#!/usr/bin/perl
##---------------------------------------------------------------------------##
##  File:
##      mhn2mbox
##  Version:
##      0.38 Nov 28 12:36:27 EST 2002
##  Author:
##      Anthony W       anthonyw@albany.net
##  Description:
##      A utility for converting MHonArc html archives into pseudo mbox
##      format.
##  Usage:
##      mhn2mbox /path/to/mhonarc/archives [ your-output-file ]
##
##---------------------------------------------------------------------------##
##    Copyright (C) 2000        AnthonyW anthonyw@albany.net
##
##    This program is free software; you can redistribute it and/or modify
##    it under the terms of the GNU General Public License as published by
##    the Free Software Foundation; either version 2 of the License, or
##    (at your option) any later version.
##
##    This program is distributed in the hope that it will be useful,
##    but WITHOUT ANY WARRANTY; without even the implied warranty of
##    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
##    GNU General Public License for more details.
##
##    You should have received a copy of the GNU General Public License
##    along with this program; if not, write to the Free Software
##    Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
##    02111-1307, USA
##---------------------------------------------------------------------------##

# Library where MHonArc libs
# are located. CHANGE THIS TO MATCH YOUR SITE
use lib '/usr/lib/perl5/site_perl/5.6.0';

use HTML::Entities;
require 'mhamain.pl';
require 'base64.pl';
use strict;

my $NoArgs   = 1;
my $USAGE    = "Usage: $0 html_dir [output_file]\n";
my $HTML_DIR = shift || die $USAGE;
my $OUTPUT_FILE = shift || '-';        # write to STDOUT by default
my $debug       = $ENV{'CMD_DEBUG'};

print STDERR "HTML_DIR=$HTML_DIR\n" if $debug;

MAIN: {

    mhonarc::initialize();
    #mhonarc::get_resources();
    print STDERR "MHonArc initialized.\n" if $debug;
    require 'ewhutil.pl';
    require 'mhtime.pl';
    require 'mhutil.pl';

    local (*DIR);

    print STDERR "Reading $HTML_DIR.\n" if $debug;
    opendir(DIR, $HTML_DIR) || die qq/Unable to open "$HTML_DIR": $!/;
    my @files = grep(/^msg/i, readdir(DIR));
    closedir(DIR);

    open(MBOXFILE, ">$OUTPUT_FILE")
        || die qq/Unable to open "$OUTPUT_FILE": $!/;

    foreach (sort @files) {
        my $name = "$HTML_DIR/" . $_;
        print STDERR "working on: $name\n" if $debug;
        &load_data($name);
        print MBOXFILE "\n\n";    # sometimes necessary to seperate messages
    }

    close(MBOXFILE);
}

