#! /usr/bin/perl -w
#
# File: bigtidy.pl
# Time-stamp: <07/10/12 15:45:02 martinc>
# $Id: bigtidy,v 2.1 2007/09/20 14:41:27 martinc Exp $
#
# Copyright (C) 2002 University of Edinburgh
# Author: Martin Corley

use strict;
use Cwd;
use File::Find;
use Getopt::Long;
use Term::ReadKey;

my @dirs;
my %config=();
$|=1;

get_config();

print "Deleting files...\n\n" unless ($config{'Q'});

do_find(\&my_delete,\&backups,@dirs);
do_find(\&my_delete,\&saves,@dirs);
do_find(\&my_delete,\&specials,@dirs) if ($config{'ok_specials'});
do_find(\&my_delete,\&texfiles,@dirs) if ($config{'tex_files'});

unless ($config{'Q'}) {
  print "Finished: ";
  print report_gone(),"\n";
}

{
  my %dirs;
  my $action;

  sub do_find {
    $action=shift;
    my ($subref,@dirs) = @_;

    %dirs=();

    File::Find::find({wanted => $subref}, @dirs);
  }

  sub process {
    my $filename = shift;
    my $cwd=cwd;
    if ($dirs{$cwd}++) {
      &$action($filename);
    } else {
      &$action($filename,$cwd);
    }
  }
}

{
  my $total=0;

  sub my_delete {
    my ($filename,$dir) = @_;
    my $delete='yes';
    unless (exists $config{'Q'}) {
      print "In $dir\n" if (defined $dir);
      print "   $filename";
    }
    if (exists $config{'i'}) {
      print "  - Delete y/[n] ? ";
      ReadMode 3;
      my $answer=getc();
      ReadMode 0;
      unless ( 'Yy' =~ $answer ) {
	$delete = 'no';
	print "no\n";
      } else {
	print "yes\n";
      }
    } else {
      print "\n" unless $config{'Q'};
    }
    unless ($delete eq 'no') {
      $total += (-s $filename);
      unlink ($filename) || warn "Can't delete $filename: $!";
    }
  }

  sub report_gone {
    $total=0 unless ($total);
    my $unit='b';
    if ($total > 1024) {
      $total/=1024;
      $unit = 'Kb';
      if ($total > 1000) {
	$total/=1000;
	$unit='Mb';
      }
      $total=sprintf("%.2f",$total);
    }
    return "deleted ${total} ${unit}";
  }
}

sub backups {
  (
   /^.*~\z/s
   ||
   /^\..*~\z/s
   ||
   /^#.*#\z/s
   ||
   /^.*%\z/s
   ||
   /^\..*%\z/s
   ||
   /^.*\.bak\z/s
   ||
   /^\..*\.bak\z/s
  ) &&
  process($_);
}

sub specials {
  (
   /^servers\.cfg\z/s
   ||
   /^music\.raw\z/s
  ) &&
  process ($_);
}

sub texfiles {
   /^.*\.[a-z]{3}\z/s
     &&
   check_tex ($_)
     &&
   process ($_);
}

sub check_tex {
  my $file = shift;
  my $return=0;
  my $nfile;

  unless ($file =~ /^.*\.(tex|dvi|pdf|bib|txt|doc|xls|sty|cls|bst)\z/) {
    # so, if the file's called the same as a .tex file _and_ it's
    # older than the .tex file _and_ it's nothing important
    if ((($nfile = $file) =~ s/\.[a-z]+\z//) && (-e "${nfile}.tex")
	&& (-M "${nfile}.tex" >= -M $file)) {
      $return++;
    }
  }
  return $return;
}


sub saves {
    my ($dev,$ino,$mode,$nlink,$uid,$gid);

    (
        /^\.saves.*\z/s &&
        (($dev,$ino,$mode,$nlink,$uid,$gid) = lstat($_)) &&
        (int(-A _) > 7)
    ) &&
    process($_);
}

sub get_config {
  $config{'ok_specials'}=0;
  Getopt::Long::Configure("bundling");
  unless (GetOptions(\%config,"c","i","h","t","Q")) {
    usage();
    exit(1);
  }
  if (exists $config{'h'}) {
    usage();
    exit(0);
  }
  if (exists $config{'c'}) {
    @dirs=('.');
  } else {
    my $home = $ENV{'HOME'} || 'farty';
    @dirs=($home);
    $config{'ok_specials'}=1;
  }
  if (exists $config{'t'}) {
    $config{'tex_files'}=1;
  }
  if (exists $config{'i'} && exists $config{'Q'}) {
    print STDERR "bigtidy: can't be interactive AND quiet\n";
    exit(1);
  }
}

sub usage {
  print STDERR "usage: bigtidy [options]\n";
  print STDERR "               -i  ask before deleting\n";
  print STDERR "               -c  start from current rather than home dir\n";
  print STDERR "               -t  delete (La)TeX byproduct files as well\n";
  print STDERR "               -Q  act quietly (no output)\n";
  print STDERR "               -h  this help\n";
}