#!/usr/bin/perl -w

# mailArchive.perl is a program for the archival of e-mail stored in
# MH folders.  It uses the date in the last Received: header to
# determine the age of each e-mail.  E-mails are moved to an archive
# if they are more than one year old, or, for folders specified in
# %old, older than the specified number of seconds.  mailArchive.perl
# stores a file in each folder, .oldest, with the date of the
# oldest remaining e-mail in that folder (to speed future runs).
# Two digit dates are converted to (curYear-49,curYear+50)

# Written by Jason D. M. Rennie, August, 2003

# 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
# of the License, 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 (see file 'COPYING'); if not, write to the Free
# Software Foundation, Inc., 59 Temple Place - Suite 330,
# Boston, MA  02111-1307, USA.

use FileHandle;
use DirHandle;
use strict;

my $homeDir = $ENV{"HOME"};
$homeDir .= "/" if ($homeDir =~ m/\/$/);

## Customize these variables to suit your environment ##
my $backupDir = "$homeDir/mailArchive";

my $verbose = 1;
my $curTime = time();
my $mailDir = "Mail";
my $mailPath = "$homeDir/$mailDir";

my $month = 2592000; # assume 1 month=30 days
my $old = 12*$month; # default age cutoff
my $daysInYear = 365.2422;

# folders with cutoff different from default ($old)
my %old = ("conf/announce" => 6*$month,
	   "friends/grove" => 24*$month,
	   "jobs" => 24*$month,
	   "spam" => 4*$month,
	   "linux/latex" => 24*$month,
	   "mit/ai-lab" => 6*$month,
	   "mit/misc" => 6*$month,
	   "mit/olympics" => 6*$month,
	   "mit/sys" => 6*$month,
	   "mit/talks" => 6*$month,
	   "mlists/ddlbeta" => 6*$month,
	   "mlists/gnucash" => 4*$month,
	   "mlists/reuters" => 6*$month,
	   "mlists/spam" => 6*$month,
	   "mlists/wn-users" => 6*$month,
	   "money/xe" => 6*$month,
	   "sale" => 24*$month,
	   "stuff" => 6*$month);

my $emailCount = 0;
my $storedEmail = 0;
my $recentEmail = 0;

my @monthName = ("Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul", "Aug", "Sep", "Oct", "Nov", "Dec");
my @monthDays = (31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31);
my @dayName = ("Sun", "Mon", "Tue", "Wed", "Thu", "Fri", "Sat");

mkdir ($backupDir, 0700) if (! -d $backupDir);

# Need to use ".folders" to find out which MH folders we should be looking
# in.  Recursive function calling doesn't work too well here.

my $file = "$mailPath/.folders";
my $fh = new FileHandle ($file) or die "open $file: $!";
foreach my $folder (<$fh>) {
    chomp $folder;
    mkdir("$backupDir/$folder", 0700) if (! -d "$backupDir/$folder");
    backupDirectory($mailPath, $folder);
}

print "Total emails: $emailCount\n";
print "Total emails stored: $storedEmail\n";
print "Total emails kept: $recentEmail\n";


sub backupDirectory
{
    my ($mailPath, $folder) = @_;
    my $dir = "$mailPath/$folder";
    my $minTime = $curTime;
    my $dirCount = 0;

    print "Backing up folder $folder...\n";
    my $folderOld = defined($old{$folder}) ? $old{$folder} : $old;

    my $fh = new FileHandle("$dir/.oldest");
    if (defined($fh))
    {
	my $time = <$fh>;
	chomp $time;
	my $count = <$fh>;
	chomp $count;
	if ($curTime - $time < $folderOld)
	{
	    $emailCount += $count;
	    $recentEmail += $count;
	    return;
	}
    }
    undef $fh;

    my $bDir = "$backupDir/$folder";
    my $dh = new DirHandle($dir) or die "dir $dir: $!";
    while (defined(my $file = $dh->read)) {
	next if ($file !~ m/^[0-9]/);
	++$emailCount;
	++$dirCount;
	my $time = getDate("$dir/$file");
	if (!defined($time)) {
	    print "*** $dir/$file\n";
	    <STDIN>;
	}
	if (defined($time) and $curTime - $time > $folderOld) {
	    if ($verbose) {
		my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday,
		    $isdst) = localtime ($time);
		print "$file is dated $dayName[$wday], $monthName[$mon] $mday $hour:$min:$sec ".(1900+$year)."\n" if ($verbose);
	    }
	    ++$storedEmail;
	    my $bFile = findNextFile ($bDir);
	    print "mv $dir/$file $bDir/$bFile\n";
	    rename "$dir/$file", "$bDir/$bFile";
	}
	elsif (defined($time)) {
	    ++$recentEmail;
	    $minTime = $time if ($time < $minTime);
	}
    }
    undef $dh;

    # Write oldest e-mail information to file
    my $file = "$dir/.oldest";
    $fh = new FileHandle(">$file") or die "write $file: $!";
    print $fh "$minTime\n";
    print $fh "$dirCount\n";
    undef $fh;
}

