Extracting Meeting Invites from my Mailbox
In previous posts I've bemoaned the lack of integration between Mozilla's Thunderbird and external programs -- especially Mozilla Sunbird. I realize that there is a new project (Lightning) to integrate the two, but my meeting invites keep pouring in at work and I can't wait.
My temporary solution to this problem uses the following perl script. Its job is to copy any MIME attachments of type "text/calendar" out of my inbox and into a folder on disk. Then I can use Sunbird's Import feature to read them in. My procedure is this:
- When I receive a meeting invite in Thunderbird, I copy the message into a specific folder - I call it meetings
- Then I run my script like this:
./extract_ics.pl -m ~/Mail/meetings -d ~/calendar -v - In Sunbird, I import the ~/calendar/[whatever].ics file created in step 2.
- Finally, I go back and delete the contents of ~/calendar and the meetings folder
#!/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;
}
Update: Make sure you "compact" your Mozilla folder before you run the script. There are likely to be "deleted" messages in it.
Technorati tags for this post: Tech email thunderbird perl
