#!/afs/athena/contrib/perl5/perl
# convert mail in movemail format back to UNIX mail-spool form.
use warnings;
use strict;

### input

sub read_line ($) {
  my ($fh) = @_;
  local ($/) = "\n";
  scalar <$fh>;
}

sub read_body ($) {
  my ($fh) = @_;
  local ($/) = "\037";
  my $body = scalar <$fh>;
  chomp $body;
  $body;
}

sub read_end ($) {
  my ($fh) = @_;
  while (my $line = read_line $fh) {
    $line =~ /\S/ and die "Extraneous data at the end of file!\n";
  }
}

sub read_msg ($) {
  my ($fh) = @_;
  my $babyl = read_line $fh;
  defined $babyl or die "Message doesn't contain a BABYL header!\n";
  $babyl =~ /^[01],/ or die "BABYL message header is invalid!\n";
  read_body $fh;
}

sub read_next ($) {
  my ($fh) = @_;
  my $start = read_line $fh;
  defined $start or return;
  $start =~ /^\cL/ or read_end($fh), return;
  1;
}

sub read_first ($) {
  my ($fh) = @_;
  my $start = read_line $fh;
  defined $start or return;
  $start =~ /^\cL/ and return 1;
  /^BABYL OPTIONS:/ or die "Unable to interpret file format.\n";
  read_body $fh;
  read_next $fh;
}

sub read_write_first ($) {
  my ($fh) = @_;
  my $start = read_line $fh;
  defined $start or return;
  $start =~ /^\cL/ and return 1;
  /^BABYL OPTIONS:/ or die "Unable to interpret file format.\n";
  print $start;
  print read_body($fh);
  read_next $fh;
}

### data extraction

sub copy_headers ($) {
  my ($msg) = @_;
  my $pos = index $msg, "\n\n";
  $pos < 0 and return $msg;
  substr $msg, 0, $pos+1;
}

sub header_retpath ($) {
  my ($hdr) = @_;
  my ($retpath) = ($hdr =~ /^Return-Path: \s+ (\S+)/mix)
    or return 'unknown-sender';
  $retpath =~ s/^<(.+)>$/$1/;
  $retpath;
}

sub header_date ($) {
  my ($hdr) = @_;
  my ($date) = ($hdr =~ /^Date: \s+ (.+)\b \s*$/mix)
    or return scalar localtime;
  $date =~ s/^\S+,\s+//;
  $date;
}

sub generate_from_line ($) {
  my ($hdr) = @_;
  my $from = header_retpath $hdr;
  my $date = header_date $hdr;
  "From $from $date\n";
}

### spool processing

read_first(\*ARGV) or return;
my $sep = '';

while (1) {
  my $msg = read_msg \*ARGV
    or last;
  print $sep, generate_from_line(copy_headers $msg), $msg;
  $sep = "\n";
  read_next \*ARGV
    or last;
}