#!/opt/perl/bin/perl -w

#
# ren -- Rename files
#

#
# W. M. Richards, Phoenix AZ, Ca. 1991
#
#
# This code copyright 1999 by
# W. M. Richards, NiEstu, Phoenix, AZ -- chipr@niestu.com
#
# This software is made freely available under the provisions of the Perl
# "Artistic" license:  http://language.perl.com/misc/Artistic.html
#
# This code is not supported and is not warranteed to perform any particular
# function. Contact chipr@niestu.com for aditional information.
# If you find bugs or make enhancements, it would be appreciated if you
# sent them on to the author.
#

#
# External modules
use Getopt::Long;

#
# Constants
$progname = 'ren';
$progver  = '0.2';
$false  = 0;
$true   = 1;
$all    = 2;  # for Getopt ignore case
$dos    = 'dos';
$apollo = 'apollo';
$perl   = 'perl';

#
# Default option values
$xlat = $dos;
$opt {'lower'}          = $false;
$opt {'upper'}          = $false;
$opt {'view'}           = $false;
$opt {'quiet'}          = $false;
$opt {'inquire'}        = $true;  # inquire on collisions
$opt {'inquire-always'} = $false;
$opt {'kill'}           = $false;
$opt {'shox'}           = $false;

#
# Process options
@opts = qw(
           dos|d apollo|a perl|p
           lower|l upper|u
           view|v examine|x quiet|q inquire|i inquire-always|j kill|k help|h
           from|f=s to|t=s
          );
$Getopt::Long::bundling = $true;
$Getopt::Long::ignorecase = $all;
GetOptions (\%opt, @opts);
if ($opt {'help'})
{
   &syntax_msg;
   exit (1);
}
if ($opt {'kill'})
{
   $opt {'inquire'} = $false;
   $opt {'inquire-always'} = $false;
}
if ($opt {'dos'})
{
   $xlat = $dos;
}
elsif ($opt {'apollo'})
{
   $xlat = $apollo;
}
elsif ($opt {'perl'})
{
   $xlat = $perl;
}

#
# Allow for positional pattern arguments
if ($opt {'from'})
{
   $from = $opt {'from'};
   $to = $ARGV [0] if (defined ($ARGV [0]));
}
if ($opt {'to'})
{
   $to = $opt {'to'};
   $from = $ARGV [0] if (defined ($ARGV [0]));
}
$from = $ARGV [0] if ((! defined ($from)) && defined ($ARGV [0]));
$to = $ARGV [1] if ((! defined ($to)) && defined ($ARGV [1]));
&syntax_msg if (! defined ($from));
&syntax_msg if ((! $opt {'lower'}) && (! $opt {'upper'}) && (! defined ($to)));

#
# Perform the desired translation on the patterns ("PERL" translation is a no-op)
if ($xlat ne $perl)  # protect perl's "sensitive" characters
{
   $from =~ s/\&/\\\&/g;
   $from =~ s/\./\\\./g;
   $from =~ s/\$/\\\$/g;
   $from =~ s/\^/\\\^/g;
   $from =~ s/\(/\\\(/g;
   $from =~ s/\)/\\\)/g;
   $from =~ s/\[/\\\[/g;
   $from =~ s/\]/\\\]/g;
   $from =~ s/\+/\\\+/g;
   if ($xlat ne $apollo)
   {
      $from =~ s/\{/\\{/g;
      $from =~ s/\}/\\}/g;
   }
}

if ($xlat eq $dos)
{
   # The order of these translations is important
   $from =~ s/[\?\*]+/\($&\)/g;
   $from =~ s/\?/\./g;
   $from =~ s/\*/\.\*/g;

   if (defined ($to))
   {
      $to =~ s/\&/\\\&/g;
      $to =~ s/\$/\\\$/g;
      $next = 1;
      while ($to =~ /\*/)
      {
         $to =~ s/[\?\*]+/\$\{$next\}/;  # *not* global!
         ++$next;
      }
   }
}
elsif ($xlat eq $apollo)
{
   $from =~ tr/@{}\?/\\()./;

   if (defined ($to))
   {
      $to =~ tr/@/\$/;
      $to =~ s/=/\$\&/g;
   }
}
$to = '(lowercase)' if ($opt {'lower'});
$to = '(uppercase)' if ($opt {'upper'});
$to = "\"$to\"" unless ($opt {'lower'} || $opt {'upper'});

