# Perl script to rename multiple files on Windows
#
# Usage --
#
# First make sure you have a copy of the files somewhere
# with their original names, in case something goes wrong.
#
# Assuming this script is in the same folder as the files
# to be renamed, from a command prompt, enter
#
#	perl -w rename-pl.txt --prefix TEelk67 --suffix .JPG I*
#
# For each file that matches I*, this will prompt for a new name.
# Enter the new name without the prefix or suffix (TEelk67 and .JPG
# in this example).  If you enter Nb, this will rename the file
# TEelk67Nb.JPG
#
# If you enter nothing, the script will skip that file.
# If you enter q, it will exit with no change to that file.
#
# In some cases, you can rename the files without being prompted,
# by using the --standard option.
# For example,
#	perl -w rename-pl.txt --prefix TEelk67 --suffix .JPG --standard I*
#
# This will rename the next 8 files that match I* to
#	TEelk67Na
#	TEelk67Nb
#	TEelk67Ea
#	TEelk67Eb
#	TEelk67Sa
#	TEelk67Sb
#	TEelk67Wa
#	TEelk67Wb
#
# The --standard option will force the script to
# quit after renaming 8 files.  If there are less than 8 specified
# on the command line, it will rename those few and quit,
# e.g. if I* in the above example matches 7 files instead of 8.
#

use File::Glob ':glob';
use Fcntl;

#----------------------------(  promptUser  )-----------------------------#
#                                                                         #
#  FUNCTION:	promptUser                                                #
#                                                                         #
#  PURPOSE:	Prompt the user for some type of input, and return the    #
#		input back to the calling program.                        #
#                                                                         #
#  ARGS:	$promptString - what you want to prompt the user with     #
#		$defaultValue - (optional) a default value for the prompt #
#                                                                         #
#-------------------------------------------------------------------------#

sub promptUser {

   #-------------------------------------------------------------------#
   #  two possible input arguments - $promptString, and $defaultValue  #
   #  make the input arguments local variables.                        #
   #-------------------------------------------------------------------#

   local($promptString,$defaultValue) = @_;

   #-------------------------------------------------------------------#
   #  if there is a default value, use the first print statement; if   #
   #  no default is provided, print the second string.                 #
   #-------------------------------------------------------------------#

   if ($defaultValue) {
      print $promptString, "[", $defaultValue, "]: ";
   } else {
      print $promptString, ": ";
   }

   $| = 1;               # force a flush after our print
   $_ = <STDIN>;         # get the input from STDIN (presumably the keyboard)


   #------------------------------------------------------------------#
   # remove the newline character from the end of the input the user  #
   # gave us.                                                         #
   #------------------------------------------------------------------#

   chomp;

   #-----------------------------------------------------------------#
   #  if we had a $default value, and the user gave us input, then   #
   #  return the input; if we had a default, and they gave us no     #
   #  no input, return the $defaultValue.                            #
   #                                                                 # 
   #  if we did not have a default value, then just return whatever  #
   #  the user gave us.  if they just hit the <enter> key,           #
   #  the calling routine will have to deal with that.               #
   #-----------------------------------------------------------------#

   if (defined($defaultValue) && "$defaultValue") {
      return $_ ? $_ : $defaultValue;    # return $_ if it has a value
   } else {
      return $_;
   }
}

$debug = 0;
$prefix = "";
$suffix = "";
$standard = 0;
@std_names = qw/Na Nb Ea Eb Sa Sb Wa Wb/;
$std_name_index = 0;

while (@ARGV+0 && $ARGV[0] =~ /^-/) {
	my $aa = $ARGV[0];
	last if $aa eq '--';
	if ($aa eq '--prefix') {
		$prefix = $ARGV[1];
		shift @ARGV;
		shift @ARGV;
	}
	elsif ($aa eq '--suffix') {
		$suffix = $ARGV[1];
		shift @ARGV;
		shift @ARGV;
	}

	elsif ($aa eq '-d') {
		$debug = 1;
		shift @ARGV;
	}
	elsif ($aa eq '--standard') {
		$standard = 1;
		shift @ARGV;
	}
}


while ($oldname = shift) {
	#$x = `dir I*`;
	#print "x=$x\n";
	@list = File::Glob::bsd_glob($oldname);
	#print "list = ", join(",",@list), "\n";
	foreach (@list) {
		$oldname = $_;
		$newname = $standard ? $std_names[$std_name_index++] 
			: promptUser("old name '$oldname' | new name ", "");
		if (!defined($newname)) {
			print "end of list of standard names";
			exit 0;
		}
		if ($newname eq "") {
			print "skipping $oldname\n";
			next;
		}
		if ($newname eq "q") {
			exit 0;
		}
		$nn = "$prefix$newname$suffix";
		print "renaming '$oldname' to '$nn'\n";
		system("rename", "$oldname", "$nn");
		#system("dir", "$nn");
		#exit 0;
		print "\n";
	}
}