: # -*- perl -*-  vim: ft=perl
eval 'exec perl -w -S $0 ${1+"$@"}'
if 0;

# Generate Apache mail archive URL from message piped to this script.

use strict;

my %numonth = qw(Jan 01 Feb 02 Mar 03 Apr 04 May 05 Jun 06 Jul 07 Aug 08 Sep 09 Oct 10 Nov 11 Dec 12);

my ($input, $archive, $year, $month, $msgid);
while ($input = <STDIN>) {
    chomp $input;
    if ($input =~ /^List-Post:\s+<mailto:(.+)\@(.+\.)?apache\.org>/i) {
        my $list = $1;
        my $sub = $2;
        if ($sub) {
            $sub =~ tr/./-/;
            $archive =  $sub . $list;
        }
        else {
            $archive = $list;
        }
    }
    elsif ($input =~ /^Date:\s+\w+,\s+\w+\s+(\w+)\s+(\w+)/i) {
        $month = $numonth{$1};
        $year = $2;
    }
    elsif ($input =~ /^Message-ID:\s+<(.+)>/i) {
        $msgid = $1;
        $msgid =~ s/%/%25/g;
        $msgid =~ s/\//%2F/g;
    }
    elsif (!$input) {
        last;
    }
}
if ($archive && $year && $month && $msgid) {
    print 'http://mail-archives.apache.org/mod_mbox/'. $archive .'/'. $year . $month .'.mbox/%3C'. $msgid .'%3E'."\n"; }
else {
    print 'Cannot generate URL from '. ($archive ? $archive : '') .'/'. ($year ? $year : '') . ($month ? $month : '') .'/'. ($msgid ? $msgid : '') ."\n"; }