The below script is an example how to clean and archive e-mails. The script was written in Perl and tested on a Courier IMAP server. Remember the Perl devise: there are million ways to write Perl scripts.

The following modules were used:

use Net::IMAP::Simple::SSL;
use Email::Simple;
use Getopt::Long qw/:config bundling/;
use DateTime;
use YAML qw/LoadFile/;
use Log::Log4perl;
use Pod::Usage;
use Data::Dumper;

The configuration file is written in YAML and the logging of the script is handled by Log4Perl.

log4perl.logger.shihai= DEBUG, shihaiLogfile
log4perl.logger.hostlistdb= DEBUG, shihaiLogfile

log4perl.appender.shihaiLogfile          = Log::Log4perl::Appender::File
log4perl.appender.shihaiLogfile.filename = /var/tmp/shihai.log
log4perl.appender.shihaiLogfile.layout   = Log::Log4perl::Layout::PatternLayout
log4perl.appender.shihaiLogfile.layout.ConversionPattern = %d %p [%x][%r millis][%c][%F{1}:%L][%M] %m%n

The configuration file contains the login credentials and the threshold values:

imap:
    host: 'mail.example.com'
    user: 'bob@example.com'
    pass: 'myultrasecretpassword'

threshold:
    archive:
        years: 3
    delete:
        years: 8

The threshold values are in fact the same parameters that can be used in the DateTime method ‘subtract()’;

The main loop of the program will:

• Connect to the IMAP server
• Retrieve all IMAP folders and loop through them
• Loop through all messages in each mailbox

# Connect to the IMAP server
my $imap = connect_imap( $config->{imap} );

# get all mailboxes and loop through them
my @mailboxes = get_mailboxes($imap);
foreach my $mailbox_name (@mailboxes){

    # Skip all Archive boxes 
    next if $mailbox_name =~ /Archive/;

    # select the mailbox and get the number of messages
    my $mb = $imap->select($mailbox_name);
    unless(defined $mb){
        $logger->error("Mailbox [$mailbox_name] doesn't exist: ", $imap->errstr());
        next;
    }

    $logger->info("Scanning $mailbox_name");

    # loop through the messages
    foreach my $i (1 .. $mb){
        my ($from, $subject, $date, $year) = get_mail_header($imap, $i);

        if(defined $date){
            if($date < $delete_date ){
                delete_mail($imap, $i);
            }
            elsif($date < $archive_date){
                $logger->info("Archiving [$i][$from][$subject][$date]");
                my $archive_box = get_archive_box($imap, $mailbox_name);
                move_mail($imap, $i, $archive_box)
            }
        }
    }

    $imap->expunge_mailbox($mailbox_name);
}

$imap->quit;

Let’s go through the different subroutines called in the mainloop.

connect_imap()

sub connect_imap {
    my ($cfg) = @_;
    my $logger = Log::Log4perl->get_logger('shihai.archive_mail');

    my $imap = Net::IMAP::Simple::SSL->new($cfg->{host})
        or $logger->logdie("Unable to connect to IMAP server: $Net::IMAP::Simple::errstr");
    $logger->info("Connected to IMAP host $cfg->{host}");

    unless( $imap->login($cfg->{user}, $cfg->{pass}) ){
        $logger->logdie("Login failed: ", $imap->errstr);

    }
    $logger->info("Logged to IMAP host $cfg->{host} as user '$cfg->{user}'");

    return $imap;
}

The parameters expected in the ‘$cfg’ hash are:

• host
• user
• pass

get_mailboxes()

sub get_mailboxes {
    my ($imap) = @_;
    my @mailboxes = $imap->mailboxes;
    my $logger = Log::Log4perl->get_logger('shihai.archive_mail');

    return @mailboxes;
}

Ok, I admit, I shouldn’t have created an extra subroutine for it… but i was kind of in a flow!

get_mail_header()

