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