#
# Now handle the translated patterns
if ($opt {'examine'})
{
   printf "%32s  --->  %-32s\n", $from, $to;
}
else
{
   ($dir, $fnpat) = ($from =~ m+(.*)/(.*)+);
   $from = $fnpat ? $fnpat : $from;
   $dir = $dir ? $dir : '.';
   opendir (DIR, $dir) || die "Cannot open directory '$dir':  $!\n";
   while (defined ($old = readdir (DIR)))
   {
      next if ($old eq '.' || $old eq '..');
      next unless $old =~ /^${from}$/;
      push (@fromfiles, $old);
   }
   closedir (DIR);
   file: foreach $old (sort @fromfiles)
   {
      next if ($old eq '.' || $old eq '..');
      next unless $old =~ /^${from}$/;
      $new = $old;
      if ($opt {'lower'})
      {
         $new =~ tr/A-Z/a-z/;
      }
      elsif ($opt {'upper'})
      {
         $new =~ tr/a-z/A-Z/;
      }
      else
      {
         $new =~ s/$from/eval $to/e;
      }
      $collide = -e $new;
      $msg = sprintf ("%32s  -%s->  %s%s", $old, ($opt {'view'} ? '|' : '-'), $new, ($collide ? ' +' : '  '));
      if ((! $opt {'view'}) && ($opt {'inquire-always'} || ($opt {'inquire'} && defined ($collide))))
      {
         $response = '!';  # let loop get started
         while ($response =~ /^[\?!]/)
         {
            print STDERR  "$msg [y]?  ";
            $response = <STDIN>;
            chomp ($response);
            next file if ($response =~ /^n/i);
            exit if ($response =~ /^q/i);
            ($opt {'inquire-always'} = $false) if ($response =~ /^g/i);
            system ($ENV {'SHELL'}) if ($response eq '!');
            system (substr ($response, 1)) if ($response =~ /^!\s*\S+/);
            &prompt_msg if ($response =~ /^\?/);
         }
      }
      else
      {
         print "$msg\n" unless ($opt {'quiet'});
      }
      next if ($opt {'view'});
      rename ("$dir/$old", "$dir/$new");
   }
}

#-----------------------------------------------------------------------------

#
# Prints our syntax message and quits
sub syntax_msg
{
   print STDERR  qq%

$progname version $progver

Syntax:

   $progname  [ options ]  [ from-pattern ]  [ to-pattern ]

Where \'options\' are:

   -d, --dos
       recognize MS-DOS wildcards (default)
   -a, --apollo
       recognize Apollo Aegis wildcards
   -p, --perl
       recognize PERL wildcards

   -l, --lower
       rename files matching from-pattern to all lower-case
   -u, --upper
       rename files matching from-pattern to all upper-case

   -v, --view
       view the re-name command(s), but don\'t execute them
   -e, --examine
       view the translated patterns, but no execution
   -q, --quiet
       quiet mode--don\'t show the rename commands as they are executed
   -i, --inquire
       inquiry mode--prompt before collision renames (default)
   -j, --inquire-always
       inquire-always mode--prompt before all renames
   -k, --kill
       kill mode--do not prompt before collision renames
   -h, --help
       print this help message

   -fpat, --from=pat
       \"from\" pattern, eg. \"-f*.*\" (no spaces allowed)
   -tpat, --to=pat
       \"to\" pattern, same rules as -f

Note that wildcards in the pattern arguments must be protected from the shell,
usually by enclosing the argument(s) in quotes, preceding them with a
backslash, or using the \'-f\' and \'-t\' forms of the pattern arguments.

Collisions (new filenames which already exist) will be marked with a \"+\".
View-only output (-v) is marked by a \"|\" in place of a dash in the arrow
marker.

%;
   exit (1);
}

#-----------------------------------------------------------------------------

#
# Explain to the user what he/she can type at the prompt
sub prompt_msg
{
   print STDERR  "\n(Y)es, (N)o, (Q)uit, (G)o ahead & do all, (!) shell escape\n\n";
}

#-----------------------------------------------------------------------------
