#!perl
# Sorts archived mail (by last-modified date) into one directory per d
+ate 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! E
+rror: $! \n");
open(STDOUT,">>$errfile") or die ("Couldn't open errfile : quitting! E
+rror: $! \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 : quitti
+ng! Error: $! \n");
    print("Created directory $end_dir\n");
}
opendir(MAILARCHIVE, "$start_dir") || die ("Couldn't open directory $s
+tart_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 t
+ext
    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_fil
+e");
        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 S
+ubject 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;
[download]