#!/usr/bin/perl
use strict;
use warnings;

my $nt='nametoucher.sh';
open my $NT, '>', $nt or die $!;

open my $DIR, '-|', 'ls ' or die $!;
while (<$DIR>) {
    chomp;
    my $date=my $fn=$_;
    next if -l $fn; #skip links
    die "$fn not found" unless -f $fn or -d $fn;
    
    #2 digits, 3 letters, 4 digits
    next unless $date=~ m/.*(\d{2}\D{3}\d{4}).*/;
    $date=$1;
    next unless &isDate($date);
    next if &isUp($fn,$date);
    &touchUp($fn,$date);
}
close $DIR;
close $NT;

sub isDate {
    my $date=shift;
    my $fday=substr $date, 0,2;

    return 0 unless $fday=~/^\d+$/;

    if( $fday < 10 and $fday !~ /\d{2}/) {
	$fday="0${fday}";
    }

    unless ($fday=~/^\d{2}$/ and 0 < $fday and $fday < 32) {
	die "$fday not a day of month";
    }

    my $fmon=substr $date, 2,3;
    die "$fmon not a month" unless $fmon =~ /^\D{3}$/;

    my $fyer=substr $date, 5,4;
    die "no year in $date" unless 
	($fyer =~ /^\d{4}$/ and 1970 < $fyer and $fyer < 2038);

    return 1;
}

sub isUp {
    my($file,$date)=@_;

    my($device, $inode, $mode, $nlink, $uid, $gid, $rdev, $size,
       $atime, $mtime, $ctime, $blksize, $blocks)= 
	   stat($file);

    $mtime=scalar localtime $mtime;
    my $cmon=substr $mtime,  4,3;
    my $cday=substr $mtime,  8,2;
    my $cyer=substr $mtime, 20,4;

    my $cdate=sprintf "%02d%3s%4d", $cday,$cmon,$cyer;

    #If mtime doesn't match date in dirname, return 0. Else 1. 
    return 1 if($cdate eq $date);
    return 0;
}

sub touchUp {
    my $target=shift;
    my $date=shift;

    my %Months=();
    my @months=qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec);

    my $i=1;
    foreach my $m (@months) {
	$Months{$m}=$i++;
    }

    my $year=substr($date,5,4);

    my $amon=substr($date,2,3);
    die "not a month: $amon" unless exists $Months{$amon};
    my $nmon=sprintf "%02d", $Months{$amon};

    my $day=substr($date,0,2);
    my $cmd=sprintf "touch -d \"%04d-%02d-%02d\" %s",
    $year, $nmon, $day, $target;
    &addline($cmd);
}

sub addline {
    my $line=shift;
    printf "%s\n", $line;
    printf $NT "%s\n", $line;
}


__END__

#http://pleac.sourceforge.net/pleac_perl/directories.html
#use DirHandle;
#
#$dh = DirHandle->new($path)   or die "Can't open $path : $!\n";
#@files = grep { /\.[ch]$/i } $dh->read();

#http://www.troubleshooters.com/codecorn/littperl/perlreg.htm
##** only lines with dates at position 28 and (long) filename at pos 44 **
#if ($line =~ /.{28}(\d\d)-(\d\d)-(\d\d).{8}(.+)$/)
#{
#    my($filename) = $4;
#    my($yymmdd) = "$3$1$2";
#    if($yymmdd lt "971222")
#    {
#        print "copy $filename \\oldie\n";
#    }
#}

#http://search.cpan.org/~nwetters/File-Touch-0.02/Touch.pm