On November 11, 1999 at 02:08, Gunnar Hjalmarsson wrote:
2. that are stored on other servers to which I have POP3 access.
Regarding 2., I have been recommended to use Net::POP3, but I'm not able
to find out how to use that protocol together with MHonArc.
Attached is a sample Perl program that archives mail using POP.
The program has been edited from a real program I wrote inorder
to protect the guilty. Use at your own risk.
--ewh
#!/usr/local/bin/perl
##############################################################################
## File:
## archive.pl
## Author(s):
## Earl Hood
## Description:
## Sample archiving of mail with MHonArc using POP. Mail is
## read from a POP server a filter to different archives based
## on which list the mail is addressed to. Original messages
## are stored in MMDF format broken up by month.
##
## This script is designed to be invoked from cron.
## Dependencies:
## FileHandle module
## Net::POP3 module
## MHonArc, <http://www.pobox.com/~ehood/mhonarc.html>
##############################################################################
package POPArchive;
##############################################################################
## BEGIN CONFIGURATION SECTION
##############################################################################
my $debug = 0;
## POP3 connection parameters
my $pophost = 'pop.somedomain.com';
my $user = 'archiveuser';
my $pass = 'somepassword';
my $timeout = 180;
## Root location for mailbox files and html archives
my $root = '/www/archives';
my $index = "$root/index.html"; # Master index of all archives
my $dirmbox = "$root/mbox"; # Location to place raw messages
my $dirhtml = "$root/html"; # Location to place list archives
my $mharc = "$root/html/archive.mrc";
## How long to keep messages in html archive
#my $expireage = 2635200; # month
my $expireage = 1317600; # half a month
##############################################################################
## END CONFIGURATION SECTION
##############################################################################
use Net::POP3;
use FileHandle;
sub L_TITLE () { 0; };
sub L_MBOX () { 1; };
sub L_HTML () { 2; };
sub L_MBOXFH () { 3; };
umask 002;
print STDERR "Initializing MHonArc ...\n" if $debug;
require 'mhamain.pl' or die qq/Unable to require mhamain.pl: $!\n/;
mhonarc::initialize();
print STDERR "MHonArc initialized\n" if $debug;
my $msgsep = "\001\001\001\001";
my $time = time;
my($mon, $year) = (localtime($time))[4,5]; ++$mon; $year += 1900;
my $mboxdate = sprintf("%4d%02d", $year, $mon);
my %lists = (
'list1' => [
'List 1 Title',
join('/', $dirmbox, 'list1'),
join('/', $dirhtml, 'list1'),
undef,
],
'list2' => [
'List 2 Title',
join('/', $dirmbox, 'list2'),
join('/', $dirhtml, 'list2'),
undef,
],
);
my @args = ($pophost, 'Timeout', $timeout);
push(@args, 'Debug' => 9) if $debug;
print STDERR "Attempting to instanstiate Net::POP3(@args) ...\n" if $debug;
my $pop = Net::POP3->new(@args);
die qq/Unable to instantiate Net::POP3 object/ if !defined($pop);
my $retcode = -1;
MAIN: {
print STDERR "Open connection to $pophost\n" if $debug;
my $cnt = $pop->login($user, $pass);
if (!defined($cnt)) {
warn qq/Problem logining into $pophost/;
last MAIN;
}
print STDERR "Connection established\n" if $debug;
my $msgs = $pop->list();
if (!defined($cnt)) {
warn qq/Problem getting message list from $pophost/;
last MAIN;
}
print STDERR "Retrieved message list\n" if $debug;
last MAIN unless $cnt > 0;
my($msg, $msgnum, $line, $list, $to, $subject, $tmp, $key, $aref, $fh,
$mboxpn);
my(%header);
## Loop thru each message and append to appropriate mailbox
print STDERR "Looping thru messages\n" if $debug;
foreach $msgnum (sort { $a <=> $b } keys %$msgs) {
print STDERR "reading message $msgnum\n" if $debug;
$msg = $pop->get($msgnum);
next unless defined $msg;
## Grab message header
%header = ( ); $aref = undef;
foreach $line (@$msg) {
last if $line =~ /^$/;
$tmp = $line; chomp $tmp;
if ($tmp =~ s/^\s//) {
next unless defined $aref;
$aref->[$#$aref] .= $tmp;
next;
}
if ($tmp =~ s/^([^:]+):\s*//) {
$key = lc $1;
if (defined($header{$key})) { $aref = $header{$key}; }
else { $aref = $header{$key} = [ ]; }
push(@$aref, $tmp);
next;
}
}
print STDERR "$msgnum: read header\n" if $debug;
## Determine which list
$list = '';
TO: foreach $key ('to', 'cc') {
next unless defined $header{$key};
LINE: foreach $line (@{$header{$key}}) {
print STDERR "$msgnum: $key: $line\n" if $debug;
if ($line =~ /\blist1@/i) {
$list = 'list1'; last TO; }
if ($line =~ /\blist2@/i) {
$list = 'list2'; last TO; }
} ## LINE: foreach
} ## TO: foreach
if (!$list) {
## Could not determine archive from address, so check subject
print STDERR "$msgnum: Subject: ",
$header{'subject'}[0], "\n" if $debug;
if ($header{'subject'}[0] =~ /^\s*([^:]+):/) {
$list = lc $1;
}
$list = 'list1' unless defined $lists{$list};
}
print STDERR "$msgnum: list = $list\n" if $debug;
## Open mailbox
if (!defined($lists{$list}[L_MBOXFH])) {
mkdir $lists{$list}[L_MBOX], 0777;
$mboxpn = join("/", $lists{$list}[L_MBOX], $mboxdate);
$fh = FileHandle->new(">>$mboxpn");
if (!defined($fh)) {
warn qq/Unable to append "$mboxpn": $!\n/;
last MAIN;
}
$lists{$list}[L_MBOXFH] = $fh;
} else {
$fh = $lists{$list}[L_MBOXFH];
}
print STDERR "$msgnum: appending to", $lists{$list}[L_MBOX], "\n"
if $debug;
print $fh "$msgsep\n", @$msg;
} continue {
$pop->delete($msgnum);
}
print STDERR "Closing connection\n" if $debug;
$pop->quit();
undef $pop;
print STDERR "Connection closed\n" if $debug;
## Update HTML archives
my $mhacode = 0;
my @mhargs = ( );
while (($list, $aref) = each(%lists)) {
next unless defined $aref->[L_MBOXFH];
$aref->[L_MBOXFH]->close();
print STDERR "Updating ", $aref->[L_HTML], "\n" if $debug;
mkdir $aref->[L_HTML], 0777;
@mhargs = (
'-add',
'-outdir', $aref->[L_HTML],
'-rcfile', $mharc,
'-msgsep', "^$msgsep",
'-expireage', $expireage,
'-title', $aref->[L_TITLE],
'-ttitle', ($aref->[L_TITLE] . " (thread)"),
join("/", $aref->[L_MBOX], $mboxdate),
);
unshift(@mhargs, '-quiet') unless $debug;
if (!mhonarc::process_input(@mhargs)) {
$mhacode = $mhonarc::CODE;
}
}
## Update master index. The master index is treated as a template.
## Special comment declaractions are looked for to add in date
## information.
print STDERR "Updating master index ...\n" if $debug;
my $tmpfile = $index . ".$$";
local(*INFILE, *TMPFILE);
if (!open(INFILE, $index)) {
warn qq/Unable to open "$index": $!\n/;
last MAIN;
}
if (!open(TMPFILE, ">$tmpfile")) {
warn qq/Unable to create "$tmpfile": $!\n/;
close INFILE;
last MAIN;
}
local $_;
my($com);
IN: while (<INFILE>) {
if (s/^<!--X-([^-]+)//) {
$com = $1;
chomp;
if ($com eq 'Expires') {
print STDERR "Found Expires tag: $_\n" if $debug;
print TMPFILE qq|<!--X-Expires-->|,
qq|<META HTTP-EQUIV="expires" CONTENT="|,
scalar(gmtime($time+3600)), qq| GMT">\n|;
next IN;
}
if ($com eq 'Date') {
print STDERR "Found Date tag: $_\n" if $debug;
($list) = $_ =~ /^-([^-]+)/;
if (defined($lists{$list}[L_MBOXFH])) {
print STDERR "Updating date for $list\n" if $debug;
print TMPFILE qq|<!--X-Date-$list-->|,
scalar(localtime($time)), qq|\n|;
} else {
print TMPFILE "<!--X-$com$_\n";
next IN;
}
next IN;
}
print TMPFILE "<!--X-$com$_\n";
next IN;
}
print TMPFILE $_;
}
close TMPFILE;
close INFILE;
if (!rename($tmpfile, $index)) {
warn qq/Unable to rename "$tmpfile" to "$index": $!\n/;
unlink $tmpfile;
last MAIN;
}
$retcode = $mhacode;
}
$pop->quit() if defined $pop;
print STDERR "Done\n" if $debug;
exit($retcode);