#!/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 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 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 might say

 rename -s .bak '' *.bak

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

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

If you have a directory full of inconveniently named files, you can use 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 will be replaced by underscores. If you specify it twice, control characters in filenames will also be substituted by underscores. If you specify 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> 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<-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;