#!/your/perl/here

use warnings;
use strict;

use DOSGLOB;


our $verbose = 0;

sub usage
{
    my $my0;
    ( $my0 = $0 ) =~ s#.*/##;
    die <<"USAGE";

usage:

  $my0 [-i] [-f] [-v] [-x] perl_exp [file...]
  
where:
  
  -i serializes file names when duplicates are encountered
  
  -f forces filename changes even when they collide with existing file
+names (use with caution!)
  
  -v verbose: prints file name translations to STDERR
  
  -x check: prints file name translations to STDERR, but does not rena
+me the files (use before -force)
  
  perl_exp is a perl expression used to make the change

  file... is one or more filenames to be changed. If no filenames are 
+given, STDIN is used instead.

description:

  $my0 will change filenames according to the perl expression given.
  
  If the new filename already exists, it will not be destroyed unless 
+the -f option is used. If the -i option is used, a unique number will
+ be added to the end of the file name (before any extension).
  
  Windows/DOS: watch out for backslashes in directory names, and quoti
+ng problems.
  
examples:

    $my0 's/\$/.bak/' *                     adds '.bak' to all filenam
+es
    $my0 -f 's/\$/.bak/' *                  same, but clobbers existin
+g files
    $my0 'tr/A-Z/a-z/' *                    changes all filenames to l
+owercase
    $my0 's/\$/.old/ if -M \$_ > 0.5'       files older than 1/2 day
    $my0 '\$count += s/foo/bar/;\$_=\$old_file_name if \$count < 10' *
+    only changes 1st 9 filenames that match

notes:
    \$old_file_name holds the old file name
    \$_ holds the new file name
    \$force, \$verbose, \$check, \$perl_expression already used

USAGE
} # end sub usage

usage if ( $#ARGV < 0 );

our $FORCE = "-f";
our $force;
our @TEMP_ARGV;
our $check;
our $increment;

foreach my $argv ( @ARGV )
{
    if ( $argv =~ /^$FORCE$/ )
    {
        $force = $argv;
        next;
    }

    if ( $argv =~ /^-v$/ )
    {
        $verbose = $argv;
        next;
    }

    if ( $argv =~ /^-x$/ )
    {
        $check = $argv;
        $verbose = '-v';
        next;
    }
    
    if ( $argv =~ /^-i$/ )
    {
        $increment = $argv;
        next;
    }
    
    push @TEMP_ARGV, $argv;
}

@ARGV = @TEMP_ARGV;

usage if ( $#ARGV < 0 );

our $perl_expression = shift( @ARGV );

@ARGV or chomp( @ARGV = <STDIN> );

DOSGLOB::dosglob( \@ARGV ) if ($^O =~ /win/);

for ( @ARGV )
{
    my $old_file_name = $_;

    # eval warnings will show useful debug info with #line directive
    eval "\n#line " . __LINE__ . " for \@ARGV in file " . __FILE__ . "
+, eval \$perl_expression\n" . $perl_expression;
    die $@ if $@;
    unless ( ( $old_file_name eq $_ ) or ( ( -e $_ ) and not( $force )
+ ) )
    {
        rename( $old_file_name, $_ ) unless $check;
        warn( "<$old_file_name> => <$_>\n" ) if $verbose;
        next;
    }
    
    if ( ( $old_file_name ne $_ )
     and ( -e $_ )
     and ( $increment ) )
    {
        my $num = "000";
        my $base;
        my $ext;
        ( $base ) = /^([^.]+)/;
        ( $ext ) = /(\..*)$/;
        my $inc_name;
        do
        {
            $num++;
            $inc_name = $base . "_" . $num . $ext;
        } while ( -e $inc_name );
        
        rename( $old_file_name, $inc_name ) unless $check;
        warn( "<$old_file_name> => <$inc_name>\n" ) if $verbose;
        next;
    }
                    
    if ( $old_file_name eq $_ )
    {
        warn( "No change: $old_file_name\n" ) if $verbose;
        next;
    }
    
    if ( ( -e $_ ) and not( $force ) )
    {
        warn( "File exists: <$old_file_name> => <$_>, use $FORCE\n" );
        next;
    }
    
    if ( $old_file_name eq $_ )
    {
        warn( "Same name: <$old_file_name> => <$_>\n" ) if $verbose;
        next;
    }
    
    next; # defensive programming
}
[download]