#!/usr/bin/perl

=pod

=head1 NAME

split-linguist - Unpack digest messages from the LINGUIST mailing list.

=head1 DESCRIPTION

C<split-linguist> takes a digest message from the LINGUIST mailing list in Unix
mailbox format and splits it up.  Each sub-message in the digest is converted
into its own email message; the digest itself with all sub-messages removed is
also preserved as an additional email message.  Consequently, this program turns
a LINGUIST digest with I<n> sub-messages into I<n>S< + 1> email messages.

C<split-linguist> is suitable for use as an incoming mail filter.  For example,
the following C<procmail> recipe splits and files into the "linguist" folder
every incoming LINGUIST message:

    :0:
    * ^From:.*\<linguist@linguistlist\.org\>
    | path/to/split-linguist | formail -s >>$MAILDIR/linguist

For current information on this program, see
http://www.digitas.harvard.edu/~ken/linguist/.
For more information on the LINGUIST mailing list, see
http://www.linguistlist.org/.

=head1 PREREQUISITES

See L<Mail::Internet> and L<Mail::Util>.

=head1 VERSION

This version of C<split-linguist> is dated 2001-12-03.

=head1 COPYING

Copyright (c) 2001, Chung-chieh Shan <ken@digitas.harvard.edu>
All rights reserved.

Redistribution and use in source and binary forms, with or without
modification, are permitted provided that the following conditions are met:

=over 4

=item

Redistributions of source code must retain the above copyright notice, this list
of conditions and the following disclaimer.

=item

Redistributions in binary form must reproduce the above copyright notice, this
list of conditions and the following disclaimer in the documentation and/or
other materials provided with the distribution.

=item

Neither the name of Harvard University nor the names of its contributors may be
used to endorse or promote products derived from this software without specific
prior written permission.

=back

THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR ANY
DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON
ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

=head1 SCRIPT CATEGORIES

CPAN/Mail

=cut

require 5;
use strict;
use Mail::Internet;
use Mail::Util 'maildomain';

my $hostname = maildomain;

my $mail = Mail::Internet->new([<>]);
$mail->unescape_from;

my $head = $mail->head;
my $msg_id = $head->get("Message-ID");
my @sub_head_from_main = (["From ", scalar($head->get("From ")), 0]);
foreach my $key (qw(Mime-Version Content-Type
    Content-Transfer-Encoding Sender Reply-To To Status))
  { push @sub_head_from_main, map [$key, $_], $head->get($key) }
foreach my $key (qw(Date From Subject))
  { push @sub_head_from_main, map ["X-List-$key", $_], $head->get($key) }

my $body = $mail->body;

my @main;
my @sub;
my $sub_n;

sub flush_sub
{
    if (defined $sub_n)
    {
        shift @sub while @sub > 0 and $sub[0] =~ /^\s*$/s;
        my $sub = Mail::Internet->new(\@sub);
        $sub->tidy_body;

        my $sub_head = $sub->head;
        $sub_head->add(@$_) foreach @sub_head_from_main;
        my $sub_msg_id = $msg_id;
           $sub_msg_id =~ tr/@/./;
           $sub_msg_id =~ s/(>?)$/.$sub_n\@$hostname$1/;
        $sub_head->delete("Message-ID");
        $sub_head->add("Message-ID", $sub_msg_id);
        $sub_head->add("References", $msg_id);

        print $sub->as_mbox_string;
        undef $sub_n;
        undef @sub;
    }
}

foreach my $line (@$body)
{
    if (my ($new_n) = ($line =~
        /^\s*-{30,38}(?:\s*Message\s*(\d+)\s*)?-{30,38}\s*$/is))
    {
        flush_sub;
        push @main, $line;
        $sub_n = $new_n;
    }
    elsif (defined $sub_n)
    {
        push @sub, $line;
    }
    else
    {
        push @main, $line;
    }
}
flush_sub;

print Mail::Internet->new(Header => $head, Body => \@main)->as_mbox_string;
print STDERR scalar($head->get("Subject"));