#!/usr/bin/perl
 # author: seth
 # e-mail: for e-mail-address see http://www.wg-karlsruhe.de/seth/email_address.php
 # description: renames files or directories using regexps
 # thx to m. hoermann for utf8 support and some ideas of additional features
 #
 # tab-size: 2
 
 use Cwd;
 use strict;
 use warnings;
 
 sub syntaxCheck{
 	my @params = @_;
 	my @path_splitted = split(/[\/\\]/, reverse($0));
 	my $prg_name = reverse($path_splitted[0]);
 	my $version = '1.23.20100130';
 	my $syntax = 'syntax: '.$prg_name.' findRE replaceRE [options]';
 	my $usage = 'renames (recursively) files using regexps
 
 '.$syntax.'
 
   findRE                 files to rename given by a regexp
   replaceRE              how to rename, i.e., s/findRE/replaceRE/ in perl syntax
   -c, --capitalize       Capitalize Every Word
   -d, --directories      rename files and directories (default: files only)
   -D, --Directories      rename directories only (default: files only)
   -m, --mtime            use $y, $mon, $d in replaceRE to insert modification
                           time
   -p, --path             while searching use full paths of files in findRE
                           (default: base filenames only)
                           for the sake of intuition this options automatically 
                           sets .*? as prefix and (?=[^\/]*\z) as suffix of
                           findRE
       --disable-auto     disables automatisms, i.e., 
                           1. automatically generated prefixes and suffixes
                              in findRE, when using --path, and
                           2. escaping of unescaped slashes in findRE, filesRE,
                              and replaceRE by backslashes
   -r, --recursive        for searching subdirectories recursively
   -t, --test             don\'t change anything, just print possible changes to
                           screen
   -u, --utf8             enable unicode support for input, output, and renaming
   -y  --tr               use tr/findRE/replaceRE/ instead of s/findRE/replaceRE/
   -F  --filesRE=s        restrict replacements to files given by regexp string s 
                           (default s=".", i.e., all files)
   -V, --version          display version and exit.
       --examples         show some examples of using this tool
 
 force overwriting:
   -p, --predictive=x     first look for possible overwriting or not...
                           x=0: rename, but skip files, which would be
                                overwritten, but shouldn\'t (depends on --force).
                           x=1: don\'t even start renaming, if files would be 
                                overwritten, that shouldn\'t (depends on --force).
                                (default)
   -f, --force            same as --force=1
   -f, --force=x          grade of forcing renaming
                           x=0: don\'t overwrite any files (default)
                           x=1: overwrite existing (but not already renamed)
                                files
                           x=2: overwrite even renamed files
 regexp-modifiers:
   -e, --emodifier        set e-modifier in RE, i.e., s/findRE/replaceRE/e
                           (maybe you should consider using --disable-auto if you
                            use slashes in replaceRE)
                           (don\'t combine this with parameter --tr)
   -g, --global           set g-modifier, i.e., rename as many times as possible,
                           i.e., s/findRE/replaceRE/g
                           (don\'t combine this with parameter --tr)
   -i, --ignorecase       set i-modifier, i.e., ignore case in findRE, i.e., 
                           s/findRE/replaceRE/i
                           (don\'t combine this with parameter --tr)
       --tr_c             use c-modifier (only if --tr is used), i.e., 
                          complement findRE.
       --tr_d             use d-modifier (only if --tr is used), i.e.,
                           delete found but unreplaced characters.
       --tr_s             use s-modifier (only if --tr is used), i.e.,
                           squash duplicate replaced characters.
 verbosity:
   -q, --silent           same as --verbose=0
   -v, --verbose          same as --verbose=1 (default)
   -vv,--very-verbose     same as --verbose=2
   -v, --verbose=x        grade of verbosity
                           x=0: no output
                           x=1: default output
                           x=2: much output
 
 examples: '.$prg_name.' "ASD" "asd"
             replaces _first_ occurrence of "ASD" by "asd" in all files, e.g.
             fooASDASD.txt -> fooasdASD (use -g for replacing all occurrences)'."\n".'
           '.$prg_name.' --examples
             shows more examples.'."\n";
 	my $examples ='
 '.$syntax.'
 
 examples: '.$prg_name.'
             displays help'."\n".'
           '.$prg_name.' "ASD" "asd"
             replaces _first_ occurrence of "ASD" by "asd" in all files, e.g.
             fooASDASD.txt -> fooasdASD'."\n".'
           '.$prg_name.' "ASD" "asd" -g
             replaces all occurrence of "ASD" by "asd" in all files, e.g.
             fooASDASD.txt -> fooasdasd'."\n".'
           '.$prg_name.' "(.)" "\u$1"
             sets _first_ character to upper case (use -g for all)'."\n".'
           '.$prg_name.' ".*cd(\d+)/([^/]+)$" "$1$2" --path -r
             uses full path, i.e., renames ...cd01/title.ogg to
             ...cd01/01title.ogg and so on (no files will be moved to another
             directory)'."\n".'
           '.$prg_name.' "(/d)(/d)" "$2$1" -gr
             exchanges digits of numbers in all filenames recursively'."\n".'
           '.$prg_name.' "(error_log\.)\d+(\.gz)" "$1$y-$mon-$d$2" --mtime
             e.g. errog_log.10.gz -> error_log.2007-07-07.gz'."\n".'
           '.$prg_name.' -rt _dir -dir
             be careful and respect the parameter order.
             this will replace "-rt" by "_dir" using parameters d, i, and r'."\n".'
           '.$prg_name.' "foo(\d\d)" "\'bar\'.($1+42)" -ert
             prints the result of replacing e.g. "foo10" by "bar52" recursively,
             but doesn\'t really change filenames.'."\n".'
           '.$prg_name.' "(\p{Cyrillic}+)" "\U$1" -drug
             uppercase all cyrillic letters of files and directories in this 
             directory and all subdirectories.'."\n".'
           '.$prg_name.' "xy" "yx" --tr -F="foo_x=\d+_y=\d+"
             use tr/xy/yx/ on all files that match /foo_x=\d+_y=\d+/, i.e., 
             switch the letters "x" and "y" in all of those files.'."\n".'
 note that in linux you have to use single quotes instead of double quotes.
 alternatively you can mask the dollar-signs etc. '."\n";
 	my $version_info = 'ren_ext.pl '.$version."\n".'
 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.'."\n".'
 originally written by seth (for e-mail-address see
 http://www.wg-karlsruhe.de/seth/email_address.php ).'."\n";
 	my $syntax_correct = 0;
 	my %param_hash;
 	# default values
 	$param_hash{'capitalize'} = 0;  # capitalize names
 	$param_hash{'directories'} = 0; # rename dirs
 	$param_hash{'emodifier'} = 0;   # s///e
 	$param_hash{'cmodifier'} = 0;   # y///c
 	$param_hash{'dmodifier'} = 0;   # y///d
 	$param_hash{'smodifier'} = 0;   # y///s
 	$param_hash{'auto'} = 1;        # automatisms
 	$param_hash{'examples'} = 0;    # diplay examples and exit
 	$param_hash{'files'} = 1;       # rename files
 	$param_hash{'filesRE'} = '.';   # RE for files to apply on
 	$param_hash{'force'} = 0;       # force; grade of forcing renaming
 	$param_hash{'fullpath'} = 0;    # use full path instead of filenames only
 	$param_hash{'global'} = 0;      # s///g
 	$param_hash{'ignorecase'} = 0;  # s///i
 	$param_hash{'mtime'} = 0;       # use modification time in replaceRE
 	$param_hash{'predictive'} = 1;  # predictive; look-ahead, and break before start, if necessary
 	$param_hash{'recursively'} = 0; # search subdirs
 	$param_hash{'test'} = 0;        # show result only (without renaming)
 	$param_hash{'tr'} = 0;          # tr/// instead of s///
 	$param_hash{'utf8'} = 0;        # interpret regexps and file names as unicode
 	$param_hash{'verbose'} = 1;     # trace; grade of verbosity
 	$param_hash{'version'} = 0;     # diplay version and exit
 	if(defined($params[1])){
 		$param_hash{'findRE'} = shift(@params);
 		$param_hash{'replaceRE'} = shift(@params);
 		$syntax_correct = 1;
 		$syntax_correct = (@params==0)? 1 : preparse_options(\@params) if $syntax_correct;
 		my $v_counter = 0; # counter for -vv = -v -v = --very-verbose
 		for(@params){
 			if($_ eq '-c' || $_ eq '--capitalize'){
 				$param_hash{'capitalize'} = 1;
 				next;
 			}
 			if($_ eq '-d' || $_ eq '--directory'){
 				$param_hash{'directories'} = 1;
 				next;
 			}
 			if($_ eq '--disable-auto'){
 				$param_hash{'auto'} = 0;
 				next;
 			}
 			if($_ eq '--examples'){
 				$param_hash{'examples'} = 1;
 				next;
 			}
 			if($_ eq '-D' || $_ eq '--Directory'){
 				$param_hash{'directories'} = 1;
 				$param_hash{'files'} = 0;
 				next;
 			}
 			if($_=~/^-(?:F|-filesRE)=(.*)$/){
 				$param_hash{'filesRE'} = $1;
 				next;
 			}
 			if($_ eq '-m' || $_ eq '--mtime'){
 				$param_hash{'mtime'} = 1;
 				next;
 			}
 			if($_ eq '-p' || $_ eq '--path'){
 				$param_hash{'fullpath'} = 1;
 				next;
 			}
 			if($_ eq '-r' || $_=~/--recursive(?:ly)?/){
 				$param_hash{'recursively'} = 1;
 				next;
 			}
 			if($_ eq '-t' || $_ eq '--test'){
 				$param_hash{'test'} = 1;
 				next;
 			}
 			if($_ eq '-y' || $_ eq '--tr'){
 				$param_hash{'tr'} = 1;
 				next;
 			}
 			if($_ eq '-u' || $_ eq '--utf8'){
 				$param_hash{'utf8'} = 1;
 				next;
 			}
 			if($_ eq '-V' || $_ eq '--version'){
 				$param_hash{'version'} = 1;
 				next;
 			}
 			# force overwriting
 			if($_=~/^-(?:p[= ]?|-predictive=)([01])$/){
 				$param_hash{'predictive'} = $1;
 				next;
 			}
 			if($_ eq '-f' || $_ eq '--force'){
 				$param_hash{'force'} = 1;
 				next;
 			}
 			if($_=~/^-(?:f[= ]?|-force=)([012])$/){
 				$param_hash{'force'} = $1;
 				next;
 			}
 			# modifiers
 			if($_ eq '-e' || $_ eq '--emodifier'){
 				$param_hash{'emodifier'} = 1;
 				next;
 			}
 			if($_ eq '-g' || $_ eq '--global'){
 				$param_hash{'global'} = 1;
 				next;
 			}
 			if($_ eq '-i' || $_ eq '--ignorecase'){
 				$param_hash{'ignorecase'} = 1;
 				next;
 			}
 			if($_ eq '--tr_c'){
 				$param_hash{'cmodifier'} = 1;
 				next;
 			}
 			if($_ eq '--tr_d'){
 				$param_hash{'dmodifier'} = 1;
 				next;
 			}
 			if($_ eq '--tr_s'){
 				$param_hash{'smodifier'} = 1;
 				next;
 			}
 			# verbosity
 			if($_ eq '-q' || $_ eq '--silent'){
 				$param_hash{'verbose'} = 0;
 				next;
 			}
 			if($_=~/^-(?:v|-verbose)$/){
 				$param_hash{'verbose'} = ++$v_counter;
 				next;
 			}
 			if($_=~/^--very-verbose$/){
 				$param_hash{'verbose'} = 2;
 				next;
 			}
 			if($_=~/^-(?:v[= ]?|-verbose=)([012])$/){
 				$param_hash{'verbose'} = $1;
 				next;
 			} # else
 			$syntax_correct = 0;
 			last;
 		}
 		# check for unvalid combinations
 		if(      $param_hash{'tr'} 
 					&& ($param_hash{'emodifier'} || $param_hash{'global'} || $param_hash{'ignorecase'})
 			 ||   !$param_hash{'tr'}
 					&& ($param_hash{'cmodifier'} || $param_hash{'dmodifier'} || $param_hash{'smodifier'})
 			){
 			die " error: don\'t mix up the modifiers. use s///eig or tr///cds. see help: $prg_name --help\n";
 		}
 	}
 	if(    $param_hash{'version'}
 			|| (defined($params[0]) && !defined($params[1]) && $params[0] =~ '^(-V|--version)$')){
 		die $version_info;
 	}elsif($param_hash{'examples'}
 			|| (defined($params[0]) && !defined($params[1]) && $params[0] eq '--examples')){
 		die $examples;
 	}else{
 		$syntax_correct || die $usage;
 	}
 	return %param_hash;
 }
 
 sub preparse_options{
 	# yeah, i know that at CPAN there already exist many get-opt-modules.
 	my $unparsed_params = shift;
 	my @params = ();
 	my $l = '[a-zA-Z]';           # leading char of long param      (--Xooo)
 	my $n = '[a-zA-Z_-]';         # non-leading char of long param  (--oXXX)
 	my $p = '.';                  # param of param                  (--oooo=X or -o=X)
 	my $s = '[a-zA-Z]';           # short params                    (-X)
 	my $waiting_for_param_param = 0;
 	my $syntax_check = 1;
 	my $param_param;
 	for my $param (@$unparsed_params){
 		if($param =~ /^--$l$n+(?:=$p+)?\z/){  # long param
 			push @params, $param;
 			$waiting_for_param_param = 0;
 		}elsif($param =~ /-($s*)($s=$p+)\z/){ # short param with param
 			$param_param = $2;
 			push @params, grep s/^/-/, split /(?=$s)/, $1;
 			push @params, '-'.$param_param;
 			$waiting_for_param_param = 0;
 		}elsif($param =~ /-$s+\z/){          # short param w/o param
 			push @params, grep s/^/-/, split /(?=$s)/, substr($param, 1);
 			$waiting_for_param_param = 1;
 		}elsif($waiting_for_param_param==1){  # separated param of param
 			$params[$#params].='='.$param;
 			$waiting_for_param_param = 0;
 		}else{
 			$syntax_check = 0;
 			last;
 		}
 	}
 	@{$unparsed_params} = @params;
 	return ($syntax_check, @params);
 }
 
 sub capitalize{
 	my $s = shift;
 	$s = lc($s);
 	$s=~s/\b(\w)/\u$1/g;     # capitalize all words
 	$s=~s/\.(\w+)\z/.\l$1/g; # decapitalize file-extension
 	return $s;
 }
 
 sub get_time_of_entry{
 	my $file = shift;
 	my $file_stat = (stat($file))[9];
 	my @filetime  = localtime($file_stat);
 	my $year  = sprintf "%04u", $filetime[5]+1900;
 	my $month = sprintf "%02u", $filetime[4]+1;
 	my $day   = sprintf "%02u", $filetime[3];
 	return ($year, $month, $day);
 }
 
 sub decode_utf8{
 	my $bytes = shift;
 	utf8::decode($$bytes)
 		or die 'invalid utf-8 encountered (try omitting option -u or --utf8 respectively)';
 }
 
 sub generate_searchreplace_string{
 	my $params = shift;
 	return ''.($$params{'tr'} ? 'tr' : 's').'/'.$$params{'findRE'}.'/'.$$params{'replaceRE'}.'/'.$$params{'emodifier'}.$$params{'ignorecase'}.$$params{'global'}.$$params{'cmodifier'}.$$params{'dmodifier'}.$$params{'smodifier'};
 }
 
 sub is_win{
 	return $^O=~/win/i;
 }
 
 sub get_fullpath{
 	my $filename = shift;
 	my $fullpath = Cwd::abs_path($filename);
 	$fullpath=~s/\//\\/g if(-d $filename && is_win());
 	return $fullpath;
 }
 
 sub check_target_filename{
 	my $filename = shift;
 	if($filename=~/\\/ && is_win() || $filename=~/\//){
 		my $output = shift;
 		my $params = shift;
 		print "error: operation not allowed!\n";
 		print ' '.$output."\"\n";
 		print ' slashes "/" (and in windows backslashes "\", too) are not allowed in target filenames'."\n";
 		print ' files can be renamed only, they can\'t be moved to other directories with this tool.'."\n";
 		print " findRE or replaceRE seem to be unvalid!.\n";
 		if($$params{'fullpath'} && $$params{'findRE'}!~/\^?\.\*/){
 			print ' maybe you want to try'."\n";
 			print '  findRE = .*'.$$params{'findRE'}."\n";
 		}
 		die 'program aborted.';
 	}
 }
 
 sub rename_files_addon{
 	my $working_dir = shift;
 	my $overwrite   = shift;
 	my $params      = shift;
 	my $findRE      = $$params{'findRE'};
 	my $filesRE     = $$params{'filesRE'};
 	my $replaceRE   = $$params{'replaceRE'};
 	my $ren_dirs    = $$params{'directories'};
 	my $ren_files   = $$params{'files'};
 	my $capitalize  = $$params{'capitalize'};
 	my $mtime       = $$params{'mtime'};
 	my $recursively = $$params{'recursively'};
 	my $test        = $$params{'test'};
 	my $tr          = $$params{'tr'};
 	my $force       = $$params{'force'};
 	my $fullpath    = $$params{'fullpath'};
 	my $ignorecase  = $$params{'ignorecase'};
 	my $prediction  = $$params{'prediction'};
 	my $utf8        = $$params{'utf8'};
 	my $verbose     = $$params{'verbose'};
 	my $output;
 	my $entry;
 	my $entry_filename;
 	my $exists;
 	my @entries_to_rename;
 	my $need_force;
 	my @renamed_entries;
 	my @dirs;
 	my $searchreplace_string = generate_searchreplace_string($params);
 	print "\n".'  '.$working_dir.'/'."\n" if $verbose>1;
 	opendir(DIR, ".") || die $working_dir.": $!"; # read_dir and generate renaming_array
 	while($entry_filename=readdir(DIR)){          # loop over directory entries
 		next if($entry_filename eq '.' || $entry_filename eq '..');
 		decode_utf8(\$entry_filename) if $utf8;
 		push(@dirs, $entry_filename) if -d $entry_filename;
 		if($fullpath){
 			$entry = get_fullpath($entry_filename);
 			decode_utf8(\$entry) if $utf8; 
 		}else{
 			$entry = $entry_filename;
 		}
 		if((($ren_dirs && -d $entry_filename) || ($ren_files && not -d $entry_filename)) 
 		  && $entry=~/$filesRE/ 
 		  &&( $tr
 		    || !$tr
 		    &&( ($ignorecase eq ''  && $entry=~/$findRE/) 
 		      ||($ignorecase eq 'i' && $entry=~/$findRE/i)
 			    )
 			  )
 			){                                        # if entry should be renamed
 			my ($y, $mon, $d) = get_time_of_entry($entry_filename) if $mtime==1;
 			print "\n".'  '.$working_dir.'/'."\n" if $verbose==1 && @entries_to_rename==0;
 			$output = 'rename: "'.$entry_filename;
 			print "'$entry'=~$searchreplace_string\n" if $verbose>2;
 			push(@entries_to_rename, $entry_filename);
 			eval('$entry=~'.$searchreplace_string);   # generate new file name
 			#$entry = substr $entry, length($`) if($fullpath && (!is_win() && -1<index($`, '/') || is_win() && -1<index($`, '\\')));
 			$entry = capitalize($entry) if $capitalize;
 			$output .= '" ==> "'.$entry;
 			check_target_filename($entry, $output, $params);
 			$need_force = 0;
 			# check for collisions
 			if((!is_win() && grep $_ eq $entry, @renamed_entries)
 				|| (is_win() && grep lc($_) eq lc($entry), @renamed_entries)
 				){                                      # if another file was already renamed to the same name
 				++$$overwrite{'newfiles'};
 				$output .= ' (another file '.(($force>1)? 'will' : 'would').' be renamed to this name already!)';
 				$need_force = 2;
 			}
 			if(-e $entry){                            # target file exists already
 				if($entry eq $entries_to_rename[-1]){   # old_name == new_name
 					$output .= ' (name unchanged)';
 				}elsif(is_win() && lc($entry) eq lc($entries_to_rename[-1])){
 					$output .= ' (changing case only)';   # case-change (win-only)
 				}else{
 					++$$overwrite{'existingfiles'};       # overwrite existing file?
 					$output .= ' (existing already! '.(($force>0)? 'will' : 'won\'t').' be overwritten.)';
 					$need_force = 1 if $need_force<1;
 				}
 			}
 			unless(-e $entry && $entry eq $entries_to_rename[-1] && $tr){
 				print $output."\"\n" if $verbose>0 && ($prediction==0 || $need_force>0) || $verbose>1;
 			}
 			if($force>=$need_force){
 				push(@renamed_entries, $entry);
 			}else{
 				pop(@entries_to_rename);
 			}
 		}else{
 			print 'skip: '.$entry."\n" if $verbose>1;
 		}
 	}
 	closedir(DIR);
 	@dirs = sort(@dirs);
 	if($recursively==1){        # first search subdirectories
 		for(@dirs){
 			chdir($_);
 			rename_files_addon($working_dir.'/'.$_, $overwrite, $params);
 			chdir('..');
 		}
 	}
 	if(!$test && !$prediction){ # after searching subdirectories begin renaming
 		for(my $i=0; $i<@entries_to_rename; ++$i){
 			rename($entries_to_rename[$i],$renamed_entries[$i]);
 		}
 	}
 }
 
 sub rename_files_using_regexps{
 	my %params = syntaxCheck(@_);
 	# postprocess params
 	if($params{'auto'}){
 		# escape unescaped slashes
 		$params{$_}=~s/(?<!\\)((?:\\\\)*)\//$1\\\//g for('findRE', 'replaceRE', 'filesRE');
 		# add prefix and suffix to findRE for intuitive fullpath searching
 		$params{findRE} = '.*?'.$params{findRE}.'(?=[^\/]*\z)' if $params{'fullpath'};
 	}
 	if($params{'utf8'}){
 		# enable unicode for both regular expressions ...
 		decode_utf8(\$params{$_})	for('findRE', 'replaceRE', 'filesRE');
 		# ... and for the screen output
 		binmode(STDOUT, ':utf8');
 		binmode(STDERR, ':utf8');
 	}
 	# bool2modifier 
 	$params{'cmodifier'}  = ($params{'cmodifier'}) ? 'c' : '';
 	$params{'dmodifier'}  = ($params{'dmodifier'}) ? 'd' : '';
 	$params{'emodifier'}  = ($params{'emodifier'}) ? 'e' : '';
 	$params{'smodifier'}  = ($params{'smodifier'}) ? 's' : '';
 	$params{'global'}     = ($params{'global'}) ? 'g' : '';
 	$params{'ignorecase'} = ($params{'ignorecase'}) ? 'i' : '';
 
 	my $working_dir = cwd;
 	decode_utf8(\$working_dir) if $params{'utf8'};
 	my %overwrite; # counting of overwritten files
 	$overwrite{'existingfiles'} = 0;
 	$overwrite{'newfiles'} = 0;
 	print ' using '.generate_searchreplace_string(\%params)."\n" if $params{'verbose'}>0;
 	if($params{'test'}==0 && $params{'predictive'}==1){        # if not just testing, predict collisions
 		print 'predicting changes/collisions...'."\n" if $params{'verbose'}>0;
 		$params{'prediction'} = 1;
 		rename_files_addon($working_dir, \%overwrite, \%params);
 		print 'number of collisions: '.($overwrite{'existingfiles'}+$overwrite{'newfiles'})."\n" if $params{'verbose'}>1;
 	}
 	if($overwrite{'existingfiles'}+$overwrite{'newfiles'}==0){ # call renaming-routine
 		print $params{'test'} ? "\ntesting...\n": "\nrenaming...\n" if $params{'verbose'}>0;
 		$params{'prediction'} = 0;
 		rename_files_addon($working_dir, \%overwrite, \%params);
 	}elsif($params{'verbose'}>0){
 		print $overwrite{'existingfiles'}.' existing and '.$overwrite{'newfiles'}.' new files would be overwritten.'."\n";
 	}
 	chdir($working_dir);
 }
 
 rename_files_using_regexps(@ARGV);