#!/afs/sipb/project/perldev/p -w

use strict;
use Term::ReadKey;

sub choose {
  my %ret = @_;
  my $c;
  ReadMode 3;
  while ($c = ReadKey 0) {
    exists $ret{$c} && last;
    print "\007";
  }
  ReadMode 0;
  $ret{$c};
}

sub _do_delete ($) {
  unlink($_[0]) or warn "Can't delete $_[0]: $!";
  return 1;
}

sub _do_rename ($) {
  my ($file) = @_;

  my $dest;
 NEW:
  {
    print "Rename $file to msg.";
    $dest = scalar <STDIN>;

    chomp $dest;
    $dest = "msg.$dest";

    -e $dest and warn("$dest already exists!\n"), redo NEW;
  }

  rename $file, $dest
    or warn "Can't rename $file to $dest: $!";

  return 1;
}

sub _do_list ($) {
  my ($file) = @_;

  local($/) = undef;

  open LIST, $file
    or die "Can't open $file fo reading: $!";
  print "\n", scalar <LIST>, "\n";
  close LIST;

  return 0;
}

sub process ($) {
  my ($file) = @_;

  print "[d]elete [r]ename [l]ist [s]kip? ";
  my $what = choose( 'd' => \&_do_delete, 'r' => \&_do_rename,
		     'l' => \&_do_list,   's' => sub ($) { 1; } );
  print "\n";

  $what->($file);
}

sub headers ($) {
  my ($file) = @_;

  local($/) = "\n\n";

  open LIST, $file
    or die "Can't open $file fo reading: $!";
  my $head = scalar <LIST>;
  close LIST;

  $head .= "--test--\nsome text\nlalala\n--blargh\n";

  $head =~ s/^--.*//ms;
  $head =~ s/^(?:references|x-mailer):.*\n?//mig;

  print "\n$head\n";
}

$| = 1;

chdir $ENV{HOME} . "/Mail"
  or die "Can't cd to your Mail directory: $!";

my @messages = <.#msg.*>;
{
  my %age = map +($_ => -M $_), @messages;
  @messages = sort { $age{$b} <=> $age{$a} } @messages;
}

foreach (@messages) {
  headers $_;
  1 until process $_;
}