#!perl
# Sorts archived mail (by last-modified date) into one directory per date in yyyymmdd format
# This depends on Date::EzDate 1.06 pre-release - fails on DST off-by-one error in 1.0.4
# Date::EzDate 1.06 has a bug OFF of DST - so for non-DST we need 1.04
# Date::EzDate 0.93 doesn't support ->('yesterday') as an initializer
# Third major revision 	- it only sorts yeterday's mail, making the archive directory if it doesn't exist.
#						- it makes an index with Filename, From, To, and Subject
#						- it will later move the MDaemon log files to the archive directory
#						- it zips the mailfiles together, and deletes the uncompressed ones
use strict;
use warnings;
use diagnostics;
use File::Copy;
use Date::EzDate;
use Mail::Header;
use Mail::Address;
use Archive::Zip qw(:ERROR_CODES :CONSTANTS);

my $logfile			= "//<log directory>/sortmail-error.log";
my $errfile			= "//<log directory>/sortmail-stdout.log";
my $indexfile		= "index.log";
my $start_dir 		= "<drive-letter>:/mdaemon/users/*/";
my $target_base_dir = "//<snapsrvr>/archives/mail_archive/";
my $target_date		= Date::EzDate->new('yesterday');
my $end_dir 		= "$target_base_dir$target_date->{'%Y%m%d'}";
my $mail_file		= undef;
my @mail_files		= undef;
my $mail_date		= undef;
my $success			= undef;
my ($header, @from, @to,@RCPT_TO, $address, $subject)	= undef;
my ($zip, $zip_file, $zip_error, $add_error)	= undef;

open(STDERR,">>$logfile") or die ("Couldn't open logfile : quitting! Error: $! \n");
open(STDOUT,">>$errfile") or die ("Couldn't open errfile : quitting! Error: $! \n");
my $time = localtime();
print("\nStarted $time\n");
warn("\nStarted $time\n");

#The directory probably doesn't exist - this makes it.
if (! ( -e $end_dir) ) {
	mkdir($end_dir) || die ("Couldn't make directory $end_dir : quitting! Error: $! \n");
	print("Created directory $end_dir\n");
}
opendir(MAILARCHIVE, "$start_dir") || die ("Couldn't open directory $start_dir : quitting! Error: $! \n");
chdir ($start_dir);
open(INDEX, ">$end_dir/$indexfile");
$zip 		= Archive::Zip->new();
$zip_file 	= "$end_dir/".$target_date->{'%Y%m%d'}.".zip";
while ($mail_file = readdir(MAILARCHIVE) ) {
	# MDaemon stores all email as *.msg files - simple RFC 822 plain text
	if ($mail_file !~ /msg/i) {
		warn ("Skipped $mail_file - wrong file extension.\n");
		next;
		}	
	$mail_date = Date::EzDate->new((stat("$mail_file"))[9]);
	if ($target_date->{'epochday'} == $mail_date->{'epochday'} ) {
		$success = File::Copy::move ("$mail_file", "$end_dir/$mail_file");
		if (!$success) {
			warn("File: $mail_file, end_dir: $end_dir, error: $!\n");
			next;}
		print("name: $mail_file, end_dir: $end_dir \n");
		push (@mail_files, $mail_file);
		#need to do some Mail::Tools madness here - I want to build an index for fast retrieval
		open(MESSAGE, "$end_dir/$mail_file") || warn ("Error opening $mail_file for indexing: $!\n");
		$header = new Mail::Header\*MESSAGE;
		$header->unfold();
		close(MESSAGE);
		@from 	= Mail::Address->parse($header->get("From:"));
		@to  	= Mail::Address->parse($header->get("To:"));
		@RCPT_TO= Mail::Address->parse($header->get("X-MDRCPT-To:"));
		$subject = $header->get("Subject:") || "Perl script says: No Subject in message";
		chomp ($subject);
		print INDEX "\n$mail_file\nSubject\t$subject\n";
		foreach $address(@from		) {print INDEX "From\t".$address->format."\n";}
		foreach $address(@to  		) {print INDEX "To  \t".$address->format."\n";}
		foreach $address(@RCPT_TO 	) {print INDEX "X-MDRCPT-To  \t".$address->format."\n";}
		
		unless ($zip->addFile("$end_dir/$mail_file") )  {
			$add_error = 1;
			warn ("Error adding $mail_file to $zip_file \n");
			next;
		}
	}
}
close(INDEX);

if ($zip_error = $zip->writeToFileNamed($zip_file) ) {
	warn ("Error zipping $zip_file was $zip_error\n");
	$time = localtime();
	print("Ended $time\n");
	warn("Ended $time\n");
	die;
}
unless ($add_error) {
	unless ( chdir ("$end_dir/") ) {
		warn "can't chdir";
		$time = localtime();
		print("Ended $time\n");
		warn("Ended $time\n");
		die;
	}
	foreach my $file (@mail_files) {
		if ($file) { unlink $file || warn ("Error :$! trying to delete file $file !\n");} 
	}
}
$time = localtime();
print("Ended $time\n");
warn("Ended $time\n");
exit 0;