prepress-tips
codeLayouterを perlxsで使う
最終更新:
prepress-tips
-
view
最終更新日時: 2011/02/27
codeLayouter ver 0.03 を perlxs で使うための準備。
codeLayout_filename.bat
- _filename のところを適当にリネームして使用する。
- filename_index.txt に codeLayouter.pl を適用して
filename.pl , filename.xs , filename_xs.pl を作り それぞれを補正する。
filename_xs.pl は filename.xs に追加する。 - filename.pl の文字コードを utf8 に変換する。
- filename と同名のフォルダがあれば filename.xs をその中にコピーする。
@echo off cd /d "%~dp0" rem fn set fn=%~n0 set fn=%fn:codeLayout_=% echo new %fn% rem codeLayouter set codeLayouter=perl codeLayouter.pl echo/ && %codeLayouter% %fn%_index.txt || ( pause && exit ) rem adjust pl set ex=pl ( if exist _.%ex% del _.%ex% ) && ren %fn%.%ex% _.%ex% perl adjust_source.pl p < _.%ex% > %fn%.%ex% if exist _.%ex% del _.%ex% rem adjust xs set ex=xs ( if exist _.%ex% del _.%ex% ) && ren %fn%.%ex% _.%ex% perl adjust_source.pl c < _.%ex% | perl -p xs_add.pl > %fn%.%ex% if exist _.%ex% del _.%ex% rem adjust _xs.pl set ex=pl ( if exist _xs.%ex% del _xs.%ex% ) && ren %fn%_xs.%ex% _xs.%ex% perl adjust_source.pl p < _xs.%ex% | perl -pe "" >> %fn%.xs if exist _xs.%ex% del _xs.%ex% rem .pl language utf8 set ex=pl ( if exist _.%ex% del _.%ex% ) && ren %fn%.%ex% _.%ex% perl -n ^ -e "BEGIN { use Encode qw( encode decode ) ; }" ^ -e "/^.*/ ; print encode( 'utf8' , decode( 'cp932' , $& . \"\n\" ) ) ;" ^ _.%ex% > %fn%.%ex% if exist _.%ex% del _.%ex% rem copy xs echo/ && echo copy %fn%.xs if exist "%fn%\" copy %fn%.xs "%fn%\" echo/ && pause
codeLayouter.pl
- codeLayouter.pl は codeLayouter ver 0.03 のものを使う。
adjust_source.pl
- codeLayouter.pl の結果を補正する。
my $pl = ( 0 < @ARGV && $ARGV[0] =~ /^p$/i ); my $c = ( 0 < @ARGV && $ARGV[0] =~ /^c$/i ); my $css = ( 0 < @ARGV && $ARGV[0] =~ /^css$/i ); my $js = ( 0 < @ARGV && $ARGV[0] =~ /^j$/i ); my $tag = ( 0 < @ARGV && $ARGV[0] =~ /^t$/i ); my $r = ( 0 < @ARGV && $ARGV[0] =~ /^r$/i ); my $dot = ( 0 < @ARGV && $ARGV[0] =~ /^d$/i ); my $uws = ( 0 < @ARGV && $ARGV[0] =~ /^u$/i ); my $as = ( 0 < @ARGV && $ARGV[0] =~ /^a$/i ); BEGIN{ my $post = 0 ; } while( <STDIN> ) { $pl && do { s,^(\s*)//,$1#,; s,^/\*,$1=pod,; s,^\*/,$1=cut,; s,^(\s*\{\s*)//,$1#,; s,^(?!\s*(?:my|our)\s)(\s*)(\S+\s*)\([^\)]*\)(\s*\{\s*)//,$1sub $2$3#,; s,^(?!\s*sub\s)(\s*[^\{]*?[^\{\s])\s*;?\s*(\{\s*)//,$1 ; $2#,; s,^(?!\s*sub\s)(\s*[^\{/]*;\s*)//,$1#,; }; $c && do { ; }; $css && do { m,^[^{;]*;?\s*{\s*//, && ( s"^([^{;]*);?(\s*{\s*)//"$1$2/*", s"(?=$)" */" ); m,^\s*//, && ( s"^(\s*)//"$1/*", s"(?=$)" */" ); }; $js && do { s,^(\s*)(\S+\s*\([^\)]*\)\s*\{\s*)//,$1function $2//,; s,^(?!\s*function\s)(\s*[^\{;]*[^\{;\s])\s*;?\s*(\{\s*)//,$1 ; $2//,; s,([\,\*])\;(?=\s*$),$1,; }; $tag && do { m,^\s*//, && ( s/^\s*/$&<!-- /, s/$/ -->/ ), s,(>\s*);$,$1, ; s,<\-([\w\-]+)>,</$1>,g ; }; $r && do { s,^(\s*\S+\s*)(\([^\)]*\)\s*\{\s*)//,$1 <- function $2#,; s,^(\s*\S+)(\s*)(;?\s*)//,$1 <- NULL$2; $3#,; s,^(\s*)//,$1#,; }; $dot && do { m,^[^{;]*;?\s*{\s*//, && ( s"^([^{;]*);?(\s*{\s*)//"$1$2/*", s"(?=$)" */" ); m,^\s*//, && ( s"^(\s*)//"$1/*", s"(?=$)" */" ); }; $uws && do { m,^[^{;]*;?\s*{\s*//, && s"^([^{;]*);?(\s*){\s*//"$1$2//" ; m,^\s*}\s*$, && s"^(\s*)}(\s*)$"$1//$2" ; m,^\s*ifb\s.*\S +endif;?(?=\s|$), && s"^(\s*)ifb(\s.*\S) +endif;?(?=\s|$)"$1if$2" ; m,^\s*if\s.*?;(?=\s*$), && s"^(\s*if\s.*?);(?=\s*$)"$1" ; }; $as && do { m,^[^{;]*;?\s*{\s*//, && s"^([^{;]*);?\s*{(\s*)//"$1--$2" ; m,^\s*//, && s"^(\s*)//"$1--" ; s,/\*,(*,g ; s,\*/,*),g ; s,\s*;(?=\s*$),, ; s,;;,\x0a,g ; m,^\s*}\s*$, && s"^(\s*)}(\s*)$"$1$2" ; }; print; }
xs_add.pl
- filename.xs 内の関数の perl用入出力宣言を
自動的に作って filename.xs に追加する。
our @types ; our $types ; our @flist ; BEGIN { @types = ( 'void' , 'int' , 'double' , 'char\s*\*' , 'SV\s*\*' , 'AV\s*\*' ) ; $types = '(?:' . ( join '|' , @types ) . ')' ; @flist = () ; } /^\s*$types\s+[\w_]+\s*\((?:\s*$types\s+[\w_]+)?(?:\s*,*\s*$types\s+[\w_]+)*\s*\)\s*\{/ || next ; my $str = $& ; $str =~ /^\s*($types)\s+([\w_]+)\s*\(/ ; $str = $' ; my $r = $1 ; my $f = $2 ; $str =~ s,\s*\)\s*\{$,, ; my @a = split ',' , $str ; push @flist , join '' , ( "\n$r\n" , "$f( " , ( join ' , ' , map { s,^\s*,, ; s,\s*$,, ; /^$types\s+/ ? $' : $_ } @a ) , " )\n" , map { " $_\n" } @a , ) ; END { print @flist , "\n" ; }