#! /usr/bin/perl
#####################################################################
#
# Program Name: archive_migrate
#
# Function:     migrates Listproc 6.0c format archive files to
#               LISTSERV 1.8b minimal digest format notebooks
#
# Comment:      In fact converts any UNIX mailbox format
#               file to notebook format which can be read by
#               virtually any LISTSERV version.
#
# Author:       Peter 'Rattacresh' Backes, PLASMA ORGANIZATION
#               ([log in to unmask])
#               Based on work originally done by Steve Howie
#               (CCS. University of Guelph)
#               Based on work originally done by Norm Aleks
#               ([log in to unmask])
#
# Logic:
#       archive_mig will traverse each subdirectory in the
#       $HOME/archives/lists directory, converting each archive
#       file it finds into Listserv Minimal Digest format. It stores
#       each converted archive file under a subdirectory of $newarch_root.
#       This tree can then be moved en masse to it's new home, and the
#       permissions / ownerships adjusted accordingly.
#
#       When processing each directory, you will be prompted for the
#       full list name for the "Sender:" field in the archive.
#
#       If an error is encountered processing an archive, it will be
#       skipped, a flag set and the archive processing will stop after
#       the last archive in that directory
#
#       You have the opportunity to skip directories if you wish
#
#####################################################################
require "pwd.pl";               # To get a half-assed accurate pwd function
$SIG{'INT'} = 'handler';        # Set up a handler to catch ctrl-C
print <<EOF;
**************************************************************
*
*       Listproc -> Listserv Archive Migration Utility
*
**************************************************************
EOF
$newarch_root = "/var/tmp";     # Root for converted archives
$home_dir = `pwd`;
chop($home_dir);

opendir(THISDIR,".");                   # Read all list directory names
$num = @alldirs =  sort grep(-d, grep(!/^\./, readdir(THISDIR)));
closedir(THISDIR);

printf("\nFound a total of %d list archive directories. Continuing ..\n", $num);

&initpwd;
$err_flag = 0;
$list_tot = $skip_tot = $arch_tot = 0;
#
#       Process each lists archive directory
#
foreach $i (@alldirs) {
    if ($err_flag == 1) {
        print "Errors encountered processing archives. Please check logs\n";
        exit;
    }
    $location = "$home_dir\/$i";
    next if ($location eq "/users/u/2/showie/archive"); #local mod
    printf("\n>>>> Processing directory %s, press \"y\" to continue..", $i);
    $yn = <STDIN>;
    chop($yn);
    if ($yn ne "y") {
        print "Skipping directory $i ... \n";
        $skip_tot++;
        next;
    }
    $list_tot++;
    print "Please enter the title of the group: ";
    $oldlistaddr = <STDIN>;
    chop($oldlistaddr);
    print "Creating Directory ", $newarch_root."/".$i, " ...\n";
    mkdir("$newarch_root/$i",0755);  # Create new archive directory subtree
    &chdir($location);  # Move into next directory to process
    #
    #  get a list of all archive files in the directory
    #
    opendir(THISDIR,".");
    @newfiles = sort  grep(/^[0-9]/,grep(!/^\./, readdir(THISDIR)));
    closedir(THISDIR);
    #
    #  Process each archive file inside the directory
    #
    foreach $archive (@newfiles) {
        printf("Processing archive %s..", $archive);
        $arch_tot++;    # Bump total
        $newname = $archive;
        #
        # Only rename and uncompress .z archives
        #
        if (/\.z$/) {
            printf(".");
            $newname =~ tr/z/Z/;
            if (rename($archive,$newname) == 0) {
                printf("Error renaming %s to %s, skipping this archive\n", $archive, $newname);
                $err_flag = 1;
                next;
            }
            printf(".");
            $result = system("uncompress $newname");
            if ($result != 0) {
                printf("Error uncompressing %s, skipping this archive\n", $newname);
                $err_flag = 1;
                next;
            }
            chop($newname);
            chop($newname);
        }
        printf(".");
        $result = 0;
        $result = &convert($newname);
        if ($result == 1) {
            printf("Error converting archive %s, skipping this archive\n", $newname);
            $err_flag = 1;
            next;
        }
        printf(" DONE\n");
    }
}
printf("\n\nProcessed %d list(s) and %d archives. A total of %d lists were skipped. \n\n", $list_tot, $arch_tot, $skip_tot);

