#!/usr/bin/perl -w
##############################################################################
# Move multiple files
# Author: Chris Rouch
# Date: 1998-2003
# Copyright (c) Chris Rouch 1998-2003
#
#     This program is free software; you can redistribute it and/or modify
#     it under the terms of the GNU General Public License as published by
#     the Free Software Foundation; either version 2 of the License, or
#     (at your option) any later version.
#
#     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.  See the
#     GNU General Public License for more details.
#
#     You should have received a copy of the GNU General Public License
#     along with this program; if not, write to the Free Software
#     Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
#     or see http://www.gnu.org/licenses/gpl.txt
##############################################################################
use strict;
use Getopt::Long;

# general global variables
my ($PROG,$USAGE,$OPTIONS);
use vars qw($old $new @files $oldfile $base $basedir @dirs $subdir $i);
# constants
use constant OKCHARS=> '[^\d\w/.-]+';

# command line variables
my $dir;		# also rename directories
my $lower;		# force lower case
my $upper;		# force upper case
my $nice;		# force 'nice' characters
my $verbose;		# make some noise
my $all;		# global replace
my $quote;		# quote metechars

# command line switch
my %opts=
(
 "a|all" => \$all,
 "d|dir" => \$dir,
 "l|lower" => \$lower,
 "u|upper" => \$upper,
 "n|nice" => \$nice,
 "v|verbose" => \$verbose,
 "q|quote" => \$quote,
);
($PROG=$0) =~ s#.*/##;
SetUsage(\%opts,\$OPTIONS);
$USAGE="Usage: $PROG $OPTIONS old new";
die "$USAGE\n" unless GetOptions(%opts);
# program begins here
if ((!$upper) and (!$lower) and (!$nice)) {
    if ($#ARGV >=2) {
	$old=shift(@ARGV);
	$new=shift(@ARGV);
	if ($quote) {
	    $old=quotemeta($old);
	    $new=quotemeta($new);
	}
    }
    else {
	die "$USAGE\n";
    }
}
# else upper, lower or nice
@files=@ARGV;
foreach my $file (@files) {
    next unless ((-f $file or -d $file));
    $oldfile=$file;
    if ($dir) {
	# change dir as well
	if (defined($new)) {
	    if ($all) {
		$file=~s/$old/$new/g;
	    }
	    else {
		$file=~s/$old/$new/;
	    }
	}
	$file = "\U$file" if ($upper);
	$file = "\L$file" if ($lower);
	$file =~ s!@{[OKCHARS]}!_!g if ($nice);
    }
    else {
	# don't change dir as well
	($base=$file) =~ s!.*/!!;
	($basedir=$file) =~ s!^(.*/).*$!$1!;
	$basedir='' if ($basedir eq $file); # no slash
# 	print "$basedir, $base\n";
	if (defined($new)) {
	    if ($all) {
		$base=~s/$old/$new/g;
	    }
	    else {
		$base=~s/$old/$new/;
	    }
	}
	$base = "\U$base" if ($upper);
	$base = "\L$base" if ($lower);
	$file = $basedir . $base
    }
    $file =~ s!@{[OKCHARS]}!_!g if ($nice);
    print "mv $oldfile $file\n";
    if ( -f "$file" ) {
	print "Will not overwrite $file \n";
	next;
    }
    MakeTargetDir($file);
    rename($oldfile,$file) || print "rename failed - $!\n";
}
sub Usage
{
	print "Usage: $0 old new file(s)\n";
}


############### end of main #############
sub MakeTargetDir {
    my ($file) = @_;
    @dirs=split('/',$file);
    pop(@dirs); # filename
#     shift(@dirs) if ($dirs[0] eq ''); #leading null
    for ($i=0;$i<=$#dirs;$i++) {
	$subdir = join('/',@dirs[0..$i]);
	if ($subdir and ! -d $subdir) {
	    if (! mkdir($subdir,0755)) {
		warn "cannot make $subdir\n";
		return;
	    }
	}
    }
}
sub SetUsage {
    my ($ropts,$rstr) = @_;
    my $short;
    foreach my $key (keys %$ropts) {
	if ($key =~ /\|/) {
	    ($short,$key) = split(/\|/,$key);
	}
	if ($key =~ /=/) {
	    $key =~ s!=.*$! value!;
	}
	$key = '-' . $key;
	if ($short) {
	    $short = '-' . $short;
	    $key = $short . '|' . $key
	}
	$$rstr .= '[' . $key . '] ';
    }
}
############### end of file #############
#