Submit Hint Search The Forums LinksStatsPollsHeadlinesRSS
14,000 hints and counting!


Code. | 22 comments | Create New Account
Click here to return to the 'Code.' hint
The following comments are owned by whoever posted them. This site is not responsible for what they say.
Code.
Authored by: forman on Jul 13, '05 03:43:34AM
I thought I'd include the code here in the event of a future symlink error. ;)

The latest version of the code can be found here.

Michael.

#!/usr/bin/perl
## $Id: ren-regexp,v 1.6 2003/12/28 08:01:25 forman Exp forman $ 
##
## Author:        Michael Forman <Michael.Forman@Colorado.EDU>
## URL:           http://www.Michael-Forman.com
## Creation Date:  Date: 2000/07/31 02:47:42 GMT
## Last Revision: $Date: 2003/12/28 08:01:25 $ 
## Revision:      $Revision: 1.6 $
##
## Copyright (C) 1999, 2000 Michael Forman.  All rights reserved.
## This program is free software; you can redistribute it
## and/or modify it under the same terms as Perl itself.
## Please see the Perl Artistic License.
##
## Category: File manipulation
## Rating:   5/5
##
## <meta name="title" content="ren-regexp">
## <meta name="description" content="Rename files using regular expressions.">
## <meta name="abstract" content="Rename files using regular expressions.">
## <meta name="keywords" content="Michael Forman perl script ren-regexp CPAN">
#

##
## TODO:
## Handle case insensitive filesystems
##
#
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(); }
#---------------------------------------------------------------------------
## I turned on color and underlining by default.
## You can comment these out or override them
## using "--nocolor" and "--nounderline".
#
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");
}

##
## Store regular expressions
#
foreach $re (@ARGV){
  ## Take the following forms:
  ##   s/a/b/[ig]	
  ##    /a/b/[ig]	
  ##     a/b/[ig]	
  ##     a/b            
  #
  if(-e $re){ last; }		# if file, end of regexps
  chomp($re);

  $re =~ s/^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);
}


##
## Apply substitutions
#
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); }
      ##
      ## A regexp worked!
      ## Store begining end and regexp
      #
      $pf{$ofile,$re} = $pfile;
      $nf{$ofile,$re} = $nfile;
      $rn{$ofile,$re} = $nre;
      $re{$ofile}    .= "$re"." __rEgExP__ ";
      $pfile = $nfile;
    }
    $nre++;
  }
  $nf{$ofile} = $nfile;
}


##
## Output and move
#
foreach $ofile (@ofile){
  ##
  ## Output
  #
  $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"); 
    }
  }
  ##
  ## Move
  #
  $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) = @_;
  ##
  ## Uses three colors to highlight changes in names.
  #
  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);
  ##
  ## Colors
  ##
  ## Attribute codes:
  ## 00=none 01=bold 04=underscore 05=blink 07=reverse 08=concealed
  ##
  ## Text color codes:
  ## 30=black 31=red 32=green 33=yellow 34=blue 35=magenta 36=cyan 37=white
  ##
  ## Background color codes:
  ## 40=black 41=red 42=green 43=yellow 44=blue 45=magenta 46=cyan 47=white
  #
  $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/12/28 08:01:25 $_";
  my($rvsn) = "\$Revision: 1.6 $_";
  my($rcsd) = "\$Id: ren-regexp,v 1.6 2003/12/28 08:01:25 forman Exp forman $_";

  $date =~ s/(.*: +)(.*?)(\s*$)/$2/g;
  $rvsn =~ s/(.*: +)(.*?)(\s*$)/$2/g;
  $rcsd =~ s/(.*: +)(.*?)(\s*$)/$2/g;

  print <<EOF;

Program:       ren-regexp v$rvsn

Author:        Michael Forman <Michael.Forman\@Colorado.EDU>
URL:           http://www.Michael-Forman.com
Creation Date: 2000/07/31 02:47:42 GMT
Last Revision: $date GMT
Revision:      $rcsd

