codeLayouterを perlxsで使う - prepress-tips

最終更新日時： 2011/02/27   

　codeLayouter ver 0.03 を perlxs で使うための準備。

　

Edit

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 をその中にコピーする。

codeLayout_filename.bat

@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 の結果を補正する。

adjust_source.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 に追加する。

xs_add.pl

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" ;
}

Edit

---