#!/usr/bin/perl -w
#
# lcra
#
# Recursively rename files to lower case, if they need renaming.
#
# Usage: lcra
#
# which will rename all regular files and directories in the current
# directory and its subdirectories.  Alternatively:
# 
# Usage: lcra filenames...
# 
# which renames the given filenames to lower case if needed, or if
# they are directories, them and all their children.
# 
# All uppercase 8.3 filenames will be renamed, apart from files with
# no extension (like INSTALL), files beginning README, and files with
# only one uppercase letter.
# 
# The -t flag will print out what needs doing, but not actually rename
# anything.
# 
# Optionally, also fixes first-letter capitalization, so 'Setup.exe'
# will be renamed to 'setup.exe'; and extension capitalization so
# 'foo.TXT' becomes 'foo.txt.'.  See 'Configuration' below.
# 
# -- Ed Avis, epa98@doc.ic.ac.uk, 2001-01-22
#

use strict;
use Getopt::Std;

# Trace messages with Log::TraceMessages, if available
sub t(@); sub d($);
eval { require Log::TraceMessages };
if ($@) {
    # Couldn't load the module - use dummy routines
    *t = sub(@) { };
    *d = sub($) { 0 };
}
else {
    import Log::TraceMessages qw<t d>;
    Log::TraceMessages::check_argv();
}

# Prototypes for subs defined in this file
sub needs_renaming($$);
sub do_rename($$);

########
# Configuration

# On a case-insensitive filesystem, it might not be possible to rename
# 'FOO' to 'foo', as they are considered 'the same'.  You can give an
# intermediate filename to be used to overcome this problem - if it is
# not defined, this kludge won't be used.
# 
#my $INTERMEDIATE = '_LCRATMP';
my $INTERMEDIATE = undef;

# Fix first-letter capitalization?
my $FIRST_LETTER = 0;

# Fix extension capitalization?
my $EXTENSION = 0;

########
# End of configuration

use vars '$opt_t'; getopts('t');
@ARGV = ('.') if not @ARGV;

foreach my $file (@ARGV) {
    my $depth = ($file eq '.') ? 1 : 0;
    
    for (;;) {
	open(FIND, "find $file -mindepth $depth -maxdepth $depth |")
	  or die;
	$. = 0;
	
	while (<FIND>) {
	    chomp;
	    t 'filename=' . d($_);

	    my ($path, $base);
	    if (m!(.+)/(.+)!) {
		($path, $base) = ($1, $2);
	    }
	    elsif ($_ eq $file) {
		($path, $base) = ('.', $file);
	    }
	    else { die "bad line $_\n" }
	    t 'path=' . d($path); t 'base=' . d($base);
	    
	    if (needs_renaming($_, $base)) {
		t 'renaming';
		if ($_ eq $file) { 
		    # $file itself has been renamed
		    $file = do_rename($path, $base);
		}
		else {
		    do_rename($path, $base);
		}
	    }
	}
	
	last if $. == 0;
	++ $depth;
    }
}


# needs_renaming()
# 
# Does a file need to be renamed?
# 
# Parameters:
#   filename
#   basename from above filename
# 
sub needs_renaming($$) {
    die 'usage: needs_renaming(filename, basename)' if @_ != 2;
    my ($f, $b) = @_;
    stat $f or warn "cannot stat $f: $!", return 0;
    
    local $_ = $b;
    return 0 unless (-f _) or (-d _);
    return 0 if (-f _ and /^README(\..*)?$/);
    return 0 if (-f _ and not /^.{1,8}\..{1,3}$/);
    return 0 if (-d _ and not /^.{1,8}(\..{1,3})?$/);
    
    if ((not tr/a-z//) and (tr/A-Z// > 1)) {
	# More than one uppercase letter and no lowercase
	return 1;
    }

    if ($FIRST_LETTER) {
	if (/^[A-Z]/ and (tr/A-Z// == 1) and tr/a-z//) {
	    # Something like Config.sys
	    return 1;
	}
    }

    if ($EXTENSION) {
	if (/^[^A-Z]+\.[A-Z]{2,3}$/) {
	    # Something like foo.TXT
	    return 1;
	}
    }
}


# do_rename()
# 
# Rename a file to its lowercase equivalent.
# 
# Parameters:
#   directory file lives in
#   basename (leaf name) of file
# 
# Returns:
#   new basename (may be unchanged), or undef if error
# 
# If there's an error, a warning is printed and undef is returned.  A
# serious error causes a die().
# 
sub do_rename($$) {
    die 'usage: do_rename(PATH, BASE)' if @_ != 2;
    my ($path, $base) = @_;
    t 'path=' . d($path); t 'base=' . d($base);
    my $o = "$path/" . $base;
    my $n = "$path/" . lc $base;
    t 'renaming ' . d($o) . ' to ' . d($n);
    return $o if $o eq $n;
    die if lc $o ne lc $n;

    print "$o -> $n\n";

    if (defined $INTERMEDIATE) {
	my $i = "$path/$INTERMEDIATE";
	unless ($opt_t or rename $o, $i) {
	    warn "cannot rename $o to $i: $!";
	    return undef;
	}

	unless ($opt_t or rename $i, $n) {
	    warn "cannot rename $i to $n: $!";
	    print "trying to rename $i back to $o... ";
	    if (rename $i, $o) {
		print "OK\n";
		return undef;
	    }
	    else {
		print "failed: $!\n";
		die "got stuck renaming $o to $n, left as $i";
	    }
	}
    }
    else {
	# No intermediate file, rename directly
	if ($opt_t or rename $o, $n) {
	    return $n;
	}
	else {
	    warn "cannot rename $o to $n: $!";
	    return undef;
	}
    }
}