#!/usr/bin/perl -w

use strict;

unless( $#ARGV >= 1 ) {
  print <<EOF;
usage: nametracks.pl [-n] [-r] "name 1, name 2, ..." <file> ...
Renames a series of files to names of the form:
<path>/<number>_<name #>.<extension>
The number has as many digits as needed, the name is determined by the names
given in the first argument and the extension is the same as the original file
names.  The files' paths are also retained, so you can use this to rename files
across several directories.
The given new names are treated as follows: All words except "in", "the" and
similar are capitalised, and sequences of characters which are neither letters
nor digits are replaced by a single underscore.  The names are given in a
single command-line argument separated by commas and may not themselves contain
commas.
The option -n merely prints what would have been done rather than renaming
anything.  -r reverses the sense of the operation by renaming the newly
constructed names to the original files.  It can be used to undo a previous
run, but be aware that shell wildcards do not work for files which no longer
exist.  If you think you may want to reverse the renaming later, and if you are
using bash, you can use Ctrl-x * or Alt-{ to perform the wildcard expansion on
the command line so the expanded list can be retrieved from the command history.
EOF
  exit (!$ARGV[0] || ($ARGV[0] ne "--help" && $ARGV[0] ne "-h"));
}

my @nocaps= qw(the a an in of at for not);

my $dummyrun= 0;
my $reverserun= 0;

while( $ARGV[0] eq "-n" or $ARGV[0] eq "-r" ) {
  $dummyrun= 1 if $ARGV[0] eq "-n";
  $reverserun= 1 if $ARGV[0] eq "-r";
  shift @ARGV;
}

my @names= split /\s*,\s*/, shift(@ARGV);

if( $#names != $#ARGV ) {
  print STDERR "You gave ", $#names+1, " names but ", $#ARGV+1, " files!  Aborting\n";
  exit 1;
}

my $havedirs= 0;
my $havelinks= 0;
for my $file (@ARGV) {
  if( !$reverserun && !-e $file ) {
    print STDERR "There is no file named $file.  Aborting.\n";
    exit 1;
  }
  if( !-f $file ) {
    $havedirs= 1 if -d $file;
    $havelinks= 1 if -l $file;
  }
  my @same= grep($_ eq $file, @ARGV);
  if( $#same ) {
    print STDERR "File $file given more than once!  Aborting.\n";
    exit 1;
  }
}

if( $havedirs || $havelinks ) {
  print "Warning: The file list given contains symbolic links and/or directories.\nRerun with -r if this was unintentional.\n";
}

my $log10e= 0.43429448190325182765;
my $num= "0" x (int($log10e*log(@ARGV))+1);
++$num;
my %map;
my @news;

for my $orig (@ARGV)
{
  my $path= "";
  $orig =~ /^(.*\/)[^\/]*$/ and $path= $1;
  my $ext= "";
  $orig =~ /^.*(\.[^.]*)$/ and $ext= $1;
  my $name= shift @names;
  my @words= split /[^a-zA-Z0-9]+/, $name;
  shift @words unless $words[0];
  pop @words unless $words[$#words];
  $words[0]= ucfirst($words[0]);
  for my $word (@words[1..$#words]) {
    $word= ucfirst($word) unless grep($_ eq $word, @nocaps);
  }
  $name= $path . $num . "_" . join("_", @words) . $ext;
  if( !$reverserun && -e $name ) {
    print STDERR "Target file name $name already exists.  Aborting.\n";
    exit 1;
  }
  elsif( $reverserun && !-e $name ) {
    print STDERR "File name $name does not exist.  Cannot reverse renaming.\n";
    exit 1;
  }
  $map{$orig}= $name;
  push @news, $name;
  ++$num;
}

%map= reverse %map if $reverserun;
my @origs= $reverserun? @news: @ARGV;

if( $dummyrun ) {
  map { print "Not renaming $_ to ", $map{$_}, "\n"; } @origs;
}
else {
  for my $orig (@origs) {
    if( !rename($orig, $map{$orig}) ) {
      print STDERR "Could not rename $orig to ", $map{$orig}, "\n";
      print STDERR "Undoing completed renamings.\n";
      my $err= 0;
      for my $done (@origs) {
	last if $done eq $orig;
	$err ||= !rename $map{$done}, $done;
      }
      if( $err ) {
	print STDERR "There were errors restoring the prior names.  Sort the mess out yourself.\n";
      }
      exit 1;
    }
  }
}