Copyright (C) 2002, 2003 Michael Forman.  All rights reserved.
This program is free software; you can redistribute it
and/or modify it under the same terms as Perl itself.

EOF
  exit;
}
#---------------------------------------------------------------------------
##
## Use "perldoc ren-regexp" to read the man page below.
#
__END__

=head1 NAME

B<ren-regexp> - Rename files by the application of regular expressions

=head1 SYNOPSIS 

B<ren-regexp> 
S<[ B<-dhtv> ]> 
S<[ B<-cfgiqu> ]> 
S<[I<regexp ...>]> 
S<[I<file ...>]>


=head1 DESCRIPTION

B<ren-regexp> applies one or more regular expressions 
to a list of file names.
This provides a method of applying common modifications
to many files that would otherwise require repetitive,
atomic file operations.


=head1 OPTIONS

B<-c --color>

B<-u --underline>

The "B<--color>" and "B<--underline>" options can be used
together or separately to highlight changes in the filename
as the regular expression are applied.

B<-d --debug>

Print additional information useful for debugging.

B<-f --force>

If the new file exists, this will force an overwrite.

B<-g --global>

Apply all regular expressions globally to a filename.
This is equivalent to appending a "I<g>" to the end of each
regular expression as in "I<s/regexp/string/B<g>>".

B<-h --help>

Prints this information.

B<-i --insensitive>

Apply all regular epxression without sensitivity to case.
This is equivalent to appending an "I<i>" to the end of each
regular expression as in "I<s/regexp/string/B<i>>".

B<-q --quiet>

B<ren-regexp> is rather verbose for a unix program.
Consider this a feature to prevent data loss.
To keep things quiet, use this option.

B<-t --test>

Test the application of the regular expressions without renaming the files.
This is highly recommended to prevent the loss of data.


=head1 EXAMPLE

The following example shows standard usage.
The regular expression, "I<s/.mp3/ of 3.mp3/>", is applied to
the three files resulting in files matching the pattern
"I<PI-01 of 3.mp3>".

B<ren-regexp> B<"s/.mp3/ of 3.mp3/"> B<PI-01.mp3 PI-02.mp3 PI-03.mp3>


The following examples all have the same result.
Note that the initial "I<s/>" are both optional
with the final "I</userdefined>" option if there is no modifier.

B<ren-regexp> B<"s/A/B/i"> B<*>

B<ren-regexp> B<-i> B<"s/A/B/"> B<*>

B<ren-regexp> B<"A/B/i"> B<*>

B<ren-regexp> B<-i> B<"A/B"> B<*>

The following example shows three regular expressions
applied in turn on a filename.  
The file progresses from the original of "I<ABCD.txt>"
to "I<abCD.txt>", "I<ABcD.txt>", and finally "I<AcDB.txt>".
The single quote is necessary to prevent the shell from
expanding the regular expression variables, "I<$1>" and "I<$2>".

B<ren-regexp> B<"AB/ab"> B<"abC/ABc"> B<'(B)(cD)/$2$1'> ABCD.txt 

=head1 BUGS

The color ouput doesn't like regular expressions variables (i.e., "I<$1>").

=head1 SEE ALSO

mv    

=head1 AUTHOR AND COPYRIGHT

Michael Forman <Michael.Forman@Colorado.EDU> http://www.Michael-Forman.com

Copyright (C) 2000, 2001, 2002 Michael Forman.  All rights reserved.
This program is free software; you can redistribute it
and/or modify it under the same terms as Perl itself.
Please see the Perl Artistic License.

=head1 VERSION

Current Revision:  $Revision: 1.6 $
Last Modification: $Date: 2003/12/28 08:01:25 $

=pod SCRIPT CATEGORIES
UNIX/System_administration

=pod OSNAMES
Any



[ Reply to This | # ]