#!/afs/athena/contrib/perl5/perl
# remove initial messages from mail in movemail format, up to and
#   including specified msgid
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_msgid ($) {
  my ($hdr) = @_;
  my ($id) = ($hdr =~ /^Message-Id: \s+ (\S+)/mix)
    or return '';
  $id =~ s/^<(.+)>$/$1/;
  $id;
}

### data output

sub output ($) {
  print "\cL\n0, unseen,,\n";
  print @_;
  print "\037";
}

### spool processing

my $msgid = shift @ARGV;

read_write_first(\*ARGV) or return;
my $copying;

while (1) {
  my $msg = read_msg \*ARGV
    or last;
  output $msg if $copying;
  header_msgid(copy_headers $msg) eq $msgid
    and $copying = 1;
  read_next \*ARGV
    or last;
}