#!/usr/bin/perl

##############################################################################
# exmh_adb - update the exmh address book                                    #
#                                                                            #
# Copyright (C) 1997 Henrik Seidel <henrik@satchmo.physik.tu-berlin.de>      #
#                                                                            #
# very first version was by Stefan Waldherr <swa@cs.cmu.edu>                 #
#                                                                            #
# $Id: exmh_adb,v 1.6 1997/06/05 09:30:56 henrik Exp henrik $                #
##############################################################################
#                                                                            #
# This program is free software; you can redistribute it and/or modify it    #
# under the terms of the GNU General Public License as published by the      #
# Free Software Foundation; either version 2, or (at your option) any later  #
# version.                                                                   #
#                                                                            #
# This program is distributed in the hope that it will be useful, but        #
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY #
# or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License   #
# for more details.                                                          #
#                                                                            #
# You should have received a copy of the GNU General Public License along    #
# with this program; if not, write to the Free Software Foundation, Inc., 59 #
# Temple Place - Suite 330, Boston, MA 02111-1307, USA.                      #
#                                                                            #
##############################################################################
#
# This program scans all mail (all folders in ~/Mail/.folders) and
# updates the address book file ~/.exmh_addrs.
# It honors
#
#       Preferences|Address Database|Regular expressions filter. (SW)
#       Preferences|Address Database|Alternate Mailboxes.        (HS)
#       Preferences|Address Database|Exclude Folders.            (HS)
#
# There is one thing to keep in mind. If you start the script while exmh is
# running, exmh -- on exit -- will save its database and overwrite the newly
# created file.
#
##############################################################################
#
# $Log: exmh_adb,v $
# Revision 1.6  1997/06/05 09:30:56  henrik
# Fixed signal handling
# Fixed replacment of old exmh_addrs by new one
# Fixed cleanup of temporary files
# Full names containing commas or parentheses are now correctly quoted
#
# Revision 1.5  1997/05/30 21:22:33  henrik
# Quote full names containing a comma.
# Make overwriting of old .emxh_addrs more secure
#
# Revision 1.4  1997/05/23 13:59:33  henrik
# Added options -d (debug) and -v (verbose)
# Added option -w (wipe) to wipe the old ~/.exmh_addrs
# If we don't want to wipe our old ~/.exmh_addrs, we first read all old
# addresses and test if the "last message" and "date" fields are still
# valid
#
# Revision 1.3  1997/05/21 23:55:43  henrik
# "Full name" is now an empty string instead of the email address if there
# was no full name in the "From: " field.
# Reported by Hal L DeVore <hdevore@bmc.com>
#
# Revision 1.2  1997/05/21 22:21:29  henrik
# Removed redundancies in the output
# Canceled sorting (exmh is sorting the database on input anyway)
#
##############################################################################

require 'getopts.pl';

do Getopts('dlvw');
$debug        = $opt_d;
$verbose      = $opt_v;
$wipe         = $opt_w;
$includelocal = $opt_l;

print "Wiping old ~/.exmh_addrs.\n" if $verbose && $wipe;
print "Including local users.\n" if $verbose && $includelocal;

# get the home directory
$home = @ENV{HOME};

# name of temporary files
$tmpfile="$home/.exmh_addrs.tmp$$";
$backup="$home/.exmh_addrs.$$";

# set signal handler
$SIG{'HUP'}=$SIG{'INT'}=$SIG{'QUIT'}=$SIG{'KILL'}=$SIG{'PIPE'}=$SIG{'TERM'}
     ='sighandler';

# get the mh mail directory
$maildir=`mhpath +`;
chomp $maildir;

# get the users excluded addresses, excluded mail dirs;
# filter alternate mailboxes?
open ( EXMH, "$home/.exmh-defaults" ) || 
    die "Can't open $home/.exmh-defaults: $!\n";
