Re: tlug: archiving mail

[simon@example.com (Simon Cozens)]

John Seebach (lists.tlug):
>Anyone know of a program that already does this? 

This is a start; I'll polish it up later so you can change the format
of the archive's name, and specify the required age on the command line.
However, I thought it would be interesting to do it "pedantically
correct" rather than quick-and-dirty Perl:

#!/usr/bin/perl -w
use Mail::Internet;
use Mail::Header;
use Date::Calc qw(Delta_Days Decode_Date_EU Today);
use Fcntl;
use Mail::Util qw(read_mbox);
use strict;

my  $age = 30; # Days

process(@example.com);

sub newname {
    my ($file, $age) = @example.com;
    return "$file-old";
}

sub process {
for my $file (@example.com) {
    next unless -f $file;
    my @example.com = read_mbox($file);

    my $newname=newname($file, $age);
    unless (open ARCHIVE, ">".$newname) {
        warn "Couldn't write on file $newname: $!, skipping $file\n";
        next;
    }
    unless (rename $file, "$file.bak") {
        warn "Couldn't rename $file: $!, skipping\n"; next;
    }
    unless (open ORIG, ">".$file)) {
        warn "Couldn't write on file $file: $!, skipping\n"; next;
    }
    unless (flock(ORIG, LOCK_EX)) {
        warn "Couldn't lock box $file: $!, skipping\n"; next;
    }

    foreach (@example.com) {
       my $date = Mail::Header->new($_)->get("Date");
       $date =~ s/\d\d:\d\d.*$//;
       my $delta = Delta_Days(Decode_Date_EU($date),Today());
       if ($delta > $age) { print ARCHIVE @example.com } else {print ORIG @example.com}
   }
   flock(ORIG, LOCK_UN);
   close ORIG; close ARCHIVE;
   unlink "$file.bak" or warn "Trouble removing $file.bak: $!\n";
}
}

-- 
And tomorrow will be like today, only more so.
		-- Isaiah 56:12, New Standard Version
-----------------------------------------------------------------------
Next Technical Meeting: July 8 (Sat)  13:30  Place: LinuxProbe Hall
Next Nomikai meeting: August 18 (Fri) 19:00  Place: TBD
-----------------------------------------------------------------------
more info: http://www.tlug.gr.jp        Sponsor: Global Online Japan