#! \usr\bin\perl

###############################################################################
###############################################################################
#
# To rename files or folders recursively using regular expressions
#	by Andrew J. Hardwick
#
###############################################################################
###############################################################################
# Version 1, 2002/3/24
# Version 2, 2005/8/31
#  Total rewrite.
#  Takes expressions from the command line instead of needing code altering.
#  Takes command line options.
#  Defaults to CWD instead of Temp directory.
#  Renamed from 'TemplateForFileRenaming.pl' to 'Rename.pl'.
# Version 3, 2005/12/20
#  Debugged changing names in subdirectories
# Version 4, 2006/9/8
#  Allowed empty strings as search & replace parameters.
# Version 5, 2007/4/8
#  Added option to turn off recursion.
#  Tidied source code & added check for overwriting when renaming.
# Version 6, 2007/4/9
#  Improved to allow renaming of directories & their contents in the same run.
# Version 7, 2007/4/10
#  Minor help message typo corrections.
#  Renamed from 'Rename.pl' to 'RecursiveRegexpRename.pl'.
# Version 8, 2008/5/13
#  Minor help message typo correction.
#  Minor syntax error ('next' instead of 'return' to abort 'sub') correction.
# Version 9, 2009/1/30
#  Added (suggestion & sample code from Doug Farley) directory creation.
# Version 10, 2009/8/16
#  Minor typo & ommission corrections to the comment section.
###############################################################################
###############################################################################
# How To Use
#  Run with no arguments or '-h' option to get instructions.
#  Warning: As it 'eval's the regular expressions to allow full functionality
#   it can be use to run other programs from within a supplied regular
#   expression. In its intended use (run from command line by user)
#   that is not an additional risk but it is not safe to run with parameters
#   from unsafe sources such as CGI parameters on a public webserver.
###############################################################################
##### This file is formatted for 80 character lines and 4 character tabs. #####
###############################################################################

# Include libraries
use File::Find;		# For file finding
use File::Path;		# For directory path creation
use Getopt::Std;	# For extracting command line options
# Disenable automatic global variables
use strict;

###############################################################################
# Main routine
###############################################################################

{	# Get command line options
	my %Options;
	getopts('hfdn:m:b:ept',\%Options);
	my $HelpFlag=exists($Options{'h'});
	my $FilesFlag=exists($Options{'f'});
	my $DirectoriesFlag=exists($Options{'d'});
	unless($FilesFlag||$DirectoriesFlag)
	{	$FilesFlag=$DirectoriesFlag=1;}
	my $NameExpression=exists($Options{'n'})?$Options{'n'}:'';
	my $Modifiers=exists($Options{'m'})?$Options{'m'}:'';
	my $BaseDirectory=exists($Options{'b'})?$Options{'b'}:'.';
	my $NoRecursionFlag=exists($Options{'e'});
	my $AllowDirectoryCreateFlag=exists($Options{'p'});
	my $TestFlag=exists($Options{'t'});
	# Get from & to expressions
	my $FromExpression=shift @ARGV;
	my $ToExpression=shift @ARGV;
	# Display help
	if($HelpFlag||!defined($FromExpression)||
			!defined($ToExpression)||shift@ARGV)
	{	print "Recursive Regexp Rename, Version 7\n";
		print " by Andrew Hardwick.\n";
		print "Finds (recursively) & renames (& moves) files & directories.\n";
		print "Usage: rename <options> <From> <To>\n";
		print "  -h           = Print these instructions.\n";
		print "  -f           = Limit to files only (default = -fd).\n";
		print "  -d           = Limit to directories only (default = -fd).\n";
		print "  -n <Name>    = Limit to matching filenames.\n";
		print "  -m [egimosx] = Perl s&r modifiers (default = none).\n";
		print "  -b <Dir>     = Search within <Dir> directory (default = ".
				"'.').\n";
		print "  -e           = Do not recurse subdirectories.\n";
		print "  -p           = Allow directories creation.\n";
		print "  -t           = Test mode (does not make the changes).\n";
		print "<From>, <To> & <Name> are Perl regular expressions.\n";
		print "<To> can contain (escaped) '/' for (relative) directory.\n";
		exit;}
	# Find all files (store names indexed by path)
	my %FileNamesByPath;
	find(
		sub
		{	# Skip the base directory
			if($_ eq '.')
			{	return;}
			# Prevent decending into subdirectories if recursion is off
			if($NoRecursionFlag&&-d)
			{	$File::Find::prune=1;}
			# Add matching files & directories to the list to rename
			if(($FilesFlag&&-f||$DirectoriesFlag&&-d)&&/$NameExpression/)
			{	$FileNamesByPath{$File::Find::name}=$_;}}
		,$BaseDirectory);
	# Arrange file paths so deepest level done first
	# (Since paths to deeper levels may change with higher level directories
	#  being renamed. Doing it this way not simply by 'File::finddepth'
	#  because that not allow pruning unlike 'File::find'.)
	my @FilePaths=reverse(sort(keys %FileNamesByPath));
	# Rename the files
	my($NameOld,$NameNew,$DirectoryOld,$RelativeDirectoryNew);
	my $Do="/$FromExpression/$ToExpression/$Modifiers";
	foreach my $FilePathOld (@FilePaths)
	{	$NameNew=$NameOld=$FileNamesByPath{$FilePathOld};
		eval("\$NameNew=~s$Do;return 1;") or 
				die "Regexp Error:\n $Do\n$@\n";
		{	# Check for name changes
			unless($NameNew eq $NameOld)
			{	# Report it
				print "$FileNamesByPath{$FilePathOld}\n";
				print " From: $NameOld\n";
				print " To: $NameNew\n";
				# Do the renaming (subdirectory creation if required)
				unless($TestFlag)
				{	$FilePathOld=~/^(.*\/)/;
					$DirectoryOld=$1;
					# Create subdirectory if required
					if($AllowDirectoryCreateFlag&&$NameNew=~/^(.*)\//)
					{	$RelativeDirectoryNew=$1;
						print " Creating: $RelativeDirectoryNew/\n";
						unless(-d($DirectoryOld.$RelativeDirectoryNew))
						{	mkpath($DirectoryOld.$RelativeDirectoryNew);}}
					# Do the renaming
					rename($FilePathOld,$DirectoryOld.$NameNew) or
						print " Error: could not rename '$NameOld'".
								" to '$NameNew'.\n";}}}}}

###############################################################################