while (<EXMH>) {
    /^\*addressdbFilterRegexp:\s*(\S.*)\s*$/ && ($regexp=$1);
    /^\*addressdbFoldersSkip:\s*(\S.*)\s*$/ && ($foldersskip=$1);
    /^\*addressdbFilterAltMailboxes:\s*(\S.*)\s*$/ && ($exclalt=$1);
}
close( EXMH );

# Resolve the folders to exclude
# Put them in @foldersskip.
if ($foldersskip !~ /^\s*$/) {
    foreach (split(/\s+/,$foldersskip)) {
        s/\./\\./g;
        s/\*/.*/g;
        push @foldersskip, $_;
    }
}

# Some debugging information
if ($debug) {
    print "Excluding addresses that match $regexp\n" if $regexp !~ /^\s*$/;
    printf "%sxcluding alternate mailboxes.\n", $exclalt ? "E" : "Not e";
    print "Folders to exclude: " . join(" ", @foldersskip) . "\n";
}

# Read the old .exmh_addrs if there is one and we don't want to wipe it
if (!$wipe && open(ADDR,"$home/.exmh_addrs")) {
    print "Reading old ~/.exmh_addrs\n" if $verbose;
    while (<ADDR>) {

        # skip empty lines. there shouldn't be empty lines anyway, but
        # better be sure.
        next if /^\s*$/;

        # read the fields;
        ($email,$lastmail,$day,$fromname,$addr) =
            /^\s*set\s+addr_list\((.*)\)\s*{(.*)\s+{(.*)}\s+{(.*)}\s+{(.*)}}/;

        # lowercase address
        $fromemail=lc("$email");

        # some debugging information
        print "\nEmail: $email\nLastmail: $lastmail\nDay: $day\n"
            . "Address: $addr\n" if $debug;

        # test if $lastmail still exists. If not, unset $lastmail and $day.
        $lastmail=~s/^{?([^{}]*)}$/$1/;
        if ($lastmail eq "" || ! -r $lastmail) {
            print "Last mail $lastmail doesn't exist anymore\n" if $debug;
            $lastmail="{}";
            $day="";
        } else {
            ($folder,$mail)= $lastmail =~ /^$maildir\/(.*)\/(\d+)$/;
            print "Last mail $lastmail (+$folder $mail) exists\n" if $debug;
            $newfrom=`scan +$folder $mail -format '%(addr{from})'`;
            chomp $newfrom;
            if (lc($newfrom) ne $fromemail) {
                $lastmail="{}";
                $day="";
                print "Last mail is not from $email but from $newfrom\n"
                    if $debug;
            }
        }
        
        # update arrays
	$email{$fromemail}="$email";
	$lastmail{$fromemail}="$lastmail";
	$day{$fromemail}="$day";
	$fromname{$fromemail}="$fromname";
	$addr{$fromemail}="$addr";
	$addrcount++;
    }
    close(ADDR);
    print "Read $addrcount addresses from old ~/.exmh_addrs\n" if $verbose;
}

# We need our own format for scan
$scanformat  = '%(addr{from});%{folder};%(msg);%{date};';
$scanformat .= '%<(nodate{date})0%|%(clock{date})%>;%(friendly{from})';
# Make scan lines empty if we want to exclude our alternate mailboxes and
# mail is from one of those
$scanformat = "%<(mymbox{from})%|$scanformat%>" if $exclalt;
$scanformat = "'$scanformat'";

open ( FOLDERS, "$maildir/.folders" )
    || die "Can't open $maildir/.folders: $!\n";

