#!/usr/bin/perl -w

my $progname = $0; $progname =~ s|.*/||;
my $usage = <<EOU;
$progname [-p] [-s] [-h] [-q] [-r] [--force] -g=pattern match-string [ replace-string ] [ directory ]

-p         replace prefix (default)
-s         replace suffix
--force    force clobber of existing files with new name
-h         print this usage
-g=pattern uses search/replace pattern in files with match-string as prefix/suffix
-q         be quiet, suppress warnings
-r         allow regexp match in match-string

match-string     match this string in prefix/suffix of filename
replace-string   optionally replace match-string with this string
directory        directory where replacement should occur (default: .)

EOU

## command line processing

if ($#ARGV < 0) { die $usage; }

$prefix = 0;
$suffix = 0;
$regexp = 0;
$force  = 0;
$quiet  = 0;
$pattern = '';

while ($ARGV[0] =~ /^-/) {
    $prefix          = 1  if ($ARGV[0] eq '-p');
    $suffix          = 1  if ($ARGV[0] eq '-s');
    $regexp          = 1  if ($ARGV[0] eq '-r');
    $force           = 1  if ($ARGV[0] eq '--force');
    $quiet           = 1  if ($ARGV[0] eq '-q');
    $pattern         = $1 if ($ARGV[0] =~ /^-g=(.*)$/);
    die $usage if ($ARGV[0] eq '-h');
    shift(@ARGV); 
}

if (($prefix == 1) and ($suffix == 1)) {
    die $usage;
}

# set prefix as default
if (($prefix == 0) and ($suffix == 0)) {
    $prefix = 1;
}

$match = shift(@ARGV) or die $usage; 
$repl = shift(@ARGV) or $repl = '';
$dir = shift(@ARGV) or $dir = '.';

if ($prefix) { $type = "prefix"; }
else { $type = "suffix"; }
print STDERR "replacing $type ($match) with ($repl)\n"
    if (! $quiet);

$status = 0;
die "$dir is not a directory\n" if (!(-d $dir));
opendir(D, $dir) or $status = 1;
if ($status) { print STDERR "$dir is not a valid directory\n"; die; }
while (($base = readdir(D))) {
    next if ($base =~ /^\./);
    $filename = $dir . "/" . $base;
    if ((-d $filename) || (-l $filename)) {
	next;
    }
    if ($regexp ? ($base =~ /$match/) : ($base =~ /\Q$match\E/)) {
	$newname = $base;
	if ($pattern ne '') {
	    my $pat = '$newname =~ ' . $pattern . ';';
	    eval $pat;
	} else {
	    if ($prefix) {
		$regexp ? ($newname =~ s/^$match/$repl/) :
		    ($newname =~ s/^\Q$match\E/$repl/);
	    } else {
		$regexp ? ($newname =~ s/$match$/$repl/) :
		    ($newname =~ s/\Q$match\E$/$repl/);
	    }
	}
	if ($base eq $newname) {
	    next;
	} elsif ((-f $newname) and (! $force)) { 
	    print STDERR "$newname already exists, not renaming $base to $newname: use --force\n"; 
        } else { 
	    print STDERR "replacing file ($base) with ($newname)\n"
		if (! $quiet); 
	    rename $base, $newname; 
        }
    }
}
closedir(D);
print STDERR "done.\n" 
    if (! $quiet);