#!/usr/bin/perl
 # author: seth
 # e-mail: for e-mail-address see http://www.wg-karlsruhe.de/seth/email_address.php 
 # description: replaces strings in a text-file or a directory using regexps
 # textre means TEXT-REplacing (REcursively) by Regular Expressions
 #
 # tab-size: 2
 
 use strict;
 use warnings;
 use Cwd;
 
 sub syntaxCheck{
 	my @params = @_;
 	my @path_splitted = split(/[\/\\]/, reverse($0));
 	my $prg_name = reverse($path_splitted[0]);
 	my $version = '1.01.20110226';
 	my %param_hash;
 	# default values
 	$param_hash{'filesRE'} = '(\\.bas|\\.bat|\\.c|\\.cc|\\.cgi|\\.cpp|\\.css|\\.csv|\\.f|\\.h|\\.hpp|\\.html?|\\.js|\\.pas|\\.php\\d?|\\.pl|\\.tex|\\.txt|\\.vbs)$';
 	$param_hash{'ignorecase'} = 0;	# s///i (findRE)
 	$param_hash{'emodifier'} = 0;	  # s///e (findRE)
 	$param_hash{'icf'} = 0;					# s///i (filesRE)
 	$param_hash{'lowercase'} = 0;		# tr/[A-Z]/[a-z]/ and some umlauts too
 	$param_hash{'uppercase'} = 0;		# tr/[a-z]/[A-Z]/ and some umlauts too
 	$param_hash{'charwise'} = 0;		# read charwise (not linewise)
 	$param_hash{'linesRE'} = '.';   # lines to work at
 	$param_hash{'recursively'} = 0;	# search subdirs
 	$param_hash{'germanshit'} = 0;	# replace äÄöÖüÜß
 	$param_hash{'test'} = 0;				# show result only (without renaming)
 	$param_hash{'verbose'} = 1;			# trace; grade of verbosity
 	$param_hash{'version'} = 0;			# diplay version and exit
 	my $usage = 'replaces strings in a text-file or a directory using regexps
 
 syntax: '.$prg_name.' findRE replaceRE [options]
 
   findRE                   text to be replaced
   replaceRE                replacement
   -f, --filesRE=s          files to search (default="'.$param_hash{'filesRE'}.'")
   -c, --charwise           don\'t read files linewise (default), but charwise
   -e, --emodifier          use e-modifier in findRE, i.e., s///e
   -g, --germanshit         _after_ replacing, convert äÄöÖüÜß to ae, ..., ss
   -i, --ignorecase-find    ignore case in findRE
   -I, --ignorecase-files   ignore case in filesRE
   -l, --lower-case         _after_ replacing, convert _all_ to lower case
   -L, --lines=s            replace only in lines s, s is interpreted as a regexp, default = all lines
   -u, --upper-case         _after_ replacing, convert _all_ to upper case
   -r, --recursively        for search subdirectories recursively
   -t, --test               don\'t change anything, just print possible changes
   -V, --version            display version and exit.
   -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.' "bratwurst" "gruenkohl"
 
           '.$prg_name.' "Blutwurst" "salat" -l
 
           '.$prg_name.' "blutwurst" "salat" -i -l  (not the same as above)
 
           '.$prg_name.' "blutwurst" "salat" -L="^123$"
 
           '.$prg_name.' "(/d)(/d)" "$2$1" -f="(\\.htm|\\.txt)$" -r'."\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 $syntax_correct = 0;
 	if(defined($params[1])){
 		$param_hash{'findRE'} = shift(@params);
 		$param_hash{'replaceRE'} = shift(@params);
 		$syntax_correct = (@params==0)? 1 : preparse_options(\@params);
 		for(@params){
 			if($_ eq '-c' || $_ eq '--charwise'){
 				$param_hash{'charwise'} = 1;
 				next;
 			}
 			if($_=~/^-(?:f|-filesRE)=(.*)$/){
 				$param_hash{'filesRE'} = $1;
 				next;
 			}
 			if($_ eq '-e' || $_ eq '--emodifier'){
 				$param_hash{'emodifier'} = 1;
 				next;
 			}
 			if($_ eq '-g' || $_ eq '--germanshit'){
 				$param_hash{'germanshit'} = 1;
 				next;
 			}
 			if($_ eq '-i' || $_ eq '--ignorecase-find'){
 				$param_hash{'ignorecase'} = 1;
 				next;
 			}
 			if($_ eq '-I' || $_ eq '--ignorecase-files'){
 				$param_hash{'icf'} = 1;
 				next;
 			}
 			if($_ eq '-l' || $_ eq '--lower-case'){
 				$param_hash{'lowercase'} = 1;
 				die 'error: conversion to lowercase _and_ uppercase not possible!'."\n" if($param_hash{'uppercase'});
 				next;
 			}
 			if($_=~/^-(?:L|-lines)=(.*)$/){
 				$param_hash{'linesRE'} = $1;
 				next;
 			}
 			if($_ eq '-r' || $_=~/--recursive(?:ly)?/){
 				$param_hash{'recursively'} = 1;
 				next;
 			}
 			if($_ eq '-t' || $_ eq '--test'){
 				$param_hash{'test'} = 1;
 				next;
 			}
 			if($_ eq '-u' || $_ eq '--upper-case'){
 				$param_hash{'uppercase'} = 1;
 				die 'error: conversion to lowercase _and_ uppercase not possible!'."\n" if($param_hash{'lowercase'});
 				next;
 			}
 			if($_ eq '-V' || $_ eq '--version'){
 				$param_hash{'version'} = 1;
 				next;
 			}
 			# verbosity
 			if($_ eq '-q' || $_ eq '--silent'){
 				$param_hash{'verbose'} = 0;
 				next;
 			}
 			if($_=~/^-(?:v|-verbose)$/){
 				$param_hash{'verbose'} = 1;
 				next;
 			}
 			if($_=~/^-(?:vv|-very-verbose)$/){
 				$param_hash{'verbose'} = 2;
 				next;
 			}
 			if($_=~/^-(?:v|-verbose)=([0123])$/){
 				$param_hash{'verbose'} = $1;
 				next;
 			} # else
 			$syntax_correct = 0;
 			last;
 		}
 	}
 	if($param_hash{'version'} || (defined($params[0]) && !defined($params[1]) && $params[0] =~ '^(-V|--version)$')){
 		my $version_info = 'textre.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.
 
 originally written by (and suggestions to) seth (for e-mail-address see http://www.wg-karlsruhe.de/seth/email_address.php).'."\n";
 		die $version_info;
 	}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;
 }
 
 sub log10{
 	my $n = shift;
 	return ($n<=0)?0:log($n)/log(10);
 }
 sub max{
 	my $a = shift;
 	my $b = shift;
 	return ($a>$b)?$a:$b;
 }
 sub vernichte_bloede_deutsche_umlaute_und_sz{
 	my $str = shift;
 	$str=~s/ä/ae/g;
 	$str=~s/Ä/Ae/g;
 	$str=~s/ö/oe/g;
 	$str=~s/Ö/Oe/g;
 	$str=~s/ü/ue/g;
 	$str=~s/Ü/Ue/g;
 	$str=~s/ß/ss/g;
 	return $str;
 }
 
 sub loadFile{
 	my $infile = shift;
 	open(INFILE, "<".$infile) || die "error: $!\n";
 		my @lines = <INFILE>;
 	close(INFILE);
 	return @lines;
 }
 sub loadFile_charwise{
 	my $infile = shift;
 	my $content = '';
 	open(INFILE, "<".$infile) || die "error: $!\n";
 		while(!eof(INFILE)){
 			$content.=getc(INFILE);
 		}
 	close(INFILE);
 	return $content;
 }
 sub saveFile{
 	my $outfile = shift;
 	print "write file ".$outfile."\n";
 	open(OUTFILE, ">".$outfile) || die " could not write file. $!\n";
 		print OUTFILE @_;
 	close(OUTFILE);
 	return 1;
 }
 
 # core
 sub search_file{
 	my $flag_dir_printed = shift;
 	my $work_dir = shift;
 	my $file = shift;
 	my $params = shift;
 	my $findRE = $$params{'findRE'};
 	my $linesRE = $$params{'linesRE'};
 	my $replaceRE = $$params{'replaceRE'};
 	my $ignorecase = ($$params{'ignorecase'})?'i':'';
 	my $emodifier = ($$params{'emodifier'})?'e':'';
 	my $verbose = $$params{'verbose'};
 	my $charwise = $$params{'charwise'}; # not used yet
 	my %counter = ('lines'=>0, 'changed_lines'=>0, 'changes'=>0);
 
 	if($charwise==1){
 		my $file_content = loadFile_charwise($file);
 		my $file_new_content = '';
 		my $found_str;
 		my $len;
 		my $old_pos = 0;
 		my $after_matched;
 		while($ignorecase eq 'i' && $file_content=~/$findRE/ig || $ignorecase ne 'i' && $file_content=~/$findRE/g){
 			print $work_dir.$file."\n" if($counter{'changes'}==0 && $verbose>0);
 			$$flag_dir_printed = 1;
 			++$counter{'changes'};
 			$found_str = $&;
 			$after_matched = $';
 			$len = length($found_str);
 			$file_new_content.=substr($file_content, $old_pos, pos($file_content)-$len-$old_pos);
 			$old_pos = pos($file_content);
 			print ' orig: '.$found_str."\n" if($verbose>0);
 			eval('$found_str=~s/'.$findRE.'/'.$replaceRE.'/'.$ignorecase.$emodifier);
 			print ' new:  '.$found_str."\n" if($verbose>0);
 			$file_new_content.=$found_str;
 		}
 		if($counter{'changes'}>0){
 			$file_content = $file_new_content.$after_matched;
 			$file_content = uc($file_content) if($$params{'uppercase'}==1);
 			$file_content = lc($file_content) if($$params{'lowercase'}==1);
 			$file_content = vernichte_bloede_deutsche_umlaute_und_sz($file_content) if($$params{'germanshit'}==1);
 			print ' '.$counter{'changes'}.' changes'."\n" if($verbose>0);
 			saveFile($file, $file_content) if($$params{'test'}==0);
 		}
 	}else{ # linewise
 		my @lines = loadFile($file);
 		my $loglines = int(log10($#lines+1)+1);
 		for(@lines){
 			++$counter{'lines'};
 			if($counter{'lines'} =~ /$linesRE/
 					&& (
 					     ($ignorecase eq 'i' && $_=~/$findRE/i)
 					  || ($ignorecase eq ''  && $_=~/$findRE/ )
 					)
 				){
 				print $work_dir.$file."\n" if($counter{'changed_lines'}==0 && $verbose>0);
 				$$flag_dir_printed = 1;
 				printf('%0'.max($loglines, 2).'d: ', $counter{'lines'}) if($verbose>0);
 				print $_ if($verbose>0);
 				++$counter{'changed_lines'};
 				eval('$_ =~ s/'.$findRE.'/'.$replaceRE.'/'.$ignorecase.'g'.$emodifier);
 				print ' ' x (max(0,$loglines-2)).'->: '.$_ if($verbose>0);
 			}
 			$_ = uc($_) if($$params{'uppercase'}==1);
 			$_ = lc($_) if($$params{'lowercase'}==1);
 			$_ = vernichte_bloede_deutsche_umlaute_und_sz($_) if($$params{'germanshit'}==1);
 		}
 		if($counter{'changed_lines'}>0){
 			print ' '.$counter{'changed_lines'}.' lines replaced'."\n" if($verbose>0);
 			saveFile($file, @lines) if($$params{'test'}==0);
 		}
 	}
 	return %counter;
 }
 
 sub text_replacer{
 	my $counter = shift;
 	my $working_dir = shift;
 	my $params = shift;
 	my $filesRE = $$params{'filesRE'};
 	my $icf = ($$params{'icf'})?'i':'';
 	my $recursively = $$params{'recursively'};
 	my $verbose = $$params{'verbose'};
 	my $entry;
 	my @dirs;
 	print "\n\n".'  '.$working_dir.'/'."\n" if $verbose>1;
 	opendir(DIR, ".") || die $working_dir.": $!"; # read_dir and generate renaming_array
 	my $flag_first_search = 1;
 	my $flag_first_skip = 1;
 	my $flag_dir_printed = 0;
 	my %counter_present;
 	my $work_dir;
 	my @entries = sort(readdir(DIR)); # cosmetics
 	closedir(DIR);
 	for $entry (@entries){
 		if(-d $entry){
 			push(@dirs, $entry);
 		}else{
 			if( (($icf eq '' && $entry=~/$filesRE/) || ($icf eq 'i' && $entry=~/$filesRE/i)) ){
 				$work_dir = ($verbose==1 && $flag_dir_printed==0)?"\n".'  '.$working_dir.'/'."\n":"\n";
 				print 'search:' if $verbose>1 && $flag_first_search++;
 				print ' "'.$entry.'"' if $verbose>1;
 				++$$counter{'files'};
 				%counter_present = &search_file(\$flag_dir_printed, $work_dir, $entry, $params);
 				$$counter{'changed_files'}+=($counter_present{'changed_lines'}+$counter_present{'changes'}>0);
 				$$counter{'lines'}+=$counter_present{'lines'};
 				$$counter{'changed_lines'}+=$counter_present{'changed_lines'};
 				$$counter{'changes'}+=$counter_present{'changes'};
 			}else{
 				print 'skip:' if $verbose>2 && $flag_first_skip++;
 				print ' "'.$entry.'"' if $verbose>1;
 			}
 		}
 	}
 	# @dirs = sort(@dirs); # not necessary
 	if($recursively==1){ # search subdirectories
 		for(@dirs){
 			if($_ ne '.' && $_ ne '..'){
 				chdir($_);
 				++$$counter{'dir'};
 				text_replacer($counter, $working_dir.'/'.$_, $params);
 				chdir('..');
 			}
 		}
 	}
 }
 
 sub stats{
 	my %counter = %{shift()};
 	my $params = shift;
 	print "\n".'stats:'."\n";
 	print ' searched: '.$counter{'dir'}.' dirs, '.$counter{'files'}.' files';
 	print ', '.$counter{'lines'}.' lines' if($$params{'charwise'}==0);
 	print "\n";
 	print ' changed:  '.$counter{'changed_files'}.' files, ';
 	print (($$params{'charwise'}==0)? $counter{'changed_lines'}.' lines' : $counter{'changes'}.' places');
 	print "\n";
 	print '(case-changing not included)'."\n" if($$params{'lowercase'}|$$params{'uppercase'});
 }
 
 sub text_replacing_using_regexps{
 	my %params = syntaxCheck(@_);		# command line parameters
 	my $working_dir = cwd;
 	my %counter;
 	$counter{'dir'} = 1;						# number of searched directories
 	$counter{'files'} = 0;					# number of searched files
 	$counter{'lines'} = 0;					# number of searched lines
 	$counter{'changed_files'} = 0;	# number of changed files
 	$counter{'changed_lines'} = 0;	# number of changed lines
 	$counter{'changes'} = 0;				# number of changes
 	text_replacer(\%counter, $working_dir, \%params);
 	chdir($working_dir);
 	stats(\%counter, \%params) if $params{'verbose'}>0;
 }
 
 text_replacing_using_regexps(@ARGV);