renamer

#!/usr/bin/perl
# From http://www.perlmonks.org/?node_id=303814
# by Aristotle - http://www.perlmonks.org/?node=Aristotle
use strict;
use warnings;

=head1 NAME

rename - renames multiple files

=head1 SYNOPSIS

F<rename>
B<-h>

F<rename>
S<B<[ -0 ]>>
S<B<[ -c | -C ]>>
S<B<[ -e code ]>>
S<B<[ -f ]>>
S<B<[ -i ]>>
S<B<[ -l | -L ]>>
S<B<[ -n ]>>
S<B<[ -s from to ]>>
S<B<[ -v ]>>
S<B<[ files ]>>

=head1 DESCRIPTION

C<rename> renames the filenames supplied according to the rules specified. 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 via standard input.

For example, to rename all files matching C<*.bak> to strip the extension, you might say

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

If are confident that none of the filenames has C<.bak> anywhere else than at the end, you can also use the much easier typed

 rename -s .bak '' *.bak

You can always do multiple changes in one ago:

 rename -s .tgz .tar.gz -s .tbz2 .tar.bz2 *.tar.*

Note however that expressive options are order sensitive. The following would probably surprise you:

 rename -s foo bar -s bar baz *

Because changes are cumulative, this would end up substituting a F<foo> match in a filename with F<baz>, not F<bar>! To get the intended results in the above example, you could reverse the order of options:

 rename -s bar baz -s foo bar *

If you placed the C<-c> after the C<-e> in the above example, files with F<.zip> and F<.ZIP> extensions would be (attempted to be) moved to different directories.

To translate uppercase names to lower, you'd use

 rename -c *

If you have files with control characters and blanks in their names, C<-z> will clean them up.

 rename -z *

You can combine all of these to suit your needs. F.ex files from Windows systems often have blanks and (sometimes nothing but) capital letters. Let's say you have a bunch of such files to clean up, and you also want to move them to subdirectories based on extension. The following command should help, provided all directories already exist:

 rename -cz -e '$_ = "$1/$_" if /(\..*)\z/' *

Again you need to pay attention to order sensitivity for expressive options. If you placed the C<-c> after the C<-e> in the above example, files with F<.zip> and F<.ZIP> extensions would be (attempted to be) moved to different directories because the directory name prefix would be added before the filenames were normalized.

=head1 ARGUMENTS

=over 4

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

Browse the manpage.

=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> option, GNU grep's C<-Z> option, and GNU sort's C<-z> option, to name just a few. B<Only valid if no filenames have been given on the commandline.>

=item B<-c>, B<--lower-case>

Converts file names to all lower case.

=item B<-C>, B<--upper-case>

Converts file names to all upper case.

=item B<-e>, B<--expr>

The C<code> argument to this option should be a Perl expression that assumes the filename in the C<$_> variable and modifies it for the filenames to be renamed. When no other C<-c>, C<-C>, C<-e>, C<-s>, or C<-z> options are given, you can omit the C<-e> from infront of the code.

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

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

=item B<-i>, B<--interactive>

Ask the user to confirm every action before it is taken.

=item B<-l>, B<--symlink>

Create symlinks from the new names to the existing ones, instead of renaming the files. B<Cannot be used in conjunction with C<-L>.>

=item B<-L>, B<--hardlink>

Create hard links from the new names to the existing ones, instead of renaming the files. B<Cannot be used in conjunction with C<-l>.>

=item B<-n>, B<--dry-run>, B<--just-print>

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

=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<-v>, B<--verbose>

Print additional information about the operations (not) executed.

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

Replaces consecutive blanks, shell meta characters, and control characters in filenames with underscores.

=back

=head1 SEE ALSO

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

=head1 AUTHORS

Aristotle Pagaltzis

Original code from Larry Wall and Robin Barker.

=head1 BUGS

None currently known.

=cut

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

