lug-bg: Re: lug-bg: Преименуване на файлове

["Danail Petrov" <oneofus@xxxxxxxxxxxxx>]

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
============================================================================