##---------------------------------------------------------------------------##
##      load_data: Function to read information from the headers of the html
## files produced by mhonarc. Adapted from mhmsgfile.pl
##
sub load_data {

    my $addendum = my $contype = my $index = my $datestr = "";
    my $from_addr   = my $email_addr = my $binfile  = "";
    my $description = my $docname    = my $boundary = "";
    my $filename = shift;    # Name of file to read
    local (*MSGFILE);
    my @Derived  = ();
    my @bodytext = ();
    my @array    = ();

    if (!open(MSGFILE, $filename)) {
        warn qq/Warning: Unable to open "$filename": $!\n/;
        return 0;
    }
    my $href = parse_data(\*MSGFILE);
    close(MSGFILE);

    my $date = $href->{'date'}[0];

# $day[$wday].', '.$d2[$mday].' '.$month[$mon].' '.($year+1900).' '.$d2[$hour].':'.$d2[$min].':'.$d2[$sec].' GMT';

    ## Determine date of message
    if (($date =~ /\S/) && (@array = mhonarc::parse_date($date))) {
        $index = mhonarc::get_time_from_date(@array[1 .. $#array]);
    } else {
        $index = time;
        $date = mhonarc::time2str("", $index, 1) unless $date =~ /\S/;
    }

    if (defined($href->{'from-r13'})) {
        $from_addr  = mhonarc::mrot13($href->{'from-r13'}[0]);
        $email_addr = &extract_email_address($from_addr);
        #$email_addr = mhonarc::extract_email_address($from_addr);
        print MBOXFILE "From $email_addr $date\n";
        print MBOXFILE "From: $from_addr\n";
    } elsif (defined($href->{'from'})) {
        $from_addr  = $href->{'from'}[0];
        $email_addr = &extract_email_address($from_addr);
        #$email_addr = mhonarc::extract_email_address($from_addr);
        print MBOXFILE "From $email_addr $date\n";
        print MBOXFILE "From: $from_addr\n";
    } else {
        print STDERR "WARNING: From Anonymous\n" if $debug;
        $from_addr  = 'Anonymous';
        $email_addr = mhonarc::extract_email_address($from_addr);
        print MBOXFILE "From $email_addr $date\n";
        print MBOXFILE "From: $from_addr\n";
    }

    print MBOXFILE "Date: $date\n";

    if (defined($href->{'msgtoheader'})) {
        print MBOXFILE "To: $href->{'msgtoheader'}[0]\n";
    }
    if (defined($href->{'subject'})) {
        print MBOXFILE "Subject: $href->{'subject'}[0]\n";
    }

    if (defined($href->{'reference'})) {
        print MBOXFILE "In-Reply-To: <$href->{'reference'}[0]>\n";
    }

    if (defined($href->{'message-id'})) {
        print MBOXFILE "Message-ID: <$href->{'message-id'}[0]>\n";
    }

    print MBOXFILE "MIME-Version: 1.0\n";

    if (defined($href->{'content-type'})) {
        $contype = $href->{'content-type'}[0];
    } elsif (defined($href->{'contenttype'})) {    # older versions
        $contype = $href->{'contenttype'}[0];
    }

    if (defined($href->{'msgbodytext'})) {
        push(@bodytext, @{$href->{'msgbodytext'}});
    }

    if ($contype =~ /multipart/i) {
        $boundary = join("", $$, '.', time, '.', $contype);

        if (defined($href->{'derived'})) {

            print MBOXFILE
                "Content-Type: $contype; boundary=\"Boundary..$boundary\"\n";
            push(@Derived, @{$href->{'derived'}});
            print STDERR "Attachments: ", join(',', @Derived), "\n" if $debug;
            pop(@bodytext);

            foreach $binfile (reverse @Derived) {
                $description = pop(@bodytext);
                $docname     = $binfile;
                $addendum .= "\n--Boundary..$boundary\n";
                $addendum .=
                    "Content-Type: application\/octet-stream\; name=\"$docname\"\n";
                $addendum .= "Content-Transfer-Encoding: base64\n";
                $addendum .=
                    "Content-Disposition: attachment\; filename=\"$docname\"\n";
                $addendum .= "Content-Description: \"$description\"\n\n";
                $addendum .= join("", mime_encode("$HTML_DIR/$binfile"));
            }

            print MBOXFILE "\n--Boundary..$boundary\n";
            print MBOXFILE "Content-Type: text/plain\n";
            print MBOXFILE "Content-Transfer-Encoding: 7bit\n";
            print MBOXFILE join("\n", @bodytext);
            print MBOXFILE "\n";
            print MBOXFILE "$addendum";
            print MBOXFILE "--Boundary..$boundary--\n\n";

        } else {

            print MBOXFILE "Content-Type: text\/plain\n";
            print MBOXFILE join("\n", @bodytext);

        }
    } else {

        print MBOXFILE "Content-Type: $contype\n\n";
        print MBOXFILE join("\n", @bodytext);

    }
}

##---------------------------------------------------------------------------##
##      parse_data(): Function to parse the initial comment
##      declarations of a MHonArc message file into a hash.  A refernce
##      to resulting hash is returned.  Keys are the field names, and
##      values are arrays of field values. Adapted from mhmsgfile.pl
##
sub parse_data {
    my $fh    = shift;     # An open filehandle
    my $start = "true";
    my $head  = "false";
    my $subj  = "false";
    my $tail  = "false";
    my $body  = "false";
    my ($field, $value);
    my $AddrExp = '[^()<>@,;:\/\s"\'&|]+@[^()<>@,;:\/\s"\'&|]+';
    my %field   = ();
    local ($_);

    while (<$fh>) {

        if (/^<!--X-Head-End-->/) {
            $start = "false";
            next;
        }
        if (/^<!--X-Head-of-Message/) {
            $head = "true";
            next;
        }
        if (/^<!--X-Body-Begin-->/) {
            $subj = "true";
        }
        if (/^<!--X-Body-of-Message/) {
            last if s/^<!--X-Body-of-Message-End//;
            $body = "true";
            $head = "false";
            next;
        }
        if ($start eq "true") {
            next unless s/^<!--X-//;    # Skip non-field lines
            chomp;
            s/ -->$//;
            s/<a(.*?)href="(.*)"(.*?)>(.*)<\/a>/$7/ig;
            s/&lt;/</g;
            s/&gt;/>/g;
            s/&quot;/"/g;
            ($field, $value) = split(/: /, $_, 2);
            push(@{$field{lc $field}}, mhonarc::uncommentize($value));
            next;
        }
        if ($head eq "true") {
            if (/^<li><em>To<.*?>:/i) {
                s/<\/li>//ig;
                s/<\/ul>//ig;
                s/<a( |  )href="(.*)">(.*)<\/a>/$3/ig;
                s/&lt;/</g;
                s/&gt;/>/g;
                s/&quot;/"/g;
                chomp;
                ($field, $value) = split(/: /, $_, 2);
                $field = "msgtoheader";
                push(@{$field{lc $field}}, $value);
                $head = "false";
            }
            next;
        }
        if ($body eq "true") {
            # Extract URLs
            chomp;
            next if /<!--X-Body-of-Message-->/;
            next if /^<(.*?)ul>$/i;

            $_ = decode_html($_);

            s/<a(.*?)href="(.*)"(.*?)>(.*)<\/a>/$4/ig;
            $field = "msgbodytext";
            $value = $_;
            chomp;
            push(@{$field{lc $field}}, $value);
            next;
        }
    }
    \%field;
}

##---------------------------------------------------------------------------##
##  subroutine to base64 encode a file
##---------------------------------------------------------------------------##

sub mime_encode {
    my $file         = shift;
    my @encoded_data = ();
    local $/;    # enable data slurp
    open(MMENCODE, "$file");
    print STDERR "MIME-encoding: $file\n" if $debug;
    @encoded_data = base64::b64encode(<MMENCODE>);
    close MMENCODE;
    return @encoded_data;
}

##---------------------------------------------------------------------------##
## Subroutine to remove html tags from a string
##---------------------------------------------------------------------------##
sub decode_html {

    s/<[^>]*>//gs;    # from page 716 of the "Perl Cookbook"
    $_ = decode_entities($_);
    return $_;
}

##---------------------------------------------------------------------------##
## Subroutine to extract email addresses. Taken from mhutil.pl
##---------------------------------------------------------------------------##
sub extract_email_address {

    ##  Regexp for address/msg-id detection (looks like cussing in cartoons)
    my $AddrExp = '[^()<>@,;:\/\s"\'&|]+@[^()<>@,;:\/\s"\'&|]+';
    return '' unless defined $_[0];
    my $str = shift;

    if ($str =~ /($AddrExp)/o) {
        return $1;
    }
    if ($str =~ /<(\S+)>/) {
        return $1;
    }
    if ($str =~ s/\([^\)]+\)//) {
        $str =~ /\s*(\S+)\s*/;
        return $1;
    }
    $str =~ /\s*(\S+)\s*/;
    return $1;
}

##---------------------------------------------------------------------------##

1;
