#!/usr/bin/perl -w
#
# $Id: rename.pl,v 2.2 2001/07/17 02:50:54 jmates Exp $
#
# Copyright (c) 2000-2001, Jeremy A. Mates.  This script is free
# software; you can redistribute it and/or modify it under the same
# terms as Perl itself.
#
# Run perldoc(1) on this file for additional documentation.
#
######################################################################
#
# REQUIREMENTS

require 5;

use strict;

######################################################################
#
# MODULES

use Carp;			# better error reporting
use Getopt::Std;		# command line option processing

use File::Copy;			# if want to copy instead of rename

######################################################################
#
# VARIABLES

my $VERSION;
($VERSION = '$Revision: 2.2 $ ') =~ s/[^0-9.]//g;

my (%opts, $op, $fn);

######################################################################
#
# MAIN

# parse command-line options
getopts('h?cmifvp', \%opts);

help() if exists $opts{'h'} or exists $opts{'?'};

# choose which function to use depending on argument; default is to
# use the rename() function, but that can be changed to one of copy()
# or move() from File::Copy if the name of the script is changed or
# appropriate argument is supplied
$fn = $opts{'c'} || $0 eq "copy" ? "copy" : "rename";
$fn = $opts{'m'} || $0 eq "move" ? "move" : $fn;

# perl expression to run the files by
$op = shift;

# read from STDIN if no args left
chomp(@ARGV = <STDIN>) unless @ARGV;

# and flag the help text if nothing from STDIN
help() unless @ARGV;

open UNDO, ">.undo" if $fn eq "rename";
print UNDO "#!/bin/sh\n\n" if $fn eq "rename";
# loop over the files
for (@ARGV) {
    # allow more flexibility in eval statements
    no strict; $^W = 0;

    # record what the file was called
    my $was = $_;

    # evaluate the expression passed on the command line,
    # operating on $_ (by default)
    eval $op;

    # keel over if something went wrong with the evaluation...
    die $@ if $@;

    # skip out early if the filename didn't change
    next if $was eq $_;

    # if required, print out what we intend to do
    print $fn, ' ', $was, ' ', $_, "\n" 
	if $opts{'v'} || $opts{'i'} || $opts{'p'};

    # skip out early if we're in the "preview" mode
    next if $opts{'p'};

    # check whether we should drop into interactive mode
    # when a conflicting file exists
    if (-e && $opts{'i'} && ! $opts{'f'}) {
	print "$_ exists.  Overwrite? (y/[n]) ";
        next unless <STDIN> =~ /^[Yy]/;
    }

    # with error checking, actually attempt the rename or
    # copy.
    unless (eval "$fn(\$was, \$_)") {
        warn "\U$fn\E ERROR $was -> $_ - $!\n";
        next;
    }
    print UNDO "mv \"$_\" \"$was\"\n" if $fn eq "rename"
}
close UNDO if $fn eq "rename";
exit;

######################################################################
#
# SUBROUTINES

# a generic help blarb
sub help {
    print <<"HELP";
Usage: $0 [opts] expression [file1 file2 .. fileN]

A powerful file renamer in perl.

Options for version $VERSION:
  -h/-?  Display this message

  -c     copy instead of rename
  -m     move instead of rename or copy

  -i     interactive, prompt if necessary
  -f     force (do not prompt to replace existing files)

  -v     be verbose
  -p     preview mode (show changes only)

Run perldoc(1) on this script for additional documentation.

HELP
    exit;
}

######################################################################
#
# DOCUMENTATION

=head1 NAME

rename.pl - a file renamer in perl

=head1 SYNOPSIS

Append .old to a bunch of files:

  $ rename.pl 's/$/.old/' *

Fix the case on all .C files to lower, doing a preview of changes
only:

  $ rename.pl -p 'tr/A-Z/a-z/' *.C

=head1 DESCRIPTION

A powerful file renamer that uses user-supplied perl expressions to
rename files.  Optionally, the copy() or move() routines from
File::Copy may be used instead of the builtin rename() function.

A preview mode is also available, to allow testing of expressions
before any changes are allowed to go to disk.

=head1 USAGE

  $ rename.pl [options] expression [file1 file2 .. fileN]

See L<"OPTIONS"> for details on the command line switches supported.

If no files are mentioned on the command line, the script will attempt
to read them from STDIN, allowing for easy interoperation with various
shell utilities.  In this case, fix .htm files to .html:

  $ find . ! -type d -name "*.htm" | rename.pl '$_ .= "l"'

=head1 OPTIONS

This script currently supports the following command line switches:

=over 4

=item B<-h> / B<-?>

Prints a brief usage note about the script.

=item B<-c>

Copy files instead of renaming them, using copy() from File::Copy.

=item B<-m>

Move files instead of renaming them.  Uses move() from File::Copy,
which may not be available in older versions of File::Copy.

Since rename() cannot be used across filesystem boundaries, and may
not be available on all systems, move() may be a better option in some
circumstances.

=item B<-i>

Interactive mode: prompts for confirmation.

=item B<-f>

Force mode.  Does not prompt to replace existing files.

=item B<-v>

Be verbose about the whole process.

=item B<-p>

Enable preview mode, no changes will be made to disk.

=back

=head1 EXAMPLES

Remove upper case from a bunch of files:

  $ rename.pl '$_ = lc' *

Dealing with deep directories full of files to be changed can be
tricky, especially if the pattern in question is renaming directories,
which will throw off the rename of deeper files.

The solution is to first change all the directories, then go after the
files.  For example, to swap out "bad" characters with _ in a deep
file tree:

    $ find . -type d -exec rename.pl 's/[^A-Za-z0-9,.\/_-]/_/g' {} \;
    $ find . -exec rename.pl 's/[^A-Za-z0-9,.\/_-]/_/g' {} \;

=head1 BUGS

=head2 Reporting Bugs

Newer versions of this script may be available from:

http://www.sial.org/code/perl/

If the bug is in the latest version, send a report to the author.
Patches that fix problems or add new features are welcome.

=head2 Known Issues

Bugs are left as an exercise to the expression writer. :)

=head1 SEE ALSO

File::Copy, perl(1)

=head1 AUTHOR

Jeremy A. Mates, http://www.sial.org/contact/

=head1 COPYRIGHT

Copyright (c) 2000-2001, Jeremy A. Mates.  This script is free
software; you can redistribute it and/or modify it under the same
terms as Perl itself.

=head1 HISTORY

This is a hacked up version of Larry Wall's original rename script
distributed with perl under the eg directory, improved by Daniel
V. Klien (copy option, interactive mode), and then polished into this
form by Jeremy Mates (preview mode, comments in source, move support).

=head1 VERSION

$Id: rename.pl,v 2.2 2001/07/17 02:50:54 jmates Exp $

=cut