#!/usr/local/bin/perl -w
use strict;
use Tk;
use Tk::LabEntry;
use Tk::ErrorDialog;
use File::Find;
use ExtUtils::Manifest "/mani/";

my $containing = '/perl\b';
my $matching   = '\.p[ml]$';
my $mode       = 'MANIFEST';
my %filefunc   = ( MANIFEST => \&manifiles, 
                   Dummy    => \&dummyfiles,
                   'find' => \&findfiles );

sub accept_file
{
 my ($file) = @_; 
 return 0 unless (-w $file);
 my $accept = $matching && ($file =~ /$matching/);
 if (!$accept && $containing)
  {
   open(FILE,"<$file") || die "Cannot open $file:$!";
   my $line = <FILE>;
   close(FILE);
   $accept = $line && $line =~ m#$containing#;
  }
 return $accept;
}

sub findfiles
{
 my ($dir) = @_;
 my @files = ();
 die "Not a directory $dir\n", unless (-d $dir);
 find(sub {
 $File::Find::prune = 0;
 if (-T $_ && !/%$/)
  {
   push(@files,"$File::Find::dir/$_") if (accept_file($_));
  }
 elsif (-d $_)
  {
   $File::Find::prune = 1 if ($_ eq 'blib');
  }},$dir); 
 return @files;
}

sub dummyfiles
{
 my ($dir) = @_;
 my @files = ();
 my $file;
 foreach $file (map("$dir/$_",'aaaa'...'aaaz'))
  {
   push(@files,$file);
  }
 return @files;
}

sub manifiles
{
 my ($dir) = @_;
 my @files = ();
 if (-d $dir && -f "$dir/MANIFEST")
  {
   my $list = maniread("$dir/MANIFEST");
   my $file;
   foreach $file (map("$dir/$_",keys %$list))
    {
     push(@files,$file) if (accept_file($file));
    }
  }
 else
  {
   die "No $dir/MANIFEST\n";
  }
 return @files;
}

sub undo
{
 my $file;
 foreach $file (@_)
  {
   if (-f "$file.bak")
    {
     rename("$file.bak",$file) || die "Cannot rename $file $file.undone:$!";
    }
   else
    {
     warn "No $file.bak\n";
    }
  }
}

sub apply
{
 my $expr = shift;
 if (@_)
  {
   local $^I = ".bak";
   my $sub = eval "sub { $expr }";
   die "$@" if ($@);
   my @undo = ();
   @ARGV = @_;
   my $changes = 0;
   while (<>)
    {
     my $line = $_;
     if (&$sub)
      {
       print STDERR "$ARGV:$.:$_";
       $changes++ if ($line ne $_);
      }
     print;
     if (eof)
      {
       if ($changes)
        {
         print STDERR "$changes in $ARGV due to $expr\n";
         $changes = 0;
        }
       else
        {
         print STDERR "No changes in $ARGV due to $expr\n";
         push(@undo,$ARGV);
        }
      }
    }
   undo(@undo) if (@undo);
  }
}

sub populate
{
 my ($lb,$dir) = @_;
 $lb->delete(0,'end');
 $lb->Busy;
 Leak::check_arenas();
 $lb->insert('end',sort &{$filefunc{$mode}}($dir));
 Leak::check_arenas();
 $lb->Unbusy;
}

my $mw   = MainWindow->new;
my $ft   = $mw->Frame->pack(-fill => 'x');
my $expr = "";
my $dir  = `pwd`;
chomp($dir);
my $ed   = $mw->LabEntry(-label => 'Directory: ', -textvariable => \$dir,  -width => 60)->pack(-fill => 'x');
$ed->bind('<Return>', sub { populate(shift,$dir)});
$mw->LabEntry(-label => 'Matching: ', -textvariable => \$matching,  -width => 20)->pack(-fill => 'x');
$mw->LabEntry(-label => 'Containing: ', -textvariable => \$containing,  -width => 20)->pack(-fill => 'x');
my $lb   = $mw->Scrolled('Listbox')->pack(-fill => 'both', -expand => 1);
my $ee   = $mw->LabEntry(-label => 'Expression: ',-textvariable => \$expr, -width => 60)->pack(-fill => 'x');
$ft->Button(-text => 'Quit', -command => [destroy => $mw])->pack(-side => 'left');
$ft->Button(-text => 'Files', -command => sub { populate($lb,$dir)})->pack(-side => 'left');
$ft->Button(-text => 'Apply', -command => sub { apply($expr,$lb->get(0,'end')) })->pack(-side => 'left');
$ft->Button(-text => 'Undo',  -command => sub { undo($lb->get(0,'end')) })->pack(-side => 'left');
$ft->Optionmenu(-options => [ keys %filefunc ], -textvariable => \$mode )->pack(-side => 'right');
MainLoop;