#!/usr/bin/perl -w
use strict;
use Email::Folder;
use Email::MIME;
use Time::Local;
use Date::Parse;
use Getopt::Std;

######################################################################
#                                                                    #
# Find text/calendar MIME attachments in mailboxes and save them     #
# into a local folder for import into Sunbird                        #
#                                                                    #
######################################################################

# parse cmd line options
my $verbose  = 0;
my %opts     = ();
getopts('vm:d:', \%opts);
if ( ! $opts{'d'} or ! $opts{'m'} ) { usage(); }
if ( $opts{'v'} ) { $verbose = 1; }
my $maildir = $opts{'m'};
my $savedir = $opts{'d'};

# is -m a single mailbox or a maildir ?
if ( -f $maildir ) { parse_box($maildir); }
else {
        # find all the mailboxes in our maildir
        opendir(DIR, "$maildir") or die "Couldn't open directory $maildir";
        my @boxes = grep { -f "$maildir/$_" && ! m/\.msf$/ && ! m/^\./ } sort readdir(DIR);
        closedir(DIR);

        foreach my $b ( @boxes ) { parse_box("$maildir/$b"); }
}
exit 0;


sub usage {
        print qq(Usage: $0 -m  -d  [-v]\n);
        exit 1;
}

# find all text/calendar MIME attachments in a mailbox
sub parse_box {
        my $box = shift;

        print "Reading mailbox $box\n" if $verbose;

        my $folder = Email::Folder->new($box);
        # foreach my $m ( $folder->messages ) {
        while ( my $m = $folder->next_message ) {
                # $m is an Email::Simple class, Email::MIME requires a string
                my $parsed = Email::MIME->new($m->as_string);
                my @parts = $parsed->parts;

                foreach my $p ( @parts ) {
                        if ( $p->content_type =~ m|text/calendar| ) {
                                write_ics($p, $m->header("Subject"), $m->header("Date"));
                        }
                }
        }
}

# write attachments to a local folder
sub write_ics {
        my ($p, $subject, $date) = @_;

        # sanitize the subject line so I can use it as a filename
        $subject =~ s/\s+/_/g; # no spaces
        $subject =~ s|/|_|g;   # no slashes
        $subject =~ s|_+|_|g;  # remove duplicate underscores

        my $filename = "${savedir}/${subject}.ics";
        if ( -f $filename ) {
                print "WARNING: overwriting $filename\n" if $verbose;
        }

        if ( ! open(ICS, ">$filename") ) {
                print qq(WARNING: failed to open $filename for writing\n);
                return;
        }

        print "Writing $filename\n" if $verbose;
        print ICS $p->body, "\n";
        close ICS;

        # set date of the file to date of email Date header
        my ($ss,$mm,$hh,$day,$month,$year,$zone) = strptime($date);
        my $newtime = timelocal(0, $mm, $hh, $day, $month, $year);
        utime $newtime, $newtime, $filename;
}

Technorati tags for this post: Tech email thunderbird perl