sub findNextFile
{
    my ($dir) = @_;
    my $num = 1;
    my $dh = new DirHandle($dir) or die "dir $dir: $!";
    while (defined(my $file = $dh->read)) {
	next if ($file !~ m/^[0-9]+$/);
	$num = $file + 1 if ($file >= $num);
    }
    undef $dh;
    return $num;
}

sub getDate
{
    my ($file) = @_;

    my $fh = new FileHandle($file) or die "open $file: $!";
    getHeaderLine($fh);
    while (defined(my $line = getHeaderLine())) {
	if ($line =~ m/^received:/i) {
	    my $time = parseDate ($line);    
	    return $time if (defined($time));
	}
    }
    undef $fh;
}

my $getHeaderFileHandle;
my $getHeaderNextLine;
sub getHeaderLine
{
    my ($fh) = @_;
    if (defined($fh)) {
	undef $getHeaderFileHandle if (defined($fh));
	undef $getHeaderNextLine;
	$getHeaderFileHandle = $fh;
	return;
    }
    return if (!defined($getHeaderFileHandle));
    my $line = defined($getHeaderNextLine) ? $getHeaderNextLine : <$getHeaderFileHandle>;
    chomp $line;
    while (defined(my $nextLine = <$getHeaderFileHandle>)) {
	if ($nextLine =~ m/^\S/) {
	    $getHeaderNextLine = $nextLine;
	    return $line;
	}
	last if ($nextLine =~ m/^\n/);
	chomp $nextLine;
	$nextLine =~ s/^\s+/ /;
	$line .= $nextLine;
    }
    undef $getHeaderNextLine;
    undef $getHeaderFileHandle;
    return $line;
}

# Accepts a string which contains a date, returns approximate number
# of non-leap seconds since January 1, 1970.  Note that this is an
# estimate as it does not take account for time zones.
# Returns -1 if the string cannot be parsed as a date.
sub parseDate
{
    my ($date) = @_;
    my ($sec, $month, $year, $hour, $min);

    # Date: Wed, 23 Jun 1999, 03:23:56
    if ($date =~ m/(\w{3,}, )?([ \d]?\d) (\w{3,}) (\d{2,4}),? (\d{1,2}):(\d{1,2})(:(\d{1,2}))?/i) {
	$sec = 0;
	$date = $2;
	$month = $3;
	$year = $4;
	$hour = $5;
	$min = $6;
	$sec = $8 if (defined($8));
    }
    # Date: Tue, Jan 15 2000, 15:09:31
    elsif ($date =~ m/(\w{3,}, )?(\w{3,}) ([ \d]?\d) (\d{2,4}),? (\d{1,2}):(\d{1,2})(:(\d{1,2}))?/i) {
	$sec = 0;
	$month = $2;
	$date = $3;
	$year = $4;
	$hour = $5;
	$min = $6;
	$sec = $8 if (defined($8));
    }
    # Date: 2000/01/15 Tue 15:09:31
    elsif ($date =~ m/(\d{2,4})\/(\d{1,2})\/(\d{1,2}) (\w{3,}) (\d{1,2}):(\d{1,2})(:(\d{1,2}))?/i) {
	$sec = 0;
	$year = $1;
	$month = $2;
	$date = $3;
	$hour = $5;
	$min = $6;
	$sec = $8 if (defined($8));
    }
    else {
	return;
    }
    #print "Date: $date $month $year $hour:$min:$sec\n";
    
    # calculate time since Jan 1, 1970
    my $ydate = 0;
    for (my $i = 0; $i < 12; $i++)
    {
	if ($month =~ m/$monthName[$i]/i)
	{
	    $ydate += $date;
	    $i = 12;
	}
	$ydate += $monthDays[$i] if ($i < 12);
    }
    # If not a 4 digit year, make guess at real year
    $year = $year % 100 if ($year < 1000);
    my (undef,undef,undef,undef,undef,$curYear) = localtime;
    $curYear += 1900;
    if ($year < 100) {
	my $curMod = $curYear % 100;
	if ($curMod >= 50) {
	    if ($year < (($curMod-50)%100)) {
		$year += $curYear-$curMod+100;
	    } else {
		$year += $curYear-$curMod;
	    }
	} else { # $curMod < 50
	    if ($year < (($curMod-50)%100)) {
		$year += $curYear-$curMod;
	    } else {
		$year += $curYear-$curMod-100;
	    }
	}
    }
    my $time = ($sec + $min*60 + $hour*60*60 + $ydate*60*60*24 +
	     ($year-1970)*60*60*24*$daysInYear);	    

    return $time;
}

# ChangeLog
# 09-03-2003 version 0.1.2 released
# 09-03-2003 use relative date matching for 2-digit years
# 09-02-2003 version 0.1.1 released
# 09-02-2003 (findNextFile) compare against number-only files
# 08-28-2003 version 0.1 released