[lug] Perl question

[Tkil]

my personal solution for this is overkill, but it is handy enough that
i've been using it for months.  the idea is to provide two arguments
to the script:  first, a regex pattern to match against all files in a
directory, and then a perl expression to evaluate to generate a new
name.

new name is then checked for uniqueness; no file should ever be
overwritten by this method.

i like the power of using regexps instead of simple globbing, and i
like the power of using full perl expressions (instead of restricting
one to even regex expansions).  this combination lets us do something
like:

   pmv 'part(\d+).shar' 'sprintf "part-%03d.shar", $1'

the original problem (rename files to lowercase) is even easier, tho:

   pmv '.*' 'lc $&'

the script can be found on my web pages at

   http://slinky.scrye.com/~tkil/perl/pmv

although i've included a copy below.  i am probably reinventing the
wheel; the "rename" script mentioned in the perl cookbook is (i
believe) shipped with the standard perl distro as an example.  fwiw,
gnu make doesn't care if the file is called "Makefile" or "makefile";
it looks for the capitalized one first, but either works.

finally, my "anti-duplicate code" segment looks for at least one
suffix; this means that you should get foo-01.tar, foo-02.tar, etc,
instead of getting foo.tar-01, foo.tar-02.  this allows tools which
rely on filename extensions to continue to function properly.

p.s. this script is horribly insecure, in the sense that it does no
     security checking on its own.  in particular, it evals a string
     of perl raw perl code given by the user.  so if you don't trust
     this user to not type "rm -rf" at the command line, don't trust
     'em with this, either.

======================================================================
#!/usr/bin/perl -w
# pmv -- 1999-04-10 by tkil at scrye.com
#
# this allows moving lots of files and renaming them, based on
# regexps.  typical usage would be:
#
#    pmv '(.*)\.foo' '"$1.bar"'
#
# the first argument is a regular expression, the second is perl code
# which is evaluated.  in the simple case of textual replacement, the
# quotes work just fine.  a slightly more complex example might be:
#
#    pmv 'part-(\d+)' 'sprintf "part-%03d", $1'
#
# this program includes some code to avoid clobbering other files.  so
# if you want it overwrite files, you'll have to edit it.
#
# as a special bonus, you can use the variable "$file" to get at the
# current file name:
#
#    pmv ' ' '$_ = $file; s/\s/_/g; $_'

require 5.005; # for qr// syntax
use strict;

use File::Copy qw(move);

if (@ARGV != 2) {
  print "only two args, please\n";
  exit 1;
}

if ($ARGV[0] =~ m!/!) {
  print "only works in current directory for now, sorry\n";
  exit 1;
}

opendir D, "."
  or die "couldn't open current directory: $!";

# need a clever way to add flags here.  oh well.
my $re = qr/$ARGV[0]/;

while (my $file = readdir D) 
{
  if ($file =~ $re) 
  {
    my $new = eval $ARGV[1];

    # anti-duplicate code
    if (-e $new) 
    {
      my ($name, $ext) = ($new =~ /^(.+?)(\.[^.]+)?$/);
      $ext = "" unless $ext;
      my $i = 0;
      while (-e $new) 
      {
	++ $i;
	$new = sprintf "$name-%02d$ext", $i;
      }
    }

    print "$file => $new\n";
    move $file, $new;
  }
}

closedir D;

exit;