#!/usr/bin/perl
use File::Find;

finddepth (\&recursive, "./");

sub recursive
    {
        push @path, "$File::Find::dir/";
        push @files, $_;
    }

@files = File::Spec->no_upwards( @files );
foreach my $file (@files)
    {
        my (@parts, @name);
        push @name, split(/\./,$file);
        foreach my $piece (@name)
            {
                if ($piece =~ /[[:alpha:]]/ && $piece =~ /[[:digit:]]/)
                    {
                        push @parts, $piece;
                    }
                else
                    {
                        push @parts, substr $piece, 0, 1;
                    }
            }
        push @newname, join('.',@parts);
    }

my %h = ();
@newname = map { s/(\d*)$/$1 + 1/e while $h{$_}; $h{$_}++; $_ } @newname;

pop @path;

my @from = @path;
for my $i (0..$#path) { $from[$i] .= $files[$i] } \@from;

my @to = @path;
for my $i (0..$#path) { $to[$i] .= $newname[$i] } \@to;

#while ( @from and @to ) { rename shift @from, shift @to }