#!/usr/bin/perl
use strict;
use warnings;

=head1 NAME

rename - renames multiple files

=head1 SYNOPSIS

 rename [ -0 ] [ -d ] [ -f ] [ -v ] perlexpr [ files ]
 rename -s [ -0 ] [ -d ] [ -f ] [ -g ] [ -v ] from to [ files ]
 rename -z [ -0 ] [ -d ] [ -f ] [ -v ] [ -z ] [ -z ] [ files ]
 rename -h

=head1 DESCRIPTION

C<rename> renames the filenames supplied according to the rules specif
+ied. If a given filename is not modified, it will not be renamed. If 
+no filenames are given on the command line, filenames will be read vi
+a standard input.

For example, to translate uppercase names to lower, you'd use

 rename 'y/A-Z/a-z/' *

To rename all files matching C<*.bak> to strip the extension, you migh
+t say

 rename -s .bak '' *.bak

Although if any of the files has C<.bak> in another part of its filena
+me as well, you'll have to resort to

 rename 's/\.bak$//' *.bak

If you have a directory full of inconveniently named files, you can us
+e C<-z> to clean them up for you.

=head1 ARGUMENTS

=over 4

=item B<-h>, B<--help>

Browse the manpage.

=item I<nothing>

A C<perlexpr> parameter is expected, which should be a Perl expression
+ that assumes the filename in the C<$_> variable and modifies it for 
+the filenames to be renamed.

=item B<-s>, B<--subst>, B<--simple>

Perform a simple textual substitution of C<from> to C<to>. The C<from>
+ and C<to> parameters must immediately follow the argument.

This is equivalent to supplying a C<perlexpr> of C<s/\Qfrom/to/;>.

=item B<-z>, B<--sanitize>

If you specify this option once, (consecutive) blanks in filenames wil
+l be replaced by underscores. If you specify it twice, control charac
+ters in filenames will also be substituted by underscores. If you spe
+cify it thrice, filenames will also be converted to all lowercase.

=back

=head1 OPTIONS

=over 4

=item B<-0>, B<--null>

When reading file names from C<STDIN>, split on null bytes instead of 
+newlines. This is useful in combination with GNU find's C<-print0> op
+tion, GNU grep's C<-Z> option, and GNU sort's C<-z> option, to name j
+ust a few. B<Only valid if no filenames have been given on the comman
+dline.>

=item B<-d>, B<--dryrun>

Show how the files would be renamed, but don't actually do anything.

=item B<-f>, B<--force>

Rename even when a file with the destination name already exists.

=item B<-g>, B<--global>

In simple mode, substitute all occurences of the string given instead 
+of only the first one. B<Only valid if you specified C<-s>.>

=item B<-v>, B<--verbose>

Print additional information about the operations executed.

=back

=head1 ENVIRONMENT

No environment variables are used.

=head1 AUTHORS

Larry Wall, Robin Barker, Aristotle Pagaltzis

=head1 SEE ALSO

mv(1), perl(1), find(1), grep(1), sort(1)

=head1 DIAGNOSTICS

If you give an invalid Perl expression you'll get a syntax error.

=head1 BUGS

None currently known.

=cut

use Pod::Usage;
use Getopt::Long;

Getopt::Long::Configure('bundling', 'no_ignore_case');
GetOptions(
    'h|help'         => \my $opt_help,
    's|subst|simple' => \my $opt_simple,
    'z|sanitize+'    => \my $opt_sanitize,
    '0|null!'        => \my $opt_null,
    'f|force!'       => \my $opt_force,
    'g|global!'      => \my $opt_global,
    'd|dryrun!'      => \my $opt_dryrun,
    'v|verbose!'     => \my $opt_verbose,
) or pod2usage( -verbose => 1 );

pod2usage( -verbose => 2 ) if $opt_help;

pod2usage( -verbose => 1 ) if $opt_global and not $opt_simple;

sub DEBUG { print "@_\n" if $opt_verbose }
sub INFO  { print "@_\n" if $opt_verbose or $opt_dryrun }
sub ERROR { print "@_\n" }

my $code =
    $opt_simple ? do {
        pod2usage( -verbose => 1 ) if @ARGV < 3;
        my $from = shift @ARGV;
        my $to = shift @ARGV;
        $opt_global
            ? sub { s/\Q$from/$to/ }
            : sub { s/\Q$from/$to/g };
    } :
    $opt_sanitize ? sub {
        s/[_[:blank:]]+/_/g;
        s/[_[:cntrl:]]+/_/g if $opt_sanitize > 1;
        s/([[:upper:]]+)/\L$1/g if $opt_sanitize > 2;
    } :
    do {
        my $perlexpr = shift;
        pod2usage( -verbose => 1 ) if not defined $perlexpr;
        my $evaled = eval "sub { $perlexpr }";
        die $@ if $@;
        $evaled;
    };

pod2usage( -verbose => 1 ) if $opt_null and @ARGV;

if (!@ARGV) {
    INFO("Reading filenames from STDIN");
    @ARGV = do {
        if($opt_null) {
            INFO("Splitting on null bytes");
            local $/ = "\0";
        }
        <STDIN>;
    };
    chomp @ARGV;
}

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

    $code->();

    if($oldname eq $_) {
        DEBUG("'$oldname' unchanged");
        next;
    }

    WARN("'$oldname' not renamed: '$_' already exists"), next
        if not $opt_force and -e;

    if ($opt_dryrun or rename $oldname, $_) {
        INFO("'$oldname' renamed to '$_'");
    }
    else {
        ERROR("Can't rename '$oldname' to '$_': $!");
    }
}

INFO('Dry run, no changes were made.') if $opt_dryrun;