#!/afs/athena/contrib/perl/perl

$debug = 1;
$real = 1;
$recurse = -1;
# $compact = 1;

sub untwiddle {
    local($level) = shift(@_);
    local($f, $sz);
    local($tm,$ta,$tc);
    local($xf, $xsz);
    local($xtm,$xta,$xtc);
  ENTRY:
    foreach $fn (@_) {
	($xf, $xsz) = ($fn, -1);
	($xtm,$xta,$xtc) = (-1,-1,-1); 
	$ll = (-l $xf);
	if ((!$ll) && (-d $xf)) {
	    local($savewd) = $ENV{'PWD'};
	    if ($xf =~ m@^/@) {
		$ENV{'PWD'} = $xf;
	    } else {
		$ENV{'PWD'} .= '/' . $xf;
	    }
	    print "--> cd'ing to $xf\n" if ($chdebug);
	    chdir($xf) || die;
	    print "--> cd'ed to $ENV{'PWD'}\n" if ($chdebug);
	    print "[$level] entering: $ENV{'PWD'}\n" if ($debug||$ddebug);
	    local(@dirs) = <*[^~]>;
	    print "(@dirs)\n";
	    do untwiddle(1+$level,@dirs) if ($recurse&&($level != $recurse));
	    print "[$level] done: $ENV{'PWD'}\n" if ($debug||$ddebug);
	    print "--> cd'ing to $savewd\n" if ($chdebug);
	    chdir($savewd) || die;
	    $ENV{'PWD'} = $savewd;    # argh.  Perl is being *stupid*.
	    print "--> cd'ed to $ENV{'PWD'}\n" if ($chdebug);
	    print "*** WARNING: $ENV{'PWD'} != $savewd\n"
		if ($ENV{'PWD'} ne $savewd);
	    next ENTRY;
	} elsif ($ll || -e $xf) {
	    $xsz = (-s _);
	    ($xtm, $xta, $xtc) = (-M _, -T _, -C _);
	} else {
	    printf STDERR "warning: master file '$fn' not found!\n";
	    printf STDERR "         (xf='$xf',-e=".(-e $xf).")\n" if ($debug);
	}
	local($slot) = 1;
      FILE:
	foreach (sort {$a <=> $b} grep(s/.*~([^~]+)~$/\1/, <$fn.~*~>)) {
	    local($f) = "$fn.~$_~";
	    $ll = (-l $f);
	    if (! -e $f) {
		printf STDERR "warning: '$f' not found!\n";
		next FILE;
	    }
	    undef $d;
	    $sz = (-s _);
	    if ($sz != $xsz) {
		printf '    %-20s %-20s sizes differ', $xf, $f;
		print "($xsz vs $sz)" if ($debug||$sdebug);
		print "\n";
		$d|=8;
	    }
	    ($tm, $ta, $tc) = (-M _, -T _, -C _);
	    if ($tm != $xtm) {
		printf '    %-20s %-20s mtimes differ', $xf, $f;
		printf '(%6.2f vs %6.2f)', $xtm, $tm if ($debug||$tdebug);
		print "\n";
		$d|=1;
	    }
	    if ($ta != $xta) {
		printf '    %-20s %-20s atimes differ', $xf, $f;
		printf '(%6.2f vs %6.2f)', $xta, $ta if ($debug||$tdebug);
		print "\n";
		$d|=2;
	    }
	    if ($tc != $xtc) {
		printf '    %-20s %-20s ctimes differ', $xf, $f;
		printf '(%6.2f vs %6.2f)', $xtc, $tc if ($debug||$tdebug);
		print "\n";
		$d|=2;
	    }
	    if ($d<=1) {
		printf "blowing away $f\n" if $debug;
		unlink($f) if $real;
	    } else {
		if ($compact) {
		    if ($_ != $slot) {
			printf "moving $f to $fn.~$slot~\n" if $debug;
			system "mv",$f,"$fn.~$slot~" if $real;
		    }
		    $slot++;
		}
		($xf, $xsz) = ($f, $sz);
		($xtm, $xta, $xtc) = ($tm, $ta, $tc);
	    }
	}
    }
}

do untwiddle(1,@ARGV);