I wrote a super-simple Perl script to change listproc archives to
LISTSERV format, and then it was enhanced a lot by Steve Howie at
University of Guelph. Here it is; if you enhance it further, please
send me or him a copy. Right now it keeps only minimal (SHORT) headers,
so any MIME you have in the archives will be destroyed -- you'd have to
make it more intelligent to keep other headers appropriately, if you
didn't want that side effect. For old archives it's probably fine ...
--
Norm
Do what you can, with what you have, where you are. [Theodore Roosevelt]
==========================================================================
#!/usr/local/bin/perl
#####################################################################
#
# Program Name: archive_migrate
#
# Function: migrates Listproc 6.0c format archive files to
# LISTSERV 1.8b minimal digest format notebooks
#
# Author: 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("\tProcessing Listproc 6.0c archive %s..", $archive);
$arch_tot++; # Bump total
$newname = $archive;
#
# Only rename and uncompress .z archives
#
if (/\.z$/) {
printf("\n\t\trenaming");
$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("\n\t\tuncompressing");
$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("\n\t\tconverting");
$result = 0;
$result = &convert($newname);
if ($result == 1) {
printf("Error converting archive %s, skipping this archive\n", $newname);
$err_flag = 1;
next;
}
printf("\t\t-- DONE --\n\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;
while (<INFILE>) {
if ($body) {
if (/^From .* \d\d\d\d$/ ) {
$body = 0;
} else {
print NEWARCH;
}
} else {
if (/^$/) {
$body = 1;
print NEWARCH <<"FOO";
========================================================================
Date: $headerline{"Date"}
Sender: $oldlistaddr
From: $headerline{"From"}
Subject: $headerline{"Subject"}
FOO
$headerline{"Subject"} = "";
$headerline{"From"} = "";
$headerline{"Date"} = "";
} else {
chop;
if (! /^\s+(.*)/) {
$toprint = (($hdr,$info)=/^(From|Date|Subject)\:\s+(.*)/);
$headerline{$hdr} = $info if $toprint;
} else {
$headerline{$hdr} .= " $1" if $toprint;
}
}
}
}
close(NEWARCH);
close(INFILE);
return 0;
}
|
