#!/usr/bin/perl
# vi:sm:ai:et:wm=0:sw=4:ts=4

# URLinator
# Given a message headed for majordomo, determine the URL it
# will have in the associated mhonard archive and add it to the
# body of the message.
#
# Do it with as little extras as possible.
#
# Try to avoid race conditions, in the event of concurrent or
# near concurrent messages.
#
# Thanks be to Stan Gerbig <sgerbig@indiana.edu> for his hard
# won wisdom in the ways of majordomo
#
# Artistic License
# Copyright 2002
# Chris Dent <cdent@burningchrome.com>


use strict;
use FileHandle;
use IPC::Open2;

# We'll need to do the following:
#
# - take the archive top dir off the command line
# - determine if we have monthlies or not
# - switch to the directory
# - get the next message number
# - check the MIME status of the message
# - drop in the URL into the body
# - put it on STDOUT

die "Improper arguments" unless (defined($ARGV[1]));
my $directory = get_file_directory($ARGV[0]);
my $url = get_url($ARGV[1]);
my ($header, $body) = read_message();
my ($next_message_number) = get_next_number($directory, \$header, \$body);
unless ($next_message_number =~ /\d/) {
    die "mhonarc injection failure, no message number provided";
}

if (text_plain($header)) {
    adjust_body(\$body, $url, $next_message_number);
}

print "$header\r\n$body";

sub adjust_body {
    my $bodyref = shift;
    my $url = shift;
    my $number = shift;

    $number = sprintf("%05i", $number);

    $$bodyref =<<"EOF";

Find this message in the archive at:

   ${url}msg${number}.html

$$bodyref
EOF

    return;
}
    

sub get_next_number {
    my $directory = shift;
    my $headerref = shift;
    my $bodyref   = shift;

    my $mhonarc_string = qq(/usr/bin/mhonarc -outdir $directory ) .
                         qq(-add -rcfile main.mrc -multipg -spammode ) .
                         qq(-umask 0002 -quiet);
    print $mhonarc_string, "\n";

    my $pid = open2(*Reader, *Writer, $mhonarc_string) ||
        die "error opening mhonarc";
    print Writer "$$headerref\r\n$$bodyref";
    Writer->flush();
    Writer->close();
    my $last;
    foreach (<Reader>) {
        chomp;
        s/^msg//;
        s/\..*$//;
        s/^0+//;
        $last = $_ if ($_ > $last);
    }

    return $last;
}
        

sub get_file_directory {
    return get_directory(shift);
}

sub get_url {
    return get_directory(shift);
}

# get the directory from command line info, interpreting yymm codings
# There's a race here, what if it is just before midnight on the last 
# day of the month?
sub get_directory {
    my $directory = shift;

    my ($year, $month, $twoyear);
    # we have the following options
    # yymm
    # yy/mm
    # yyyymm
    # yyyy/mm
    # need to create that info
    ($year, $month) = (gmtime(time))[5,4];
    $month++;
    $year+=1900;
    $month =~ s/^(\d)$/0$1/;
    $twoyear = $year;
    $twoyear =~ s/^\d\d//;

    if ($directory =~ s(/yymm/?$)(/)) {
        $directory .= "$twoyear$month/";
    } elsif ($directory =~ s(/yy/mm/?$)(/)) {
        $directory .= "$twoyear/$month/";
    } elsif ($directory =~ s(/yyyymm/?$)(/)) {
        $directory .= "$year$month/";
    } elsif ($directory =~ s(/yyyy/mm/?$)(/)) {
        $directory .= "$year/$month/";
    } elsif ($directory !~ m(/$)) {
        $directory .= '/';
    }

    return $directory;
}
        



# return false if this does not appear to be a text/plain message
sub text_plain {
    my $header = shift;

    return ($header !~ /^Content-type:/im ||
            $header =~ /^Content-type:.*text\/plain/im);
}

# split the message into header and footer
sub read_message {
    my $message = join('', <STDIN>);
    return (split(/^$/m, $message, 2));
}