File::Rename - Perl extension for renaming multiple files

  use File::Rename qw(rename);		# hide CORE::rename
  rename @ARGV, sub { s/\.pl\z/.pm/ }, 1;

  use File::Rename;
  File::Rename::rename @ARGV, '$_ = lc';

package File::Rename;

use strict;
BEGIN { eval { require warnings; warnings->import } }

package File::Rename::Options;

use Getopt::Long ();
eval{ Getopt::Long::Configure qw(posix_default); 1 } or warn $@;

sub GetOptions () {
    Getopt::Long::GetOptions(
	'-v|verbose'	=> \my $verbose,
	'-n|nono'	=> \my $nono,
	'-f|force'	=> \my $force,
	'-h|?|help'	=> \my $help,
	'-m|man'	=> \my $man,
	'-e=s'		=> \my @expression
    ) or return;

    my $options = {
	verbose 	=> $verbose,
	no_action	=> $nono,
	over_write	=> $force,
	show_help	=> $help,
	show_manual	=> $man,
    };
    return $options if $help or $man;
	 
    if( @expression ) {
	$options->{_code} = join "\n", @expression;
    }
    else { 
	return unless @ARGV;
	$options->{_code} = shift @ARGV;
    } 
    return $options;
}
 
sub ProcessOptions (\@) {
    my $argv = shift;
    local @ARGV = @$argv;
    my $options = GetOptions;
    @$argv = @ARGV;
    return $options;
}

package File::Rename;

use base qw(Exporter);
use vars qw(@EXPORT_OK $VERSION);

@EXPORT_OK = qw( rename );
$VERSION = '0.05';

sub _default(\$);

sub rename_files ($$@) {
    my $code = shift;
    my $options = shift;
    _default $options; 
    for (@_) {
        my $was = $_;
	$code->();
    	if( $was eq $_ ){ }		# ignore quietly
    	elsif( -e $_ and not $options->{over_write} ) { 
		warn  "$was not renamed: $_ already exists\n"; 
	}
    	elsif( $options->{no_action} ) { 
		print "rename($was, $_)\n";
	}
    	elsif( CORE::rename($was,$_)) { 
		print "$was renamed as $_\n" if $options->{verbose}; 
	}
    	else { 	warn  "Can't rename $was $_: $!\n"; }
    }
}

sub rename_list ($$$;$) {
    my($code, $options, $fh, $file) = @_;
    _default $options; 
    print "reading filenames from ",
	(defined $file ? $file : 'file handle ($fh)'),
	"\n" if $options->{verbose};
    chop(my @file = <$fh>); 
    rename_files $code, $options,  @file;
}

sub rename (\@$;$) {
    my($argv, $code, $verbose) = @_;
    if( ref $code ) {
	if( 'HASH' eq ref $code ) {
	    require Carp;
	    if(defined $verbose ) {
 		Carp::carp(<<CARP);
File::Rename::rename: third argument ($verbose) ignored
CARP
	    } 
	    $verbose = $code;
	    $code = delete $verbose->{_code}
	  	or Carp::carp(<<CARP);
File::Rename::rename: no _code in $verbose
CARP

	}	
    } 
    unless( ref $code ) {
	if( my $eval = eval <<CODE ) 
sub {
#line 1
$code
#line
}
CODE
	{	
	    $code = $eval;
	} 
	else {
	    my $error = $@;
	    $error =~ s/\(eval\s+\d+\)/\(user-supplied code\)/g;
	    $error =~ s/\s+line\s+1\b//g unless $code =~ /\n/;
	    $error =~ s/\"[^#"]*\#line\s+1\n/"/;
	    $error =~ s/\n\#line\n[^#"]*\"/"/;
	    $error =~ s/\s*\z/\n/;
	    die $error;
	}
    }
    if( @$argv ) { rename_files $code, $verbose, @$argv }
    else { rename_list $code, $verbose, \*STDIN, 'STDIN' }
}

sub _default (\$) {
    my $ref = shift;
    return if ref $$ref;
    my $verbose = $$ref;
    $$ref = { verbose => $verbose }
}

1;

__END__