#!/usr/bin/perl -w
# pmv -- 1999-04-10 by tkil@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;