Aide i az da ne ostana po nazade ama maaalko po obshirno s mnogo options :PPP
#!/usr/bin/perl use warnings; #use scrict; use Getopt::Long; use File::Copy; #--------------------------------------------------------------------------- GetOptions( "h|help" => \$help, "d|debug" => \$debug, "t|test" => \$test, "v|version" => \$vers, #--------------------------------- "c|color" => \$color, "u|underline" => \$under, "g|global" => \$global, "i|insensitive" => \$insen, "f|force" => \$force, "q|quiet" => \$quiet, ); #--------------------------------------------------------------------------- if($help){ exec("perldoc $0"); } if($vers){ version(); } if($#ARGV == -1){ usage(); } if($color eq ""){ $color = 1; } if($under eq ""){ $under = 1; } if($under && $color){ $CG = ansi_color("g","u"); $CR = ansi_color("r","u"); $CO = ansi_color("y","u"); $CL = ansi_color("d","n"); }elsif($under){ $CG = ansi_color("d","u"); $CR = ansi_color("d","u"); $CO = ansi_color("d","u"); $CL = ansi_color("d","n"); }elsif($color){ $CG = ansi_color("g","n"); $CR = ansi_color("r","n"); $CO = ansi_color("y","n"); $CL = ansi_color("d","n"); } foreach $re (@ARGV){ if(-e $re){ last; } # if file, end of regexps chomp($re); $re =~ s/^\w*s?\///; ($pa,$tx,$md) = split(/\//,$re); push(@re,$re); if($global && (!($md =~ /g/))){ $md.= "g"; } if($insen && (!($md =~ /i/))){ $md.= "i"; } $pa{$re} = $pa; # regexp $tx{$re} = $tx; # replacement $md{$re} = $md; # modifier $dl{$re} = $dl; # delimiter } if($#re == -1){ usage(); } $nsp = int(($#re+1)/10)+2; $spc = " " x $nsp; foreach $re (@re){ shift(@ARGV); } while($ofile = shift(@ARGV)){ $nfile = $ofile; $pfile = $ofile; $nre = 0; foreach $re (@re){ $pa = $pa{$re}; $tx = $tx{$re}; $md = $md{$re}; $dl = $dl{$re}; eval("\$nfile =~ s/$pa/$tx/$md"); if($pfile ne $nfile){ if($ofile[$#ofile] ne $ofile){ push(@ofile, $ofile); } $pf{$ofile,$re} = $pfile; $nf{$ofile,$re} = $nfile; $rn{$ofile,$re} = $nre; $re{$ofile} .= "$re"." __rEgExP__ "; $pfile = $nfile; } $nre++; } $nf{$ofile} = $nfile; } foreach $ofile (@ofile){ $prc = ""; @re = split(/ __rEgExP__ /,$re{$ofile}); print("\n"); for($i=0;$i<=$#re;$i++){ $re = @re[$i]; if(!$quiet){ $pa = $pa{$re}; # pattern $tx = $tx{$re}; # trans $md = $md{$re}; # mod $pp = $pa{$re[$i+1]}; # trans $m2 = $md{$re[$i+1]}; # trans $of = $ofile; # old file name $pf = $pf{$ofile,$re}; # new file name $nf = $nf{$ofile,$re}; # new file name $rn = $rn{$ofile,$re}; # regexp number if($color||$under){ ($pf, $nf) = color_regexp3($pf, $pa, $tx, $md, $nf, $pp, "", $m2); } $prn = $rn + 1; if($nsp > 2){ $prn =~ s/^(\d)$/0$1/; $spc = " "; } if($i==0){ print("$spc$pf\n"); } print("$prn $nf\n"); } } $nfile = $nf{$ofile}; if(!$test){ if((!-e $nfile)||($force)){ move("$ofile","$nfile"); } else{ print(STDERR "Cannot move \"$nfile\": file exists.\n"); } }else{ #print("mv \"$ofile\" \"$nfile\"\n"); } } if(!$quiet){ print("\n"); } sub color_regexp3{ my($p1, $r1, $t1, $m1, $p2, $r2, $t2, $m2) = @_; my($c1, $c2, $c3); my(@c3, @r1); my($str,$pr); my($i); $c1 = restcol($p1,$r1, $t1,$m1,1); $c2 = restcol($p2,$r2,"\$1",$m2,2); $c3 = stradd($c1, $c2); eval("\$p1 =~ s/($r1)/$CR\$1$CL/$m1;"); if($debug){ print(" $c1 s/$r1/$t1/$m1\n"); print(" +$c2 /$r2/$m2\n"); print(" =$c3 sum\n"); } @c3 = split(//, $c3); @p2 = split(//, $p2); for($i=0;$i<=$#c3;$i++){ if($c3[$i] != $pr){ if($c3[$i] == 0){ $str.= "$CL$p2[$i]"; }elsif($c3[$i] == 1){ $str.= "$CL$CG$p2[$i]"; }elsif($c3[$i] == 2){ $str.= "$CL$CR$p2[$i]"; }elsif($c3[$i] == 3){ $str.= "$CL$CO$p2[$i]"; } }else{ $str.= "$p2[$i]"; } $pr = $c3[$i]; } $p2 = $str."$CL"; return($p1,$p2); } sub restcol { my($st,$re,$tx,$md,$k) = @_; my(@st); my($i,$n,$col); eval("\$st =~ s/($re)/ __ReGeXp__ $tx __ReGeXp__ /$md;"); @st = split(/ __ReGeXp__ /,$st); for($i=0;$i<=$#st;$i++){ $n = $i%2*$k; $col.= $n x length($st[$i]); } return($col); } sub stradd { my($a, $b) = @_; my(@a,@b,@c); my($i,$c); my($sa) = 1; my($sb) = 1; if($a =~ s/^-//){ $sa*= -1; } if($b =~ s/^-//){ $sb*= -1; } @a = split(//,$a); @b = split(//,$b); for($i=0;$i<=$#a;$i++){ $c[$i] = $sa * $a[$i] + $sb * $b[$i]; if($c[$i] < 0){ $c[$i] = 0; } } $c = join('', @c); return($c); } #--------------------------------------------------------------------------- sub ansi_color { my($color,$attrb) = @_; my($ansi); $ansi = "\e["; if($color =~ /d(efault)?/i){ $ansi.= "00"; } elsif($color =~ /r(ed)?/i){ $ansi.= "31"; } elsif($color =~ /g(reen)?/i){ $ansi.= "32"; } elsif($color =~ /y(ellow)?/i){ $ansi.= "33"; } elsif($color =~ /b(lue)?/i){ $ansi.= "34"; } elsif($color =~ /m(agenta)?/i){ $ansi.= "35"; } elsif($color =~ /c(yan)?/i){ $ansi.= "36"; } elsif($color =~ /w(hite)?/i){ $ansi.= "37"; } if($attrb =~ /n(ormal)?/i){ $ansi.= ";00"; } elsif($attrb =~ /b(old)?/i){ $ansi.= ";01"; } elsif($attrb =~ /u(nderline)?/i){ $ansi.= ";04"; } $ansi.= "m"; return($ansi); } sub usage { print("\n"); print("usage: ren-regexp [regexp ...] [file ...]\n"); print("\n"); exit; } sub version { my($date) = "\$Date: 2003/03/09 04:28:12 $_"; my($rvsn) = "\$Revision: 1.5 $_"; my($rcsd) = "\$Id: ren-regexp,v 1.5 2003/03/09 04:28:12 forman Exp forman $_"; $date =~ s/(.*: +)(.*?)(\s*$)/$2/g; $rvsn =~ s/(.*: +)(.*?)(\s*$)/$2/g; $rcsd =~ s/(.*: +)(.*?)(\s*$)/$2/g; } Best Regards, dido .. ============================================================================ A mail-list of Linux Users Group - Bulgaria (bulgarian linuxers). http://www.linux-bulgaria.org - Hosted by Internet Group Ltd. - Stara Zagora To unsubscribe: http://www.linux-bulgaria.org/public/mail_list.html ============================================================================