encryptio.com

#!/usr/bin/perl
#############################################################################
# brename.pl - Batch rename files
# The latest version of this can be found at:
# http://encryptio.com/code/brename
#############################################################################
# Copyright (c) 2007-2008 Chris Kastorff
#
# Redistribution and use in source and binary forms, with or without
# modification, are permitted provided that the following conditions are
# met:
#
#     * Redistributions of source code must retain the above copyright
#       notice, this list of conditions, and the following disclaimer.
#     * Redistributions in binary form must reproduce the above copyright
#       notice, this list of conditions and the following disclaimer in the
#       documentation and/or other materials provided with the distribution.
#     * The name Chris Kastorff may not be used to endorse or promote
#       products derived from this software without specific prior written
#       permission.
#############################################################################

use warnings;
use strict;
$| = 1;

our $VERSION = 0.14;

sub help {
    print STDERR <<EOF
brename [ options ] code [ path [ path ... ] ]

This batch renamer looks in all the paths given (default .) and runs the
perl code given on the filename, passing it in as \$_. If \$_ is changed
after the code is run, the file is renamed.

Options:
    -r --recursive (--norecursive removes)
        recursively check paths
    -f --force (--noforce removes)
        allow renaming to an already existing file
    -v --verbose (--noverbose removes)
        spew data about what is being done
    -a --all (--noall removes)
        run on all files, including hidden ones
    --
        stops argument parsing

EOF
}

# please, don't change these... use your shell's alias feature to set defaults
my $recursive = 0;
my $force     = 0;
my $verbose   = 0;
my $all       = 0;
my @paths     = ();

# snatch options from the start
while ( $ARGV[0] =~ /^-/ ) {
    my $arg = shift @ARGV;
    if ( $arg =~ /^--/ ) {
        if    ( $arg eq "--recursive"   ) { $recursive = 1 }
        elsif ( $arg eq "--norecursive" ) { $recursive = 0 }
        elsif ( $arg eq "--verbose"     ) { $verbose   = 1 }
        elsif ( $arg eq "--noverbose"   ) { $verbose   = 0 }
        elsif ( $arg eq "--force"       ) { $force     = 1 }
        elsif ( $arg eq "--noforce"     ) { $force     = 0 }
        elsif ( $arg eq "--all"         ) { $all       = 1 }
        elsif ( $arg eq "--noall"       ) { $all       = 0 }
        else {
            help;
            die "Unknown long option $arg.\n";
        }
    } elsif ( $arg eq "--" ) {
        last;
    } else {
        $arg =~ s/^-//;
        for my $char ( split //, $arg ) {
            if    ( $char eq "r" ) { $recursive = 1 }
            elsif ( $char eq "v" ) { $verbose   = 1 }
            elsif ( $char eq "f" ) { $force     = 1 }
            elsif ( $char eq "a" ) { $all       = 1 }
            else {
                help;
                die "Unknown short option $char.\n";
            }
        }
    }
}

if ( ! @ARGV ) {
    help;
    die "Code not given.\n";
}

# @ARGV = code path path path

my $code = eval "sub { ".(shift @ARGV)." }";
if ( $@ ) {
    die "Couldn't evaluate the code given:\n$@";
}

while ( @ARGV ) {
    my $path = shift @ARGV;
    if    ( ! -e $path ) { die "Path does not exist: $path\n"     }
    elsif ( ! -d $path ) { die "Path is not a directory: $path\n" }
    else {
        push @paths, $path;
    }
}

push @paths, "." unless @paths;

# finally, the main loop.
my %looked = map { $_, 1 } @paths;
while ( @paths ) {
    my $path = shift @paths;
    opendir my $dh, $path
        or die "Couldn't opendir $path: $!\n";
    my @all = readdir $dh;
    close $dh;
    for my $inner ( @all ) {
        if ( ($recursive and -f $inner) or (not $recursive and (-f $inner or -d $inner)) ) {
            $_ = $inner;
            $code->();
            if ( $_ ne $inner ) {
                print "$path/$inner -> $path/$_\n" if $verbose;
                die "Target path already exists (tried to move $path/$inner to $path/$_)\n"
                    if -e "$path/$_" and not $force;
                rename "$path/$inner", "$path/$_"
                    or die "Couldn't rename $path/$inner to $path/$_: $!\n";
            }
        } elsif ( $recursive and -d $inner ) {
            if ( -l $inner ) {
                # symlink, make sure we don't do infinite recursion
                my $linkpath = readlink("$path/$inner");
                next if $looked{$linkpath};
                $looked{$linkpath} = 1;
                push @paths, $linkpath;
            } else {
                $looked{"$path/$inner"} = 1;
                push @paths, "$path/$inner";
            }
        }
    }
}

__END__

Bugs:

Revision history:

0.14:
    * Fix: Documentation fix, help had wrong argument order (thx sikki)

0.13:
    * Fix: Now in nonrecursive mode, will rename directories as well as files.

0.12:
    * Fix: Read the full filelist into memory, then process, to avoid issues
           with stupid filesystems.

0.11:
    * Fix: brename without code argument prints help.
    * Change: argument order: code is first, paths come afterwards.

0.1:
    * Initial release
    * Known bug: Symlink recursion is not handled correctly: a symlink can
                 point to a path, then the path can be specified on the command
                 line in a different fashion (ex: foo is a symlink to
                 /curdir/bar, and we pass foo and bar - bar is processed twice)