#!/usr/bin/perl -w

=head1 SYNOPSIS

  perl -w fixfilenames.pl mahaticd f

=head1 DESCRIPTION

Modifies a directory hierarchy in place fixing up file and diretory names.
Last arg is 'f' or 'd' according to whether it should fix files or dirs.  

both directories and files:
    replace spaces and any funny characters to underscores
    make suffixes lowercase

files:
    make sure there is a suffix (matching file type)
    remove zero-size files.

directories:
    removes empty directories

=cut

use File::Basename;


# exclude documents like doc pdf html
my @OK_TYPES = qw(jpg jpeg gif png tif tiff psd);

sub warning {
    print STDERR "WARNING: ", @_, "\n";
}

sub main {
    die "usage: $0 dir type" unless @ARGV == 2;
    my ($dir, $ftype) = @ARGV;

    fix_dir($dir, $ftype);
}

sub fix_dir {
    my ($dir, $ftype) = @_;
    my @files = `find $dir -type $ftype`;

    # longest first, so rename at bottom of tree first
    @files = sort {length($b) <=> length($a)} @files;

    for my $f (@files) {
	fix_file($f, $dir, $ftype);
    }
}

sub fix_file {
    my ($f, $dir, $ftype) = @_;
    chop($f);
    return if $f eq $dir;

    # suffix based on type
    my $n = basename($f);
    my $d = dirname($f);
    # spaces to underscores
    $n =~ s/ /_/g;
    # funny characters
    $n =~ s/[\'\"\\\(\)\/\&\<\>\;\!]/_/g;
    # make suffixes lowercase
    $n =~ s/(\.[^\.]+)$/lc($1)/e;

    # final fixes
    $n =~ s/--/-/g;
    $n =~ s/_-/_/g;
    $n =~ s/-_/_/g;
    $n =~ s/__/_/g;
    $n =~ s/^_//;
    $n =~ s/_\././g;
    $n =~ s/\._/_/g;

    my $of = $f; # keep veresion without quote escaping
    $f =~ s/'/\\'/g;

    # no suffix in non-directory
    my ($suff) = ($n =~ m/\.([^\.]+)$/);
    if ($ftype eq 'f' && !$suff) {
        my $filetype = `file '$f'`;
        chomp($filetype);
        print "type of '$f' is: '$filetype'\n";
        if ($filetype =~ m/TIFF/) {
            $suff = 'tif';
        }
        elsif ($filetype =~ m/Adobe Photoshop/) {
            $suff = 'psd';
        }
        elsif ($filetype =~ m/: empty/) {
            # remove
            print "unlink: $f\n";
            unlink($of);
        }
        elsif ($filetype =~ m/JPEG/) {
            $suff = 'jpg';
        }
        else {
            print "unknown file type: '$filetype'\n";
        }
        $n .= ".$suff" if $suff;
        # print "setting suffix in $n\n";
    }

    my $nf = "$d/$n";

    # check for empty dirs
    if ($ftype eq 'd'){
        my @subfiles = `ls '$f'`;
        # print "subfiles of '$f': ", scalar(@subfiles), "\n";
        unless (@subfiles) {
            print "rmdir '$f'\n";
            rmdir($of);
        }
    }

    # maybe rename
    if ($f ne $nf) {
	my $cmd = "mv '$f' '$nf'";
	print $cmd, "\n";
	
	rename($of, $nf) || die "can't rename: $!";
    }
}

main();