#!/usr/bin/perl
## $Id: ren-regexp,v 2.4 2006/08/22 23:02:17 forman Exp forman $ 
##
## Author:        Michael Forman <Michael.Forman@mac.com>
## URL:           http://www.Michael-Forman.com
## Creation Date:  Date: 2000/07/31 02:47:42 GMT
## Last Revision: $Date: 2006/08/22 23:02:17 $ 
## Revision:      $Revision: 2.4 $
##
## Thanks to the following people for submitting fixes:
##   Marek Gura
##   Tim		Support for quoted slashes
##
## Copyright (C) 2006 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;

my $help;
my $debug;
my $test;
my $vers;
my $color;
my $under;
my $global;
my $insen;
my $force;
my $quiet;

#---------------------------------------------------------------------------
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 on
## the command line by using "--nocolor" and "--nounderline".
#
if($color eq ""){ $color = 1; }
if($under eq ""){ $under = 1; }
#---------------------------------------------------------------------------
##
## Setup ANSI global variables
#
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){
  ##
  ## Replacing will accept the following substitution forms:
  ##   s/a/b/[ig]	Proper
  ##    /a/b/[ig]	Short
  ##     a/b/[ig]	Short
  ##    /a/b     	Short
  ##     a/b            Short
  ##
  ## Matching will accept the following forms:
  ##   m/a/		Proper
  ##    /a/		Short
  #
  if(-e $re){ last; }		# if file, end of regexs
  chomp($re);

  if($re =~ /^[m!n]?\/[^\/]+\/[i]?$/){ 
    ##
    ## File name pattern matches
    #
    $re =~ s/^m?\///g;
    if($re =~ s/^[!n]\///){ $ng = "!"; }
    else{ $ng = ""; }

    #($re,$md) = split(/\//,$re); 
    ($re,$md) = split_regexp($re);
    push(@pm,$re);				# pattern matches
    $ng{$re} = $ng;	# negator
    $pm{$re} = $pm;	# regexp
    $md{$re} = $md;	# modifier

  }else{
    ##
    ## Substitutions
    #

    $re =~ s/^s?\///;
    #($pa,$tx,$md) = split(/\//,$re); 
    ($pa,$tx,$md) = split_regexp($re);
    push(@re,$re);				# substitutions
  
    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,@pm){
  shift(@ARGV);
}

if(($#pm > -1)||($#ARGV == -1)){ @ARGV = match_files(@ARGV); }


##
## Apply substitutions
#
while($ofile = shift(@ARGV)){
  $dir   = "";
  $file  = $ofile;
  $pfile = $ofile;
  $nre = 0;

  if($debug){
    print("dir:   $dir\n");
    print("ofile: $ofile\n");
    print("nfile: $nfile\n");
  }

  foreach $re (@re){
    $pa = $pa{$re};
    $tx = $tx{$re};
    $md = $md{$re};
    $dl = $dl{$re};

    if($debug){
      print("pa: $pa\n");
      print("tx: $tx\n");
      print("md: $md\n");
    }

    if($debug){ print("file: $file\n"); }
    eval("\$file =~ s/$pa/$tx/$md");
    if($debug){ print("file: $file\n"); }

    $nfile = "$dir"."$file";
    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
  #
  @re = split(/ __rEgExP__ /,$re{$ofile});

  if(!$quiet){ 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")||print(STDERR "Cannot move to \"$nfile\": $!\n");
    }else{ 
      print(STDERR "Cannot move to \"$nfile\": file exists.\n"); 
    }
  }else{
    if($debug){ 
      if(!-e $nfile){ 
	print("move: \n  \"$ofile\" \n  \"$nfile\"\n"); 
      }else{ 
	print(STDERR "Cannot move to \"$nfile\": file exists.\n"); 
      }
    }
  }
}

if(!$quiet){ print("\n"); }


#---------------------------------------------------------------------------
sub split_regexp {
  my($re) = @_;
  my @redata;

  while($re =~ /(.*?)(^|[^\\])(\\\\)*\//xg){
    ## Look for either the start of the string or any character other 
    ## than backslash, followed by a double backslash, repeated zero 
    ## or more times, followed by the pattern.
    #
    push @redata, $1.$2;
  }

  if($debug){
    my $out = join(",",@redata);
    print("split_regexp: $out\n");
  }

  return @redata;
}
#---------------------------------------------------------------------------
sub match_files { my(@file) = @_;
  my $file;
  my $pm;
  my @nfile;

  if($#file == -1){ push(@file,"."); }		# cwd default
  if($#pm   == -1){ push(@pm,".");   }		# pm default

  foreach $file (@file){
    foreach $pm (@pm){
      if(-d $file){

	$md = $md{$pm};
	$ng = $ng{$pm};

	opendir(DIR,$file)||die("Cannot open directory: $!\n");
   #eval("\@dir = grep { !/^\.{1,2}\$/ } grep { $ng/$pm/$md } readdir(DIR)");
    eval("\@dir = grep { !/^\\\.{1,2}\$/ } grep { $ng/$pm/$md } readdir(DIR)");

	closedir(DIR);

	for($i=0;$i<=$#dir;$i++){ 
	  $dir[$i] = "$file/$dir[$i]"; 
	  if($debug){ print("  $dir[$i]\n"); }
	}
	push(@nfile,@dir);

      }else{
	if($file =~ /$pm/){ push(@nfile,$file); }
      }
    }
  }
  return(@nfile);
}
#---------------------------------------------------------------------------
 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: 2006/08/22 23:02:17 $_";
  my($rvsn) = "\$Revision: 2.4 $_";
  my($rcsd) = "\$Id: ren-regexp,v 2.4 2006/08/22 23:02:17 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) 2006 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<pattern ...>]>)
(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 all
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 all
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 PATTERNS

In addition to passing a list of files to the program by using
shell globs, one can also use regular-expression matching to 
select files from the working directory or to filter a list of
files and directories included on the command line.

The following example shows the standard use of shell globs.

B<ren-regexp> B<'s/tiff$/.tif/'> B<*tiff>

The following example shows the use of regular-expression
pattern matching.

B<ren-regexp> B<'s/tiff$/.tif/'> B</tiff/>

The following example shows the combination of regular-expression
pattern matching used to filter shell globs..

B<ren-regexp> B<'s/tiff$/.tif/'> B</vacation/i> B<*tiff>

=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</>" 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) 2006 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: 2.4 $
Last Modification: $Date: 2006/08/22 23:02:17 $

=pod SCRIPT CATEGORIES
UNIX/System_administration

=pod OSNAMES
Any