#!/usr/bin/env perl

# massrename.pl - renames files using regular expressions
# Copyright (C) 2008, Thomas Backman <serenity@exscape.org>
# Written on 2008-03-12; last modified 2008-03-16

# This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version.
# This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details.
# You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA

use strict;
use warnings;
use Getopt::Std;
use constant DEBUG => 0;

our $VERSION = "0.2";
$Getopt::Std::STANDARD_HELP_VERSION = 1;

# Get command line arguments
my %options;
getopts("dfpvVh", \%options);

sub HELP_MESSAGE
{
	print <<EOF
massrename v$VERSION, by Thomas Backman <serenity\@exscape.org>
Usage: $0 [options...] <file list> <regex>
Valid options:
	-f	Overwrite existing file, if any
	-d	Work on directories as well. By default, only regular files (and symlinks) are renamed.
	-p	Pretend. That is, don't move anything, only display what would be moved without -p active.
	-v	Be verbose (print all old and new filenames)
	-V, -h	Show this help/version screen.

Example: $0 *.bak 's/\\.bak\$/.txt/g'
EOF
;
	exit 0;
}

sub VERSION_MESSAGE { &HELP_MESSAGE }

HELP_MESSAGE() unless @ARGV >= 2;
HELP_MESSAGE() if ($options{h} or $options{V});

# The regex should be the last argument, so:
my $regex = pop @ARGV;

# Split the regex. Lets hope it doesn't contain slashes (which isn't *too* common in filenames!)
my ($search, $repl, $flags) = ($1, $2, $3) if $regex =~ m{^s/(.*?)/(.*?)/(\w+)?};
$repl = "" unless defined $repl;
$flags = "" unless defined $flags;
die "Unable to read regex! Make sure it's in the form s/old/new/flags\nFlags are optional, but you might want the /g flag. See man perlre for more info.\n" unless (defined $search && defined $repl);

# Walk through the file list and delete all non-files
for my $index (0 .. $#ARGV) {
	$_ = $ARGV[$index];
	unless (-f || -l || -d) {
		warn "$_ doesn't appear to be an existing file, ignoring\n";
		if (DEBUG) { print ">>> Deleting $ARGV[$index] from the file list...\n" }
		delete $ARGV[$index];
	}
}

# Main loop follows, I guess.
for my $filename (@ARGV) {
	my $newname = $filename;

	# Couldn't get it to work any other way.
	eval '$newname =~ s/$search/' . "$repl/$flags";
	die "Unable to execute substitution! Invalid regular expression?\nError message was: $@\n" if $@;
	do_move ($filename, $newname) unless $filename eq $newname; # Ignore files whose name didn't change
}

sub do_move {
	my ($filename, $newname) = @_;

	if (-e $newname && !$options{f}) {
		warn "$newname already exists, not renaming $filename (use -f switch to force)\n";
		return
	}
	if (-d $filename && !$options{d}) {
		warn "$filename is a directory, skipping (use -d switch to rename directories as well)\n";
		return
	}

	# Print names if debugging, pretending (-p) or told to be verbose (-v)
	if (DEBUG || $options{p} || $options{v}) { print ">>> $filename -> $newname\n"; }
	return if $options{p}; # Don't actually rename if we're pretending
	rename $filename, $newname or warn "Unable to rename $filename to $newname: $!\n";
}