110 lines
3.1 KiB
Perl
110 lines
3.1 KiB
Perl
#!/bin/perl
|
|
|
|
#(Message inbox:15)
|
|
#Return-Path: Majordomo-Users-Owner@greatcircle.com
|
|
#Message-Id: <m0oXmfl-0002wDC@hock.bolis.sf-bay.org>
|
|
#From: Alan Millar <amillar@bolis.sf-bay.org>
|
|
#Subject: Perl prog to create list archives
|
|
#To: majordomo-users@greatcircle.com
|
|
#Date: Wed, 1 Sep 1993 00:32:03 -0800 (PDT)
|
|
#Cc: brent@greatcircle.com
|
|
#Reply-To: Alan Millar <AMillar@bolis.sf-bay.org>
|
|
#
|
|
#
|
|
#Hi-
|
|
#
|
|
#Here is a perl program I wrote to keep mailing list archives.
|
|
#It is designed to produce list archive files similar to Revised
|
|
#Listserv. Each message is separated by a line of "==="s and
|
|
#most of the header "noise" is gone. Instead of being stored
|
|
#in one big file, they are split into one file per month with
|
|
#the name logYYMM where YY and MM are the numeric year and
|
|
#month.
|
|
#
|
|
#I call it from /usr/lib/aliases using:
|
|
#
|
|
# listname-archive: "|/usr/local/mail/majordomo/wrapper archive.pl \
|
|
# /usr/local/mail/lists/listname.archive"
|
|
#
|
|
#Where the last parameter is the directory name to put the
|
|
#log files into.
|
|
#
|
|
#Give it a try and let me know what you think.
|
|
#
|
|
#- Alan
|
|
#
|
|
#---- ,,,,
|
|
#Alan Millar amillar@bolis.SF-Bay.org __oo \
|
|
#System Administrator =___/
|
|
#The skill of accurate perception is called cynicism by those who don't
|
|
#possess it.
|
|
#----
|
|
|
|
|
|
# archive.pl
|
|
# Mailing list archiver. Specify the directory (not the file)
|
|
# on the command line. Messages are written to a file
|
|
# called 'logYYMM' in that directory, where YY is the two digit
|
|
# year and MM is the two-digit month.
|
|
|
|
# Written by Alan Millar August 25 1993.
|
|
|
|
# All these should be in the standard PERL library
|
|
unshift(@INC, $homedir);
|
|
require "majordomo.pl"; # all sorts of general-purpose Majordomo subs
|
|
require "shlock.pl"; # NNTP-style file locking
|
|
|
|
# The headers we want to keep, in order:
|
|
@keepHeaders =
|
|
( "To", "cc"
|
|
, "from", "reply-to", "organization"
|
|
, "date", "subject"
|
|
, "summary", "keywords"
|
|
, "Content-Type"
|
|
);
|
|
|
|
#-----------------------------------
|
|
# Set up output file. See if directory is specified on command line.
|
|
$outputDir = $ARGV[0];
|
|
if (! -d $outputDir) {
|
|
$outputDir = "/tmp";
|
|
}
|
|
$outputDir =~ s/\/$//; # drop trailing slash
|
|
|
|
#------------------------------------
|
|
# Get date for log file name
|
|
($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time);
|
|
|
|
# log file name is form "logYYMM"
|
|
$logFile = sprintf("$outputDir/log%2.2d%2.2d",$year,$mon + 1);
|
|
|
|
# open output file
|
|
&lopen(OUTPUT,">>",$logFile);
|
|
|
|
# Parse the mail header of the message, so we can figure out who to reply to
|
|
&ParseMailHeader(STDIN, *hdrs);
|
|
|
|
# Print the headers we want
|
|
|
|
print OUTPUT "========================================";
|
|
print OUTPUT "======================================\n";
|
|
|
|
foreach $key (@keepHeaders) {
|
|
$key =~ tr[A-Z][a-z];
|
|
if (defined($hdrs{$key})) {
|
|
$newKey = $key; substr($newKey,0,1) =~ tr/a-z/A-Z/;
|
|
printf OUTPUT "%-15s%s\n", "$newKey: ", $hdrs{$key};
|
|
} # if non-blank
|
|
} # foreach
|
|
|
|
print OUTPUT "\n";
|
|
|
|
# copy the rest of the message
|
|
|
|
while (<STDIN>) {
|
|
print OUTPUT $_;
|
|
}
|
|
print OUTPUT "\n";
|
|
|
|
&lclose(OUTPUT);
|