exit 0;

#
# Signal Handler for ctrl-C
#
sub handler {
    print "User pressed CTRL-C, exiting..\n";
    exit(0);
}

#
# Do the actual archive conversion
#
sub convert {
    ($archive_name) = @_;

    open(NEWARCH, "> $newarch_root/$i/log$archive_name");
    open(INFILE, $archive_name);
    #print "\n\t\tCreating new Listserv archive: $newarch_root/$i/log$archive_name\n";
    $body = 0;
    $delm = 0;
    while (<INFILE>) {
        if ($body) {
            if (/^From .* \d\d\d\d$/ ) {
                $body = 0;
                $delm = 0;
            } else {
                if ($delm) {
                    print NEWARCH "\n";
                }
                if (/^$/) {
                    $delm = 1;
                } else {
                    $delm = 0;
                    print NEWARCH;
                }
            }
        } else {
            if (/^$/) {
                $body = 1;
                print NEWARCH     "=========================================================================\n";
                print NEWARCH     "Date:         $headerline{'DATE'}\n";
                if ($headerline{'REPLY-TO'} ne "") {
                    print NEWARCH "Reply-To:     $headerline{'REPLY-TO'}\n"; }
                else {
                    print NEWARCH "Reply-To:     $oldlistaddr\n"; }
                print NEWARCH     "Sender:       $oldlistaddr\n";
                if ($headerline{'FROM'} ne "") {
                    print NEWARCH "From:         $headerline{'FROM'}\n"; }
                if ($headerline{'ORGANIZATION'} ne "") {
                    print NEWARCH "Organization: $headerline{'ORGANIZATION'}\n"; }
                if ($headerline{'SUBJECT'} ne "") {
                    print NEWARCH "Subject:      $headerline{'SUBJECT'}\n"; }
                if ($headerline{'IN-REPLY-TO'} ne "") {
                    print NEWARCH "In-Reply-To:  $headerline{'IN-REPLY-TO'}\n"; }
                if ($headerline{'MIME-VERSION'} ne "") {
                    print NEWARCH "MIME-Version: $headerline{'MIME-VERSION'}\n"; }
                if ($headerline{'CONTENT-TYPE'} ne "") {
                    print NEWARCH "Content-type: $headerline{'CONTENT-TYPE'}\n"; }
                if ($headerline{'CONTENT-TRANSFER-ENCODING'} ne "") {
                    print NEWARCH "Content-Transfer-Encoding: $headerline{'CONTENT-TRANSFER-ENCODING'}\n"; }
                print NEWARCH "\n";
                $headerline{'DATE'} = "";
                $headerline{'REPLY-TO'} = "";
                $headerline{'FROM'} = "";
                $headerline{'ORGANIZATION'} = "";
                $headerline{'SUBJECT'} = "";
                $headerline{'IN-REPLY-TO'} = "";
                $headerline{'MIME-VERSION'} = "";
                $headerline{'CONTENT-TYPE'} = "";
                $headerline{'CONTENT-TRANSFER-ENCODING'} = "";
            } else {
                chop;
                if (! /^\s+(.*)/) {
                    $toprint = (($hdr,$info)=/^([a-zA-Z][a-zA-Z-]*)\:\s+(.*)/i);
                    $hdr =~ tr/a-z/A-Z/;
                    $headerline{$hdr} = $info if $toprint;
                } else {
                    $headerline{$hdr} .= " $1" if $toprint;
                }
            }
        }
    }
    close(NEWARCH);
    close(INFILE);
    return 0;
}