#!/cygdrive/c/Perl/bin/perl
#
# pinc.pl
# This is a rudimentary implementation of the MH 'inc' program in Perl.
# NB: This only works with POP3 servers currently.  08/02/2002
#
# pfd = Peter Davis, pd@world.std.com
#
# History:
#  2003/04/19 pfd  Fetch all messages into inbox, then sort/distribute
#  2003/04/10 pfd  Added X-Label values to .pmhservers file
#  2003/04/01 pfd  Use MH rcvstore to store messages in MH folders.
#  2003/02/20 pfd  Update the .mh_sequences file in the inbox directory.
#  2002/08/02 pfd  First pass, based on earlier scripts by AMG and me.
#				   Read list of POP servers from ~/popservers, and fetch
#				   mail from each.
#
use Net::POP3;
use Date::Manip qw(ParseDate UnixDate Date_Init);
&Date_Init("TZ=US/Eastern");

# find home
$home = $ENV{'HOME'};
$rcvstore = $ENV{RCVSTORE} || '/usr/local/nmh/bin/rcvstore';

# get profile settings, in case we ever implement any of this stuff
local($profs, %profs);
if (open PROFILE, "<$home/.pmh_profile") {
    while (<PROFILE>) {
       ($key, $val) = split(/:/, $_);
       $val =~ s/^\s+//;
       $profs{$key} = $val;
   }
    $path = $profs{'Path'};
} else {
    $path = "$home/Mail";
}

$path =~ s/^\s+//;
$path =~ s/\s+$//;

$mailstore = "$home/$path";
$mailstore =~ s/\\/\//g;

# Get number of messages
$inboxpath = $mailstore . "/inbox";
opendir(DIR, $inboxpath);
@msgnums = grep { /^,?[0-9]*$/ } readdir(DIR);
closedir(DIR);

# Find highest message number
$maxmsg = 0;
foreach $msgnum (@msgnums) {
    if (substr($msgnum, 0, 1) eq ",") {
        chop $msgnum;
    }
    if ($msgnum > $maxmsg) {
        $maxmsg = $msgnum;
    }
}
$nxtmsgnum = $maxmsg + 1;
#$newStr = "new:";

# Get number of spam messages
$spampath = $mailstore . "/spam";
opendir(DIR, $sapmpath);
@spammsgnums = grep { /^,?[0-9]*$/ } readdir(DIR);
closedir(DIR);

# Find highest spam message number
$maxspammsg = 0;
foreach $spammsgnum (@spammsgnums) {
    if (substr($spammsgnum, 0, 1) eq ",") {
        chop $spammsgnum;
    }
    if ($spammsgnum > $maxspammsg) {
        $maxspammsg = $spammsgnum;
    }
}
$nxtspammsgnum = $maxspammsg + 1;

# Read spam filters
# if (open SPAMF, "<$home/spam.filter") {
#     @spamfilt = <SPAMF>;
#     close SPAMF;
#     chomp(@spamfilt);
# }

sub determine_folder
{
    for $_ (@filters)
    {
        my ($folder, $fields, $regexp) = split /\s+/;
        next unless $folder =~ /\S/;
        my $field;
        for $field (split /\|/, $fields)
        {
            $fieldvalue = $head{$field}; # eval("\$$field"); 
            if ($fieldvalue =~ /$regexp/i) {
                # print "Match: $field => $fieldvalue\n";
                return $folder;
            }
        }
    }
    return "misc";
}

open FILTERS, "<$home/filters.txt" or die "Unfiltered";
@filters = <FILTERS>;
close FILTERS;

# sort messages from inbox into different folders
sub sortmail
{
    printf "Sorting ...\n";

    # Get list of all messages in inbox
    opendir(DIR, $inboxpath) or die "Can't open $inboxpath: $!\n";
    while ( defined ($msgnum = readdir DIR)) {
        next if $msgnum !~ /^,?[0-9]*$/;

        # read message
        # print "Message: $msgnum\n";
        open MSG, "<$inboxpath/$msgnum" or die "Can't read $msgnum";
        @lines = <MSG>;
        close MSG;

        # make head hash
        undef %head;
        $header_done = 0;
        foreach $rfc822 (@lines) {
            next unless !($header_done);
            if ($rfc822 eq "" || $rfc822 eq "\n") {
                $header_done = 1;
                next;
            }
            ($field, $value) = ($rfc822 =~ /([^:]+)\:\s*([\s\S]*)/m);
            chop $value;
            if (length ($field) > 0 && length($value) > 0) {
                # print "$field : $value\n";
                $head{lc $field} = "$value";
            }
        }

        # filter the message for disposition
        undef $disposition;
        $disposition = determine_folder();

        # Parse date
        $msgmn = "00";
        $msgdy = "00";
        $msgdate = ParseDate($head{'date'});
        ($msgyr, $msgmn, $msgdy) = UnixDate($msgdate, "%y", "%m", "%d");

        # move message to appropriate folder
        printf ("%8s : %2d/%2d %-20s %-40s\n", 
                substr($disposition, -8),
                $msgmn, $msgdy,
                substr($head{'from'}, 0, 20),
                substr($head{'subject'}, 0, 40));
        open(MSGOUT, "| $rcvstore +$disposition")
            or die "Can't find rcvstore\n";
        print MSGOUT join ("", @lines);
        close MSGOUT;
        unlink("$inboxpath/$msgnum");
    }
}

