#!/usr/athena/bin/perl
# for cleanup of The Evil Mess In My Homedir
#
# $Id: cleanup.pl,v 1.2 1995/01/25 20:10:37 bert Exp bert $
#

$0 =~ s@.*/@@;

$| = 1;

### switches

$real = 1;   $debug=0;   $quiet=0;  $dump=0;
while ($dir = shift(@ARGV)) {
    ($dir eq '-help') &&    (&help, exit(0));
    ($dir eq '-fake') &&    ($real = 0, next);
    ($dir eq '-nofake') &&  ($real = 1, next);
    ($dir eq '-debug') &&   ($debug = 1, next);
    ($dir eq '-nodebug') && ($debug = 0, next);
    ($dir eq '-quiet') &&   ($quiet = 1, next);
    ($dir eq '-noquiet') && ($quiet = 0, next);
    ($dir eq '-dump') &&    ($dump = 1, next);
    ($dir eq '-nodump') &&  ($dump = 0, next);
    last;
}

sub help {
    local($rev) = '$Revision: 1.2 $';
    $rev =~ s/\s*\$\s*//g;
    $rev =~ tr/A-Z/a-z/;
    print "cleanup.pl ($rev)\n\n";
    print "$0 [options] [directory]\n";
    print <<"***";
options:
  -help    show this help information
  -fake    modify nothing, display what we would do
  -quiet   don't display information about what's going on
  -debug   print each action before doing it
  -dump    internal comparison list for debugging
***
#';
}

if (! $real && ! $quiet) {print "We're not doing this for real... =)\n";}
if ($debug && ! $quiet)  {print "Displaying actions for debugging.\n";}

### CD to the directory and open stuff we need to read

chdir $dir || die "$0: cannot cd to $dir! ($!)\n  quitting";

open(DEFS, '.cleanup') || die "$0: Can't open .cleanup ($!)\n  quitting";
@defs = sort( grep( !/^\#|^\!/, <DEFS> ));

opendir(DIR, '.') || die "$0: Can't open directory ($!)\n  quitting";
@dir = sort( grep( !/^\.\.?$/, readdir(DIR) ));

@mnm = ();

if ($dump && $debug) {
    print "*** checklist:\n", join('',@defs);
    print "*** directory:\n", join("\n",@dir),"\n";
    print "*****\n";
}

### go over all the files

FILE: while (@dir || @defs) {
    if ((@defs[0] =~ /^\s+$/) && @defs) {shift(@defs); next FILE;}
    if (@defs[0] =~ /^&/) {push(@mnm,shift(@defs)); next FILE;}

    $file = @dir[0];
    ($lname,$type,$lptr) = split( /\s+/, $defs[0] );

    print "comparing file $file and entry $lname\n" if $dump;

### deal with links/files that shouldn't be here

    if (($file lt $lname) || ($lname eq '')) {
      if ($file =~ /~$/ and -f $file) {
	printf( "%20s: shouldn't be here, removing\n", $file )
	  unless $quiet;
	do_unlink($file);
      } else {
	printf( "%20s: shouldn't be here, moving to crud\n", $file )
	  unless $quiet;
	do_rename_fuzzy($file, 'crud/'.$file);
	shift(@dir); next FILE;
      }
    }

### deal with links/files that should be here and aren't

    if (($lname lt $file) || ($file eq '')) {
	if ($type eq 'link') {
	    if (-e $lptr) {
		printf("%20s: symlink nonexistant, fixing\n",$lname)
		    unless $quiet;
	    } else {
		printf("%20s: WARNING: creating symlink into void\n",$lname)
		    unless $quiet;
	    }
	    &do_symlink($lptr, $lname);
	    shift(@defs); next FILE;
	}
	if (($type ne 'ignore')&&($type ne 'rm')&&($type ne 'rmdir')) {
	    printf( "%20s: no file/dir/symlink, CANNOT FIX\n", $lname )
		unless $quiet;
	}
	shift(@defs); next FILE;
    }

### check the file

    if ($type eq 'link') {
	if ($lnk=readlink($file)) {
	    if ($lnk ne $lptr) {
		printf( "%20s: wrong symlink, fixing\n",$lname ) unless $quiet;
		&do_unlink ($file);
		&do_symlink($lptr, $file);
	    }
	}
	else {
	    if ($! eq 'Invalid argument') {
		printf( "%20s: regular file (not symlink), fixing\n", $file )
		    unless $quiet;
		if (-e $lptr) {
		    &do_rename ($lptr, $lptr.'.copy');
		}
		&do_rename ($file, $lptr);
		&do_symlink($lptr, $file);
	    }
	    else {
		die "$0: $! error while trying to readlink $file\n  quitting";
	    }
	}
	shift(@defs); shift(@dir); next FILE;
    }

    if ($type eq 'rm') {
	if (-f $file) {
	    printf( "%20s: removing file\n", $file) unless $quiet;
	    &do_unlink($file);
	}
	else {
	    printf( "%20s: not regular file, CANNOT REMOVE\n", $file)
		unless $quiet;
	}
	shift(@defs); shift(@dir); next FILE;
    }

    if ($type eq 'rmdir') {
	if (-d $file) {
	    printf( "%20s: removing directory\n", $file) unless $quiet;
	    &do_rmdir($file);
	}
	else {
	    printf( "%20s: not a directory, CANNOT REMOVE\n", $file)
		unless $quiet;
	}
	shift(@defs); shift(@dir); next FILE;
    }

    shift(@defs);
    shift(@dir);
}


sub do_symlink {
    print "debug> link '@_[1]' -> '@_[0]'\n" if $debug;
    (symlink(@_[0],@_[1]) ||
     die "$0: Can't create symlink '@_[1]'->'@_[0]' ($!)\n  quitting")
      if $real;
}

sub do_rename {
    &do_unlink (@_[1]) if ( -f @_[1] );
    print "debug> move '@_[0]' to '@_[1]'\n" if $debug;
    (rename(@_[0],@_[1]) ||
     (($! eq 'Cross-device link') && &do_sys_mv(@_)) ||
     warn "$0: Can't move file '@_[0]' to '@_[1]' ($!)\n  continuing")
      if $real;
}

sub do_rename_fuzzy {
  my ($from, $to) = @_;
  if (-e $to) {
    my $idx = '0000';
    ++$idx while -e "$to.COPY$idx";
    $to = "$to.COPY$idx";
  }
  do_rename($from, $to);
}

sub do_sys_mv {
    print "debug> rename() failed; /bin/mv '@_[0]' to '@_[1]'\n" if $debug;
    (system("/bin/mv @_[0] @_[1]") &&
     die "$0: /bin/mv failed for '@_[0]' to '@_[1]' ($!)\n  quitting")
      if $real;
    1;
}

sub do_unlink {
    print "debug> remove '@_[0]'\n" if $debug;
    (unlink(@_[0]) || die "$0: Can't remove file '@_[0]' ($!)\n  quitting")
	if $real;
}

sub do_rmdir {
    print "debug> rmdir '@_[0]'\n" if $debug;
#    (rmdir(@_[0]) ||
    (system("/bin/rm -r @_[0]") &&
     die "$0: Can't remove directory '@_[0]' ($!)\n  quitting")
      if $real;
}