#!/usr/bin/perl

use File::Spec;
use POSIX 'strftime';

my $dir = shift || '.';
opendir D, $dir or die "Couldn't read directory $dir: $!; aborting";
my @message_files = sort { $a <=> $b } grep {!/\D/ && -f "$dir/$_" } readdir D;
closedir D;

my %me;
{ my @addresses = $ENV{ADDRESS} ? 
    split(/,\s+/, $ENV{ADDRESS}) : guess_addresses();
  for (@addresses) { $me{lc $_} = 1 };
}

my %m2n = (jan => 1, feb =>  2, mar =>  3, apr =>  4,
           may => 5, jun =>  6, jul =>  7, aug =>  8,
           sep => 9, oct => 10, nov => 11, dec => 12, );

for $msgno (@message_files) {
  local *F;
  my $file = File::Spec->catfile($dir, $msgno);
  unless (open F, "<", $file) {
    warn "Couldn't read message $msgno; skipping.\n"; 
    next;
  }
  my %mo = read_message(\*F);

  { my $datefield = $mo{date};
    if ($datefield && $datefield =~ /(\d+) (\w+)/) {
      $date = sprintf "%02d/%02d", $m2n{lc $2}, $1;
    } else {
      $date = strftime("%m/%d", localtime((stat($file))[9]));
    }
  }

  { my ($phrase, $addr, $comment) = parse_addr($mo{from});
    if ($me{lc $addr}) {
      ($phrase, $addr, $comment) = parse_addr($mo{to});
      $whom = "To:" . ($comment || $phrase || $addr);
    } else {
      $whom = $comment || $phrase || $addr;
    }
  }

  $subjcontent = $mo{subject} . "<<" . join "", $mo{BODY};
  $subjcontent =~ tr/\n//d;
  
  write;
}

format STDOUT =
@####  @<<<< @<<<<<<<<<<<<<<<<  @<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
$msgno,$date,$whom,             $subjcontent
.

sub guess_addresses {
  my $username = $ENV{USER} || (getpwuid($<))[0] || return;
  my $host = $ENV{HOST} || do {
    require Config;
    "Config"->import;
    $Config{myhostname} . $Config{mydomain};
  } || return;
  "$username\@$host";
}

sub read_message {
  my $fh = shift;
  my ($header);
  my %m;
  {
    local $/ = "";
    $header = <$fh>;
    undef $/;
    $m{BODY} = <$fh>;
  }
  my @fields = split /\n(?!\s)/, $header;
  for (@fields) {
    my ($t, $v) = split /:\s+/, $_, 2;
    $m{lc $t} = $v;
  }
  %m;
}

sub parse_addr {
  my $x = shift;
  my ($phrase, $addr, $comment) =
    $x =~ /([^<(]*) 
           (?: < ( [^<\s]* ) > )  ? \s* 
           (?: \( ([^\)]*) \))    ?/x;
   $addr = $phrase unless defined $addr;
#  warn "$x -> '$phrase', '$addr', '$comment'\n";
   for ($phrase, $addr, $comment) { 
     s/^\s+//;  s/\s+$//;
   }
   return ($phrase, $addr, $comment);
}