# getmail($srvr, $usr, $pw, $xlbl, $lmos);
# get messages from POP server
sub getmail
{
    ($server, $user, $password, $xlbl, $leaveMessagesOnServer) = @_;

    if ($leaveMessagesOnServer) {
    print "Leaving mail on $server ...\n";
    }
    else {
    print "Checking for new mail on $server ...\n";
    }

    # Read list of messages to delete from this server
    if (open DMFS, "<$home/dmfs-$server") {
      @dmfs = <DMFS>;
      close DMFS;
    }

    # Read UIDLs of already-fetched messages
    if (open UIDLS, "<$home/$server\.uidl") {
        @uidllist = <UIDLS>;
    }

    $svrhdr = "X-POP-Server: $server\n";
    $xlblhdr = "X-Label: $xlbl\n";

    $popbox = new Net::POP3($server);
    return unless defined $popbox;
    $msgcount = $popbox->login($user, $password);
    $popbox->quit(), return if $msgcount == undef;
    @uidls = ();
    for ($i = 1; $i <= $msgcount; $i++) {
      # Have we already fetched this message?
        $uidl = $popbox->uidl($i);
        $uidhdr = "X-POP-UIDL: $uidl\n";
        #$uidl =~ s/\n$//;
        push(@uidls, $uidl);
        $newmsg = 1;
        foreach $olduidl (@uidllist) {
            $olduidl =~ s/\n$//;
            $olduidl =~ s/\r$//;
            if ($uidl eq $olduidl) {
                $newmsg = 0;
                last;
            }
        }

        # See if message is marked for server delete
        if (!$newmsg) {
          for ($j = 0; $j < @dmfs; $j++) {
            $xmsg = $dmfs[$j];
            $xmsg =~ s/\n//;
            $xmsg =~ s/\r//;
            # print "Comparing: $xmsg\n";
            # print "     with: $uidl\n";
            if ($xmsg eq $uidl) {
              print "Deleting: $xmsg\n";
              split(@dmfs, $j, 1);
              $popbox->delete($i);
              last;
            }
          }
        }

        # If previously fetched message, no further processing needed
        next unless $newmsg;

        $msgref = $popbox->get($i);
        $msg = $svrhdr . $uidhdr . $xlblhdr . join ("", @$msgref);

        # write new message file
        printf ("%5d  %-64s\n",
                $nxtmsgnum, $uidl);
        open OUT, ">$inboxpath/${nxtmsgnum}" or die "Save failed\n";
        print OUT $msg;
        close OUT;

        $nxtmsgnum += 1;

        $popbox->delete($i) unless $leaveMessagesOnServer;
    }

# Write current UIDLs, only if messages left on server
    if ($leaveMessagesOnServer)
      {
        open UIDLFILE, ">$home/$server\.uidl";
        print UIDLFILE join("\n", @uidls);
        close UIDLFILE;
      }

    # Delete the "clean-up" file
    unlink("$home/dmfs-$server");

    $popbox->quit();
}

# Look for the file ~/popservers.  
# If present, this should be of the form:
#   server:user:password:leave-messages-on-server

if (open SERVERS, "<$home/.pmhservers") {
    while (<SERVERS>) {
        ($srvr, $usr, $pw, $xlbl, $lmos) = split(/:/, $_);
        if (substr($lmos,0,1) eq "0") {
            $lmos = 0;
        }
        getmail($srvr, $usr, $pw, $xlbl, $lmos);
    }
    sortmail;
    close SERVERS;

    $nummsgs = $nxtmsgnum - ($maxmsg + 1);
    # print $newStr;
    print "\n $nummsgs new message(s).\n\n";

}