while ( $currentfolder = <FOLDERS> ) {

    chomp $currentfolder;

    # ignore if folder is in list of folders to skip
    $ignore=0;
    foreach (@foldersskip) {
	$ignore=1 if $currentfolder=~/^$_$/;
    }

    # Ignore some additional folders we want to skip
    $ignore=1 if $currentfolder =~ /\.glimpse.*/i || # no .glimpse stuff
	         $currentfolder =~ /drafts/i ||      # no drafts folder
	         $currentfolder eq "";               # and no empty lines

    # If we want to ignore this folder, print a warning and skip to the
    # next folder
    if ($ignore) {
	print "$0: ignoring folder $currentfolder\n" if $verbose;
        next;
    }

    print "$0: processing $currentfolder\n" if $verbose;

    # Begin scanning
    open ( SCANOUTPUT, 
        "scan +$currentfolder -width 1000 -format $scanformat |" ) ||
        die "Can't scan the folders: $!\n";

    # Do the scan
    while ( $line = <SCANOUTPUT> ) {
        chomp $line;

        # Skip empty lines
        next if $line =~ /^\s*$/;

        # Split the line into fields
        ($email,$folder,$msgnum,$day,$clock,$fromname) = split(/;/,$line);

        # lowercase the email address
        $fromemail=lc("$email");

        # Reset ignore
        $ignore=0;

        # ignore address if it matches $regexp
        $ignore=1 if $regexp !~ /^\s*$/ && $fromemail =~ /$regexp/i;
        
        # ignore local users if we specified to do so
        $ignore=1 if ! $includelocal && $fromemail !~ /.*\@.*/;

        # ignore address if it's not a valid e-mail address
        $ignore=1 if $fromemail =~ /.*\".*/ || $fromemail =~ / /;

        # ignore address if it's not a valid e-mail address - part ][
        $ignore=1 if $fromname =~ /.*\\.*/;

        # If we want to ignore this address, print a warning and skip to next
        if ($ignore) {
            print "$0: ignoring address $fromemail\n" if $verbose;
            next;
        }

        # unset the full name if it's just the email address
        $fromname = "" if lc($fromname) eq $fromemail;

        # get rid of quotes around the name
        $fromname =~ s/\"//g;
        if ($fromname =~ /^\s*\(\s*(\S.*\S)\s*\)\s*$/) {
            $fromname=$1;
        }
        $fromname="\"$fromname\"" if $fromname=~/.*[,()].*/;

	# save the full name if there is one and we don't have it yet
	if (("$fromname" ne "") && ($fromname{$fromemail} eq "")) {
            $fromname{$fromemail}="$fromname";
            $addr{$fromemail}="$fromname <$email>";
        }

        # save data if this is the latest message from $fromemail
        if ($clock >= $clock{$fromemail}) {
            if ("$fromname" ne "") {
                # update the full name if there is one
                $fromname{$fromemail}="$fromname";
                $addr{$fromemail}="$fromname <$email>";
            } else {
                # if we don't have a full name and this is the very first
                # message from $fromemail
                $addr{$fromemail}="$email" if $addr{$fromemail} eq "";
            }
            $clock{$fromemail}=$clock;
            $lastmail{$fromemail}="$maildir/$currentfolder/$msgnum";
            $day{$fromemail}=$day;
            $email{$fromemail}=$email;
        }

    }
}
close( FOLDERS );

# and, finally, write to the address database
open ( ADDR, ">$tmpfile" ) 
    || die "Can't open $tmpfile: $!\n";
foreach (keys(%email)) {
    print ADDR "set addr_list($email{$_}) {$lastmail{$_} {$day{$_}} " .
               "{$fromname{$_}} {$addr{$_}}}\n";
}
close( ADDR );

# move $tmpfile to ~/.exmh_addrs in a secure fashion
link "$home/.exmh_addrs", $backup;
unlink "$home/.exmh_addrs";
link $tmpfile, "$home/.exmh_addrs";
unlink $tmpfile;
unlink $backup;

# and bye
exit 0;

sub sighandler {
    local($sig) = @_;
    # delete the temporary file
    unlink $tmpfile if -w $tmpfile;
    # If we got interrupted while copying $tmpfile to ~/.exmh_addrs,
    # restore the original ~/.exmh_addrs
    if (-r $backup) {
	unlink "$home/.exmh_addrs";
	rename "$backup", "$home/.exmh_addrs";
    }
    print STDERR "$0: Caught a SIG$sig. Original ~/.exmh_addrs restored.\n";
    exit 0;
}