sub get_mail_header {
    my ($imap, $i) = @_;
    my $logger = Log::Log4perl->get_logger('shihai.archive_mail');

    my $header = $imap->top($i);
    unless( $header ){
        $logger->error("No header found for message $i in ", $imap->current_box);
    }
    
    my $email = Email::Simple->new(join '', @{ $header });
    unless( $email ){
        $logger->error("No Email::Simple object, skipping...");
        return
    }

    my ($subject) = $email->header('Subject');
    my ($date)    = $email->header('Date');
    my ($from)    = $email->header('From');

    # $logger->debug("Got e-mail [$from] [$subject] [$date]");

    unless(defined $date){
        $logger->error("No date found: ", $email->header_obj->as_string);
        delete_mail($imap, $i);
        return;
    }
    
    my($junk, $day, $month, $year) = ( $date =~ m/(...,\s+)?([0-9]{1,2})\s+(...)\s+(\d{4})/ );

    my $date_obj;
    if(defined $year && defined $month && defined $day){
        $date_obj = DateTime->new(
            year  => $year,
            month => $months{$month},
            day   => $day,
        );
    }    

    return ($from, $subject, $date_obj, $year, $month, $day);
}

This subroutine takes the ‘$imap’ object and the message number as input parameters. It will then retrieve the mail header and convert it to an ‘Email::Simple’ object. I’ve chosen this module so I can easily extract header fields.
If no ‘Date:’ field was found in the e-mail, then the tool will just delete the email. I don’t like e-mails with wrong or missing headers (they’re usually spam anyway).

delete_mail()

sub delete_mail {
    my($imap, $i) = @_;
    my $logger = Log::Log4perl->get_logger('shihai.archive_mail');

    if( $imap->delete($i) ){
        $logger->info("Deleted message number $i from ", $imap->current_box);
    }
}

Pretty straightforward.

get_archive_box()

sub get_archive_box{
    my($imap, $mailbox_name) = @_;
    my $logger = Log::Log4perl->get_logger('shihai.archive_mail');

    my ($archive_box) = ($mailbox_name);
    $archive_box =~ s/INBOX/INBOX.Archive/;

    if( not grep /^$archive_box$/, @mailboxes) {
        create_mailbox($imap, $archive_box);
        subscribe($imap, $archive_box);
    }

    return $archive_box;       
}

This subroutine will assemble the archive mailbox name. It will then check if the mailbox already exists and otherwise create it and subscribe to it.

create_mailbox()

sub create_mailbox {
    my($imap, $mb) = @_;
    my $logger = Log::Log4perl->get_logger('shihai.archive_mail');

    $imap->create_mailbox($mb) or $logger->logdie("Mailbox creation '$mb' failed: ", $imap->errstr());
    $logger->info("Created mailbox $mb");
}

It will basically just create the mailbox and log about it.

subscribe()

sub subscribe {
    my($imap, $box) =@_;
    my $logger = Log::Log4perl->get_logger('shihai.archive_mail');

    $imap->folder_subscribe($box);
    $logger->info("Subscribed to mailbox $box");
}

move_mail()

sub move_mail {
    my($imap, $i, $new_box) = @_;
    my $logger = Log::Log4perl->get_logger('shihai.archive_mail');

    if( $imap->copy($i, $new_box) ){
        $logger->info("Copied message number [$i] from ", $imap->current_box ," to [$new_box]");
        delete_mail($imap, $i);
    }
}

Moving an e-mail consists of copying it first to the new mailbox and then afterwards removing it from the old mailbox.

And that’s basically it!

Working as a contractor, we have to fill in timesheets which have to be approved and so. Now, I also like to view in my agenda when I’ve worked and how long. This information is important at the end of the month when creating an invoice (which state the number of days I’ve worked).

The project management tool at my current job, sends out emails when a certain period has been approved by my manager. The email body looks somewhat like this:

Name:        Morano, Johnny
Status:      Approved
Week Ending: 25-Dec-2010
Manager:     Name, Manager
                                 HOURS                                 
=======================================================================
Ln|Work Request   |Act |  Sun|  Mon|  Tue|  Wed|  Thu|  Fri|  Sat|Total
-----------------------------------------------------------------------
1 |xxxxxx         |COD | 0.00| 8.00| 8.00| 8.00| 8.00| 0.00| 0.00|32.00
-----------------------------------------------------------------------
TOTAL                  | 0.00| 8.00| 8.00| 8.00| 8.00| 0.00| 0.00|32.00
=======================================================================

                                DETAILS                                
