Listing 2 Mail::Archive::Account

package Mail::Archive::Account;

use File::Basename;
use File::Path;
use File::Spec;
use Mail::Audit;
use Mail::Address;
use Mail::POP3Client;


sub new(@) {
    my $class = shift;
    my %params = @_;
    my $self = {};

    map {
        die "Cannot create account without $_" unless (exists($params{$_}));
    } qw/user password host address/;

    map {
    $self->{$_} = $params{$_};
    } keys %params;

    $self->{maildir}    = File::Spec->catfile("$ENV{HOME}", "mail")
    unless $self->{maildir};

    $self->{auth_mode}  = "PASS"              unless $self->{auth_mode};
    $self->{log}        = "log"               unless $self->{log};
    $self->{archive}    = "Archive"           unless $self->{archive};
    $self->{inbox}      = "Inbox"             unless $self->{inbox}; 
    $self->{junk}       = "Junk"              unless $self->{junk};
    $self->{filter}     = \&filter            unless $self->{filter};
    $self->{safe}       = 0                   unless $self->{safe};
    $self->{mode}       = 0700                unless $self->{mode}; 

    (my $username, my $domain) = split(/\@/, $self->{address});
    $self->{maildir} .= "/$domain" if $opts{f};
    $self->{domain} = $domain;

    for (qw(archive log junk inbox)) { 
    $self->{$_} = File::Spec->catfile($self->{maildir}, $self->{$_})
        unless ($self->{$_} =~ /^\//);
    }

    $self->{spam} = File::Spec->catfile($self->{maildir}, $self->{spam})
        if ($self->{spam} && $self->{spam} !~ /^\//);

    bless($self, $class);

    return $self;
}


sub fetch($;) {
    my $self = shift;
    my $filter = shift;

    do {print "Skipping $self->{address}\n"; return;} if ($self->{skip});

    $self->_m_mkpath($self->{maildir}) unless -d $self->{maildir};
    $self->_popread($filter);
}


sub _popread($;) {
    my $self = shift;
    my $filter = shift || $self->{filter};
    my %account = {};
    my %midcache;
    my $cache = File::Spec->catfile($ENV{HOME}, ".msgidcache");

    if (-f $cache) {%midcache = map {chomp; $_ => 1} `tail -50 $cache`};

    print "Connecting to $self->{host}...";

    for (user, password, host, auth_mode) {
        (my $upper = $_) =~ tr/a-z/A-Z/;
        $account{$upper} = $self->{$_};
    }

    my $pop = new Mail::POP3Client(%account);
    unless ($pop) { warn "Couldn't connect\n"; next; }

    my $count = $pop->Count;
    if ($count <0) { warn "Authorization failed ($$_{host})"; next; }
    print "\n";
    print "New messages: $count\n";

    my %down = map {$_ => 1} (1..$count); 
    my @mails;
    for my $num (1..$count) {
    print "\n";
    my @head = $pop->Head($num);
    for (@head) {
         /^(From|Subject):\s+(.*)/i and do {
        print "$1\t$2\n";
        $mails[$num]->{$1} = $2;
         };
         /^Message-Id:\s+(\S+)/i and do {
        if (exists $midcache{$1}) {
            print "(Duplicate)\n";
            delete $down{$num};
            $mails[$num]->{mid} = $1;
            $pop->Delete($num) unless $self->{safe};
        }
        $midcache{$1}++;
         }
    }
    }

    next unless keys %down;

    my @tocome = sort {$a <=> $b} keys %down;
    print "Downloading: @tocome\n";
    for my $num (@tocome) {
    print "Downloading message $num (", $mails[$num]->{From}, ":",
        $mails[$num]->{Subject}, ")...";

    my @mail = $pop->Retrieve($num);
    $_ .= "\n" for @mail;
    my $now = scalar localtime;
    $mail[0] =~ s/Return-Path:\s+<([^>]+)>/From $1 $now/;

    print "\n";

    if (!@mail) { 
        print "Ugh, something went wrong!\n"; 
        delete $midcache{$mails[$num]->{mid}};
        next;
    }

    my $item = Mail::Audit->new(
        data      => \@mail, 
        emergency => $self->{junk},
        log       => $self->{log},
        loglevel  => 2,
        noexit    => 1,   
        nomime    => 1,   
    ); 

        next unless $item;

        print "From: ", $item->from, "\nTo: ", $item->to, "\n";

        $self->deliver($item, $self->{junk}) 
        unless &$filter($self, $item);

    $pop->Delete($num) 
        unless $self->{safe};
    }

    $pop->Close;

    open OUT, ">$cache" or die $!;
    print OUT "$_\n" for keys %midcache;
    close OUT;
}


sub filter($$) {
    my $self = shift;
    my $item = shift;

    my $spamtest= $self->{spamtest};
    my $address    = $self->{address};
    my $domain     = $self->{domain};
    my $inbox     = $self->{inbox};
    my $maildir = $self->{maildir};
    my $archive = $self->{archive};
    my $spam     = $self->{spam};
    my $junk    = $self->{junk};

    my $to = $item->to;
    my $cc = $item->cc;
    my $from = $item->from;
    
    my $isspam = 0;
     
    if ($spam && $spamtest) {
    my $status = $spamtest->check($item);
    if ($status) {
        $isspam = $status->is_spam();
        $status->finish();
    }
    }

    return eval {
    if ($from =~ /$address/i) {             # mail from me? 
        if ($spamtest) {
        my $learner = $spamtest->learn($item);
        $learner->finish();
        }

        # if i am cc'd at the same address, deliver it, too
        $self->deliver($item, $inbox) 
        if ($to =~ /$address/i || $cc =~ /$address/i);
        $self->file($item, $archive, Mail::Address->parse($to, $cc)); 
    } 
    elsif ($to =~ /$address/i || $cc =~ /$address/i) {# directly to me, either to or cc 
        if ($isspam) {
        $self->deliver($item, $spam); 
        } else {
        $self->file($item, $archive, Mail::Address->parse($from));
        $self->deliver($item, $inbox);
        }
    } 
    elsif (($to =~ /$domain/ || $cc =~ /$domain/)) {# mail not directly to me... 
        # check if email originated from within my domain
        if ($from =~ /$domain/) {  
        $self->file($item, $archive, Mail::Address->parse($from));
        $self->deliver($item, $inbox);
        } elsif ($isspam) {
        $self->deliver($item, $spam); 
        } else {
        $self->deliver($item, $junk);
        }
    } 
    elsif ($isspam) {            # spam
        $self->deliver($item, $spam);
    } 
    else {
        0;                       # something else
    }
    };
}


sub inbox($;)     {$self = shift; $self->get("inbox", @_)};
sub junk($;)      {$self = shift; $self->get("junk", @_)};
sub spam($;)      {$self = shift; $self->get("spam", @_)};
sub maildir($;)   {$self = shift; $self->get("maildir", @_)};
sub archive($;)   {$self = shift; $self->get("archive", @_)};
sub host($;)      {$self = shift; $self->get("host", @_)};
sub address($;)   {$self = shift; $self->get("address", @_)};
sub auth_mode($;) {$self = shift; $self->get("auth_mode", @_)};
sub password($;)  {$self = shift; $self->get("password", @_)};
sub user($;)      {$self = shift; $self->get("user", @_)};
sub safe($;)      {$self = shift; $self->get("safe", @_)};
sub code($;)      {$self = shift; $self->get("code", @_)};
sub mode($;)      {$self = shift; $self->get("mode", @_)};


sub get($$;) {
    my $self = shift;
    my $parameter = shift;
    my $setting = shift;

    my $string = $self->{$parameter}; 

    chomp($string=(defined $string && length $string) ? $string : "") 
        unless ($parameter =~ /(c|m)ode/);     # don't convert mode or code

    $self->{$parameter} = $setting if ($setting); 

    return $string; 
}


sub isspam($) {
    my $self = shift;
    my $item = shift;

    return 0 unless (exists $self->{spamtest} && exists $self->{spam});

    my $status = $self->{spamtest}->check($item);
    if ($status) {
    my $isspam = $status->is_spam();
    $status->finish();
    return $isspam;
    }

    return 0;
}


sub deliver($$;$;) {
    my $self = shift;
    (my $item, my $folder, my $mbox) = @_;

    return unless $item;

    $folder = $self->{inbox} unless $folder;

    my $to = $item->to;
    my $cc = $item->cc;
    my $from = $item->from;

    my $drop = eval {
    if ($mbox) {
        $self->_m_mkpath($folder) unless -d $folder; 
        $mbox = File::Spec->catfile($folder, $mbox);
    } 
    elsif (-f $folder || -d $folder) {
        $folder;
    } 
    else {
        my $dirname = dirname($folder);
        $self->_m_mkpath($dirname) unless (-f $dirname || -d $dirname);
        $folder;
    } 
    };

    print "Delivering to mailbox: $drop\n";

    return $item->accept($drop);
}


sub file($$@) {
    my $self = shift;
    my ($item, $subfolder) = (shift, shift);
    my @names = map {_explode($_);} @_;
    my $filed = 0;

    for my $ref (@names) {
    my $box = ''; my $username = ${$ref}{username};
    my $firstname = ${$ref}{firstname};
    my $lastname = ${$ref}{lastname};
    my $fullname = ${$ref}{fullname};
    my $domain = ${$ref}{domain};

        next if ($username =~ /-(help|subscribe)$/);

        if ($opts{s} && $lastname) {
        $box = $lastname;
        do {
            $box .= "_$firstname";
        } if $firstname; 
    } elsif ($firstname) {
        $box = $firstname;
        $box .= "_$lastname" if $lastname; 
    } elsif ($fullname) {
        $box =$fullname;
    } elsif ($username) {
        $box = $username;
    } else {
        print "... exception ... \n";
        $self->deliver($item, $self->{junk});
        $filed++;
        next;
    }

    $box = $1 if ($box =~ /(.*)@/); 
    $box =~ s/\s+/_/g;
    my ($letter) = split(//, $box);
    next if ($letter !~ /[a-z0-9_-]/);

        $filed += $self->deliver($item, $subfolder, 
        File::Spec->catfile($letter, $box));
    }

    return $filed;
}


use constant esc        => '\\\\';               
use constant Period     => '\.';
use constant space      => '\040';               
use constant tab        => '\t';
use constant OpenBR     => '\[';                 
use constant CloseBR    => '\]';
use constant OpenParen  => '\(';                 
use constant CloseParen => '\)';
use constant NonASCII   => '\x80-\xff';          
use constant ctrl       => '\000-\037';
use constant CRlist     => '\n\015'; 
use constant atom_char  => qq/[^<>()spacetab\@,;:\"escOpenBRCloseBRctrlNonASCII]/;

sub _explode {
    my $address = shift;
    return undef if (!defined($address));


    my @subdomains = split(Period, $address->host);
    my $fdomain = pop @subdomains;

    if ($fdomain =~ /atom_char{3}/) {
    $fdomain = pop @subdomains;
    } elsif ($fdomain =~ /atom_char{2}/) {
    $fdomain = pop @subdomains;
    $fdomain = pop @subdomains if ($fdomain =~ /^atom_char{2}$/);
    } 

    my $username = $address->user;
    my $fullname = $address->name;
    my $lastname = my $firstname = '';

    if ($fullname =~ /
                       ^(atom_char+) [spacetab]
                (atom_char+ [spacetab])* 
            (atom_char+)$
             /x) {
    $firstname = $1;
    $lastname = $3;
    }

    tr/A-Z/a-z/ for ($username, $fullname, $firstname, $lastname, $fdomain);

    return {
    username => $username,
    domain => $fdomain,
    fullname => $fullname,
    firstname => $firstname,
    lastname => $lastname,
    };
}

sub _exception($) {
    my $self = shift;
    my $item = shift;

    return unless ($item);

    $item->accept($self->{junk});
}


sub _m_mkpath($$;$;) {
    my $self = shift;
    (my $paths, my $echo, my $mode) = @_;

    mkpath($paths, $echo || 0, $mode || $self->{mode});
}

1;