чтобы в следующий раз не писать с нуля:
#!/usr/bin/perl
my $fuck="";
my $i;
if($ARGV[0]){open(STDIN,$ARGV[0]);}
$i=\*STDIN;
while(!eof($i)){
$fuck.=<$i>;
}
%str=();
$id=0;
$fuck=~s/\r+//gs;
$fuck=~s/(\n[ \t\n]*\n)(?{$str{++$id}="\n\n\n"})/"\nshaklo".$id."zz\n"/egsi; #'
# //-style comments
$fuck=~s/(\/\/[^\n])(?{$str{++$id}=$1.$2})/"shaklo".$id."zz"/egsi; #'
# strings
$fuck=~s/(['"])((\\\1|.)*?\1)(?{$str{++$id}=$1.$2})/"shaklo".$id."zz"/egsi; #'
$fuck=~s/(\$[a-z]+)\s*\{\s*(shaklo\d+zz)\s*\}\s*(?{$str{++$id}=$1.'{'.$2.'}'})/" shaklo".$id."zz"/egsi; #'
$fuck=~s/\t+/ /gs;
$fuck=~s/ *([=\+\*\/\-<>()\{\}\&\|\;]+) */$1/gs;
$fuck=~s/for\s*\(\s*([^\n]+?)\s*\)(?{$str{++$id}=$1})/"for(shaklo".$id."zz)"/egs i; #'
$fuck=~s/\s*\{/\{\n/gs;
$fuck=~s/\}/\n\}\n/gs;
$fuck=~s/;/;\n/gs;
$fuck=~s/(\*\/)/$1\n/gs;
$fuck=~s/(\/\*)/\n\t\n$1/gs;
$fuck=~s/\{\s+\}/\{\}/gs;
$fuck=~s/\}\s*;/\};/gs;
$fuck=~s/\}\s*else\s*(\{|if)/\} else \1/gs;
my(@lines)=split(/[\r\n]+/,$fuck);
my($pos)=0;
my $prev=0;
my($res)="";
foreach(@lines){
#~s/^\/\/.+$//;
~s/^System.out.pr.+$//;
~s/^\s*if\s*\(/if(/gs;
~s/^\s+//;
~s/\s+$//;
if($_ eq ""){next;}
my $lz=($_=~tr/\{\[\(//);
my $rz=($_=~tr/\}\]\)//);
my $r1=0;
my $r2=0;
if($lz>$rz){$r1=$lz-$rz;}
if($lz<$rz){$r2=$rz-$lz;}
my $pp=0;
$pos-=$r2;
if(substr($_,0,1) eq "}" && $prev==$pos){$pp=-1;}
$res.=("\t" x ($pos+$pp)).$_."\n";
$prev=$pos;
$pos+=$r1;
#if($_=~/\*\/$/){$res.="\n";}
}
$res=~s/shaklo(\d+)zz/$str{$1}/gs;
$res=~s/shaklo(\d+)zz/$str{$1}/gs;
$res=~s/shaklo(\d+)zz/$str{$1}/gs;
$res=~s/shaklo(\d+)zz/$str{$1}/gs;
$res=~s/\n\t*\n+/\n\n/gs;
if($ARGV[0] ne ""){open(STDOUT,">".$ARGV[0]);}
print $res;
# приведение кода в порядок, относительно ненужных пробелов и табов где не надо плюс замена досового переноса строк на юниксовый.
saransk
05.08.2011 19:41 QIP
Do you really want to delete ?