=======================================================================
Ln|Work Request Name        |Activity       |Site  |Asset    |SubAsset 
-----------------------------------------------------------------------
1 |xxxxxxxxxx               |Code & UnitTest|XXXXXX|XXXXX    |N/A      
=======================================================================

                            TIMESHEET NOTES                            
=======================================================================
 
=======================================================================

These emails all get sorted in my Courier IMAP email server into a specific mailbox, e.g. ‘INBOX.Moretrix.Timesheets’.

My agenda is currently held at Google Calendar, which is an excellent tool for creating private and public agenda’s.

The programming language I’ve used is, of course, Perl. In Perl, there are easy to use modules like Net::IMAP::Simple and Net::Google::Calendar which are going to help us building this automated process.

We will need to gather some information, before we start writing our code. The following is required:
– IMAP user login account
– IMAP password
– IMAP mailbox
– GMail user account
– GMail password
– Google Calendar name (you need to create a separate calendar in Google Calendar, I’ve called mine ‘Business’

The header of script shows which modules to use:

#!/usr/bin/perl
use strict; use warnings;

use Net::IMAP::Simple::SSL;
use Email::Simple;
use DateTime;
use Net::Google::Calendar;

my %months = (
    Jan => 1, May => 5, Sep => 9,
    Feb => 2, Jun => 6, Oct => 10,
    Mar => 3, Jul => 7, Nov => 11,
    Apr => 4, Aug => 8, Dec => 12,
);

my($imap_host, $imap_user, $imap_pass, $scan_box);
my ($gmail_username, $gmail_password, $gmail_calendar);
$imap_user      ||= 'IMAP username';
$imap_pass      ||= 'IMAP password';
$imap_host      ||= 'IMAP host';
$scan_box       ||= 'INBOX.Moretrix.Timesheets';
$gmail_username ||= 'GMail user@gmail.com';
$gmail_password ||= 'GMail password';
$gmail_calendar ||= 'Business';

This part is pretty basic and requires no explanation.

The following part will try to connect to the IMAP server and initialize a connection to the Google Calendar.

my $imap = Net::IMAP::Simple::SSL->new($imap_host)
        or die "Unable to connect to IMAP server: $Net::IMAP::Simple::errstr n";
die( "Login failed: " . $imap->errstr . "n" ) unless $imap->login($imap_user, $imap_pass);

my $number_of_messages = $imap->select($scan_box);
if( not defined $number_of_messages ){
    error "failed to get number of messages for $scan_box: " . $imap->errstr();
    next
}

#
# Log in on Google Calendars
#
my $gcal = Net::Google::Calendar->new();
$gcal->login($gmail_username, $gmail_password);
info "Logged in to Google Calendars";

#
# Search my 'Business' calendar
#
for my $c ($gcal->get_calendars) {
    debug "Calendar title: ". $c->title;
    debug "Calendar ID   : ". $c->id;
    if($c->title eq $gmail_calendar){
        $gcal->set_calendar($c);
        debug "Found calendar $gmail_calendar...";
        debug $c->title." has ".scalar($gcal->get_events)." events";
        last;
    }
}

Still no rocket science, we use the modules like they are described in their perldoc pages, and finally we search for the calendar we want to edit in Google Calendars.

So at this point we have an IMAP connection and a connection to Google Calendars. Now we will loop through all the messages in the configured IMAP folder and start parsing the messages.
We will only need the ‘TOTAL’ lines with all the working hours and the line stating ‘Week Ending’. The latter is used to calcute the dates of the working hours.
Since this IMAP folder also contains other emails than the timesheet emails, we’ll refine our search procedure by taking only those emails that match a certain subject.

#
# Loop through the emails
#
foreach my $message ( 1 .. $number_of_messages ){
    my $header = $imap->top($message);
    (warning( "No header found: ", $imap->errstr() ), next) unless $header;

    my $email = Email::Simple->new(join '', @{ $header });
    (warning( "No Email::Simple object", $imap->errstr() ), next) unless $email;

    next unless $email->header('Subject') =~ /Approved Business Timesheet/;

    info sprintf("n[%03d] %-29s | %-56s", $message, $email->header('Date'), $email->header('Subject'));

At this point, we know that the mail message number (which is in $message) is an email that we need to parse.
Now we will grab the information required from the body of the email and start the calculation of the dates.

    # Grab data from email body
    my $body = $imap->get( $message ) or die $imap->errstr;
    $body = "$body";
    my($week_ending) = ($body =~ /Week Ending:([^n]*)/m);
    my($totals)      = ($body =~ /TOTAL([^n]*)/m);
    $week_ending              =~ s/s+//g;
    $totals                   =~ s/s+//g;

    # Create DateTime object based on the 'Week Ending' string in the body of the email
    my($day,$month,$year) = split /-/, $week_ending;
    my $date_obj  = DateTime->new(year => $year, month => $months{$month}, day => $day);
    $date_obj->set(hour => 0);
    $date_obj->set(minute => 0);
    $date_obj->set(second => 0);
    $date_obj->set_time_zone('Europe/Brussels');
    # subtract 5 days since Week Ending shows Saturday, but we start on Monday
    $date_obj->subtract(days => 5);

In the next part, we cleanup the @totals array, since we don’t need the days Sunday and Saturday, nor do we need the grand total displayed in the email.

    #
    # Cleanup the @totals
    #
    my (@totals) = split /|/, $totals;
    # last value is grand total, we dont need that
    pop(@totals);
    # last value now is saturday, we dont need that
    pop(@totals);
    # first value is empty due to the leading | in $totals
    shift(@totals);
    # first value is sunday, we dont need that
    shift(@totals);

The comments in the code explain enough.
Now that we have our totals (which are the values per day), we can loop through the days and create the appropriate calendar items:

    # loop through the days of the week
    foreach my $t (@totals){

        # skip days with 0 working hours
        next unless $t > 0;

        # These values are to narrow down the search for Google Calendars events
        my $day_start  = DateTime->from_object(object => $date_obj);
        my $day_end    = DateTime->from_object(object => $date_obj);
        $day_end->add(days => 1);

        # Start and end time of the event we want to create/update
        my $start_date = DateTime->from_object(object => $date_obj);
        my $end_date   = DateTime->from_object(object => $date_obj);
        $start_date->add(hours => 9);
        $end_date->add(hours => 9 + $t);

        # Print some logging
        info 'From: '.$start_date->dmy. ' '.$start_date->hms. " | ".
             'Until: '.$end_date->dmy. ' '.$end_date->hms. "  => $t hours";

        # Create the author contact person
        my $author = Net::Google::Calendar::Person->new();
        $author->name('Johnny Morano');
        $author->email('johnny.morano@gmail.com');

        # Create Google Calendar entry object
        my $entry = Net::Google::Calendar::Entry->new();
        $entry->title('Approved Business Timesheet');
        $entry->content(
            "Worked $t hours. ".
            'From: ' .$start_date->dmy. ' '.$start_date->hms. " | ".
            'Until: '.$end_date->dmy  . ' '.$end_date->hms . 
            " Approved in email from " . $email->header('Date')
        );
        $entry->location('Leuven, Belgium');
        $entry->when($start_date, $end_date);
        $entry->author($author);

        my @cal_events = $gcal->get_events('start-min' => $day_start, 'start-max' => $day_end);
        my $found   = 0;
        foreach my $e (@cal_events) {
            if($e->title =~ /Approved Business Timesheet/){
                my $changes = 0;
                ($e->title($entry->title()), $changes++)            if $e->title    ne $entry->title;
                ($e->content($entry->content()), $changes++)        if $e->content  ne $entry->content;
                ($e->location($entry->location()), $changes++)      if $e->location ne $entry->location;
                ($e->when($entry->when()), $changes++)              if $e->when     ne $entry->when;
                ($e->author($entry->author()), $changes++)          if $e->author   ne $entry->author;

                if($changes){
                    $gcal->update_entry($e) if $changes;
                    info " --> UPDATED CALENDAR ENTRY with $changes changes";
                    $found++; last;
                }
            }
        }
        if(not $found){
            $gcal->add_entry($entry);
            info " --> ADDED CALENDAR ENTRY";
        }

        # go to next day
        $date_obj->add(days => 1);
    }

}