BEGIN { eval "use Win32::Autoglob;" }
    # Per http://www.perlmonks.org/?node_id=829972
    # by Ciantic, http://www.perlmonks.org/?node_id=829946

sub DEBUG { print "@_\n" if $::LEVEL >= 2 }
sub INFO  { print "@_\n" if $::LEVEL >= 1 }
sub ERROR { print "@_\n" }

my @perlexpr;

Getopt::Long::Configure(qw(bundling no_ignore_case));
GetOptions(
    # Tweaked per http://www.perlmonks.org/?node_id=309199 by
    # sauoq, http://www.perlmonks.org/?node_id=182681
    'h|help'               => sub { pod2usage( -verbose => 1 ) },
    'man'                  => sub { pod2usage( -verbose => 2 ) },
    '0|null'               => \my $opt_null,
    'c|lower-case'         => sub { push @perlexpr, 's/([[:upper:]]+)/\L$1/g' },
    'C|upper-case'         => sub { push @perlexpr, 's/([[:lower:]]+)/\U$1/g' },
    'e|expr=s'             => \@perlexpr,
    'f|force'              => \my $opt_force,
    'i|interactive'        => \my $opt_interactive,
    'l|symlink'            => \my $opt_symlink,
    'L|hardlink'           => \my $opt_hardlink,
    'n|just-print|dry-run' => \my $opt_dryrun,
    's|subst|simple'       => sub {
        pod2usage( -verbose => 1 ) if @ARGV < 2;
        my @param = map(quotemeta, splice @ARGV, 0, 2);
        # NB: ${\"..."} is necessary because unknown backslash escapes are not
        # treated the same in pattern- vs doublequote-quoting context, and we need
        # the latter to do the right thing with user input like 'foo{bar}baz'
        push @perlexpr, sprintf 's/\Q${\"%s"}\E/%s/', @param;
    },
    'v|verbose+'           => \my $opt_verbose,
    'z|sanitize'           => sub { push @perlexpr, 's/[!"$&()=?`*\';<>|_[:cntrl:][:blank:]]+/_/g' },
) or pod2usage( -verbose => 1 );

pod2usage( -verbose => 1 ) if $opt_hardlink and $opt_symlink;

if(not @perlexpr) {
    if(@ARGV) { push @perlexpr, shift }
    else { pod2usage( -verbose => 1 ) }
}

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

$::LEVEL = ($opt_verbose || 0) + ($opt_dryrun || 0);

my $code = do {
    my $cat = "sub { ".join('; ', @perlexpr)." }";
    DEBUG("Using expression: $cat");
    my $evaled = eval $cat;
    die $@ if $@;
    die "Could not evaluate to code ref\n" unless 'CODE' eq ref $evaled;
    $evaled;
};

if (!@ARGV) {
    INFO("Reading filenames from STDIN");
    my $delim = "\n";
    @ARGV = do {
        if($opt_null) {
            INFO("Splitting on null bytes");
            $delim = "\0";
        }
        local $/;   # file-slurp mode
        my $inputs=<STDIN>;
        split($delim, $inputs)
    };
    chomp @ARGV;
}

my ($verb, $verbed, $action) =
    $opt_hardlink ? ( qw(link linked), sub { link shift, shift } ) :
    $opt_symlink  ? ( qw(symlink symlinked), sub { symlink shift, shift } ) :
    do { qw(rename renamed), sub { rename shift, shift } };

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

    $code->();

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

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

    if($opt_interactive and not $opt_dryrun) {
        print "\u$verb '$oldname' to '$_' (y/n)? ";
        if(<STDIN> !~ /^y/i) {
            DEBUG("Skipping '$oldname'.");
            next;
        }
    }

    if ($opt_dryrun or $action->($oldname, $_)) {
        INFO("'$oldname' $verbed to '$_'");
    }
    else {
        ERROR("Can't $verb '$oldname' to '$_': $!");
    }
}

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

# vi: set ts=4 sts=4 sw=4 et ai ft=perl: #