#!/usr/bin/perl
#
# Brad Fitzpatrick <brad@fitzpat.com>
#

use strict;
use Getopt::Long;
use Carp qw(croak);

my $opt_dry;
my $opt_verbose;
my $opt_test;
usage() unless GetOptions(
			  'verbose' => \$opt_verbose,
			  'dry-run|n' => \$opt_dry,
			  'test' => \$opt_test,
			  );

test() if $opt_test;

my $dir = shift;
usage() unless $dir && -d $dir;

chdir($dir) or die "Couldn't chdir";
opendir(D, ".") or die;
my @files = readdir(D);
closedir(D);

my $changes = rename_list(\@files);

foreach (sort keys %$changes) {
    if ($opt_dry || $opt_verbose) {
	print "$_ -> $changes->{$_}\n";
    }
    unless ($opt_dry) {
	rename $_, $changes->{$_};
    }
}


sub usage {
    die "nrename [opts] <directory>

OPTIONS:
     --dry-run -n      Dry-run, just show what it would've done (implies verbose)
     --verbose -v      Shows renames as they happen

DESCRIPTION:

Renames all necessary files in a directory with respect to numbers in
their filenames such that when they sort alphabetically later, their
alphabetic order is the same as their numeric order.  Essentially it
just zero-pads numbers within filenames where needed, but it can deal
with any number of digits anywhere in the filename.  For instance, these
files:

   20_foo_5.dat
   20_foo_20.dat
   5_foo_6.dat

Would normally sort:

   20_foo_20.dat
   20_foo_5.dat
   5_foo_6.dat

Which is entirely wrong.  What nrename will do is:

   05_foo_06.dat
   20_foo_05.dat
   20_foo_20.dat

Which is what you presumably wanted.

AUTHOR:
 Brad Fitzpatrick <brad\@fitzpat.com>
";
}

# returns hashref of changes from arrayref of items
sub rename_list {
    my $lref = shift;  # listref
    croak "rename_list() takes an ARRAY ref" unless ref $lref eq "ARRAY";

    my %max;  # sig -> col -> max_len
              # sig like:   c_####_####_t.dat
              # col is 0-based
              # max_len is length(the digits)
    my $changes = {};

    foreach my $pass (1, 2) {
	foreach my $f (@$lref) {
	    next unless $f =~ /\d/;  # ignore non-numeric files
	    my @parts;
	    pos($f) = 0;
	    while ($f =~ /(.*?)(\d+)/gc) {
		push @parts, [ $1, $2 ];
	    }
	    if ($f =~ /\G(.+)/) {
		push @parts, [ $1, undef ];
	    }

	    my $sig = join("####", map { $_->[0] } @parts);

	    if ($pass == 1) {
		my $n = -1;
		foreach my $p (@parts) {
		    $n++;
		    my $this_len = length($p->[1]);
		    $max{$sig}{$n} = $this_len if $this_len > $max{$sig}{$n};
		}
	    }

	    elsif ($pass == 2) {
		my $new_name;
		my $n = -1;
		foreach my $p (@parts) {
		    $n++;
		    $new_name .= $p->[0];
		    next unless defined $p->[1];
		    my $maxlen = $max{$sig}{$n};
		    $new_name .= sprintf("%0${maxlen}d", $p->[1]);
		}
		$changes->{$f} = $new_name if $new_name ne $f;
	    }
	}
    }

    return $changes;
}

sub test {
    my @test_a = qw(
		    1_a.dat
		    8_a.dat
		    10_a.dat
		    b_1_tail.dat
		    b_8_tail.dat
		    b_7_tail.dat
		    b_100_tail.dat
		    c_8_8_t.gz
		    c_8_10_t.gz
		    c_10_2_t.gz
		    c_1_2_t.gz
		    );
    my @correct = qw(
		     01_a.dat
		     08_a.dat
		     10_a.dat
		     b_001_tail.dat
		     b_007_tail.dat
		     b_008_tail.dat
		     b_100_tail.dat
		     c_01_02_t.gz
		     c_08_08_t.gz
		     c_08_10_t.gz
		     c_10_02_t.gz
		     );
    
    my $changes = rename_list(\@test_a);
    foreach (@test_a) {
	if ($changes->{$_}) { $_ = $changes->{$_}; }
    }
    @test_a = sort @test_a;

    my $cor_s = join(", ", @correct);
    my $fixed_s = join(", ", @test_a);
    if ($cor_s eq $fixed_s) {
	print "MATCH.\n";
	exit 0;
    }

    print "Error!  Didn't match:\n";
    print "  SHOULD BE:  $cor_s\n";
    print "   ACTUALLY:  $fixed_s\n";

    foreach (sort keys %$changes) {
	print "$_ -> $changes->{$_}\n";
    }
    exit 1;
}