File Coverage

blib/lib/Mail/GcalReminder.pm

Criterion	Covered	Total	%
statement	7	9	77.7
branch			n/a
condition			n/a
subroutine	3	3	100.0
pod			n/a
total	10	12	83.3

package Mail::GcalReminder;

## no critic (RequireUseStrict) - Moo does strict
use Moo;

with 'Role::Multiton::New';

use Email::Send::SMTP::Gmail ();
use XML::Simple              ();
use DateTime                 ();

our $VERSION = '0.4';

has gmail_user => ( is => 'rw', required => 1 );

has gmail_pass => ( is => 'rw', required => 1 );

has app_name => ( is => 'rw', lazy => 1, builder => 1 );

sub _build_app_name { return $_[0]->gmail_user . ' (' . __PACKAGE__ . ')' }

has time_zone => (
    is      => 'rw',
    default => sub { 'UTC' },
    isa     => sub {
        require DateTime::TimeZone;
        my $tz;
        eval { $tz = DateTime::TimeZone->new( name => $_[0] ) };
        die "DateTime::TimeZone does not recognize the given name" unless $tz;
    }
);

has cc_self => ( is => 'rw', default => sub { 1 } );

has try_receipts => ( is => 'rw', default => sub { 1 } );

has try_priority => ( is => 'rw', default => sub { 1 } );

has no_guests_is_ok => ( is => 'rw', default => sub { 1 } );

has include_event_dt_obj => ( is => 'rw', default => sub { 0 } );

has http => (
    is        => 'rw',
    'lazy'    => 1,
    'default' => sub {
        require HTTP::Tiny;
        return HTTP::Tiny->new();
    },
    isa => sub { die "http() must have a mirror method" unless $_[0]->can('mirror') },
);

has workdir => (
    is        => 'rw',
    'lazy'    => 1,
    'default' => sub {
        require File::Temp;
        return File::Temp->newdir();
    },
    isa => sub { die "workdir() must be a directory" unless -d $_[0] },
);

has base_date => (
    is        => 'rw',
    'lazy'    => 1,
    'default' => sub {
        return DateTime->now( time_zone => $_[0]->time_zone );
    },
    'isa' => sub { die "only DateTime objects are supported" unless ref( $_[0] ) eq 'DateTime' },
);

has essg_hax_ver => ( is => 'rw', 'default' => sub { 0.82 } );

has warning_code => (
    is        => 'rw',
    'default' => sub {
        require Carp;
        return sub {
            shift;
            local $Carp::CarpLevel += 1;
            goto &Carp::carp;
          }
    }
);

sub warning {
    my ( $self, @args ) = @_;
    $self->warning_code->( $self, @args );
}

has date_format_obj => (
    is        => 'ro',
    'lazy'    => 1,
    'default' => sub {
        require DateTime::Format::ISO8601;
        return DateTime::Format::ISO8601->new();
    },
);

has signature => ( is => 'rw', lazy => 1, builder => 1 );

sub _build_signature {
    return "\n\n--\n" . $_[0]->app_name . "\n\nNote: Please ensure mail from “" . $_[0]->gmail_user . "” is not being filtered out of your inbox.";
}

has debug => ( is => 'rw', default => sub { 0 } );

has gcal_cache => ( is => 'rw', default => sub { {} }, isa => sub { die "gcal_cache must be a hashref" unless ref( $_[0] ) eq 'HASH' } );

# TODO: clear_gcal() ?
sub get_gcal {
    my ( $self, $gcal ) = @_;
    my $cache = $self->gcal_cache();

    if ( !exists $cache->{$gcal} ) {

        my $q_end = $self->base_date->clone;
        $q_end->add( days => 42 );    # TODO: start-max via object

        my $query_string = 'orderby=starttime&sortorder=a&start-min=' . $self->base_date->format_cldr('yyyy-MM-dd') . '&start-max=' . $q_end->format_cldr('yyyy-MM-dd') . '&max-results=100';    # TODO: max via object

        my $single_event = 1;                                                                                                                                                                    # ? DO THIS ALL THE TIME?
        my $addt = $single_event ? '&singleevents=true' : '';

        # https://developers.google.com/google-apps/calendar/v2/reference#Calendar_feeds
        my $url = "http://www.google.com/calendar/feeds/$gcal/full?$query_string$addt";

        my $path = $gcal;
        $path =~ s{/}{_slash_}g;
        my $file = $self->workdir . "/$path.xml";                                                                                                                                                # TODO: make portable via File::Spec
        my $res = $self->http->mirror( $url, $file );
        if ( !$res->{success} ) {
            die "Could not fetch “$url”: $res->{reason}\n";
        }

        my $xml = eval { XML::Simple::XMLin( $file, ForceArray => [ 'gd:who', 'link' ] ) };
        if ($@) {
            die "Could not parse XML ($file): $@";
        }

        my %cal;

        my $gcal_title        = $xml->{title}{content};
        my $gcal_updated      = $xml->{updated};
        my $gcal_tz           = $xml->{'gCal:timezone'}{'value'};
        my $gcal_updated_date = defined $gcal_updated ? $self->date_format_obj->parse_datetime($gcal_updated)->format_cldr("E MMM d") : undef;

        for my $entry_key ( sort { $xml->{entry}{$a}{'gd:when'}{'startTime'} cmp $xml->{entry}{$b}{'gd:when'}{'startTime'} } keys %{ $xml->{entry} } ) {
            my $entry = $xml->{entry}{$entry_key};

            my $event_dt_obj = $self->date_format_obj->parse_datetime( $entry->{'gd:when'}{'startTime'} );

            # $event_dt_obj->set_time_zone($gcal_tz);

            # TODO: factor author in attendees ?
            # 'author' => {
            #   'email' => '[e-mail]',
            #   'name' => 'Steeplechase Public Talks Coord'
            # },

            my $attendees_ar = $entry->{'gd:who'};
            my @who;
            if ( defined $attendees_ar && ref($attendees_ar) eq 'ARRAY' ) {
                @who = map {
                    my $str = $_->{email};
                    $str && $str !~ m/\@group.calendar.google.com$/ ? $str : ()
                } @{$attendees_ar};
            }

            my $date = $event_dt_obj->format_cldr("E MMM d");
            push @{ $cal{$date} }, {
                'title' => $entry->{title}{content},
                'desc'  => $entry->{content}{content},

                'url' => $entry->{link}[0]{type} eq 'text/html' ? $entry->{link}[0]{href} : $entry->{link}[1]{href},
                'date' => $date,
                'year' => $event_dt_obj->format_cldr("YYYY"),
                'time' => $event_dt_obj->format_cldr("h:mm a"),
                ( $self->include_event_dt_obj ? ( 'event_dt_obj' => $event_dt_obj ) : () ),
                'location' => $entry->{'gd:where'}{valueString},
                'guests'   => \@who,

                'gcal_title'        => $gcal_title,
                'gcal_uri'          => $url,
                'gcal_entry_obj'    => $entry,
                'gcal_updated'      => $gcal_updated,
                'gcal_updated_date' => $gcal_updated_date,
            };
        }

        $cache->{$gcal} = \%cal;
    }

    return $cache->{$gcal};
}

sub send_reminders {
    my ( $self, $conf ) = @_;

    my $gcal = $self->get_gcal( $conf->{'gcal'} );
    my $name = $conf->{'label'} || $conf->{'gcal'};

    my $target = $self->base_date->clone();
    $target->add( @{ $conf->{'in_advance'} } );
    my $target_str = $target->format_cldr("E MMM d");

    return "0E0" if !exists $gcal->{$target_str} || !@{ $gcal->{$target_str} };    # no events that day

    my $event_cnt = @{ $gcal->{$target_str} };

    if ( $conf->{'min_events'} && $event_cnt < $conf->{'min_events'} ) {
        $self->warning("Not enough events (min $conf->{'min_events'}, actual $event_cnt) for “$name”.");
    }

    if ( $conf->{'max_events'} && $event_cnt > $conf->{'max_events'} ) {
        $self->warning("Too many events (max $conf->{'max_events'}, actual $event_cnt) for “$name”.");
    }

    # ? TODO ? warning() if $conf->{'max_events'} < $conf->{'min_events'}

    my $count = 0;
    for my $event ( @{ $gcal->{$target_str} } ) {
        my @guests = $event->{'guests'} ? @{ $event->{'guests'} } : ();
        @guests = $conf->{'guestcheck'}->( $self, @guests ) if ref( $conf->{'guestcheck'} ) eq 'CODE';

        if (@guests) {
            my $guests_cnt = @guests;
            if ( $conf->{'min_guests'} && @guests < $conf->{'min_guests'} ) {
                $self->warning("Not enough guests (min $conf->{'min_guests'}, actual $guests_cnt) for “$event->{'title'}”.");
            }

            if ( $conf->{'max_guests'} && @guests > $conf->{'max_guests'} ) {
                $self->warning("Too many guests (max $conf->{'max_guests'}, actual $guests_cnt) for “$event->{'title'}”.");
            }

            # ? TODO ? warning() if $conf->{'max_guests'} < $conf->{'min_guests'}

            my $to = join( ',', @guests );
            my $subject = ref( $conf->{'subject'} ) eq 'CODE' ? $conf->{'subject'}->( $self, $event ) : $conf->{'subject'};    # || ? TODO, default/warning/both ?
            my $body = ref( $conf->{'body'} ) eq 'CODE' ? $conf->{'body'}->( $self, $event ) : $conf->{'body'};                # || ? TODO, default/warning/both ?

            $count++ if $self->send_gmail( $to, $subject, $body );
        }
        else {
            $self->warning("No guests for “$event->{'title'}”.");
            $count++ if $self->no_guests_is_ok;
        }
    }

    return unless $count == @{ $gcal->{$target_str} };
    return $count;
}

sub send_gmail {
    my ( $self, $to, $subject, $body ) = @_;

    eval {
        my $charset = 'UTF-8';

        # have to verify this still works as new versions come out
        # Email::Send::SMTP::Gmail -charset 'bugure' header injection:
        if ( $Email::Send::SMTP::Gmail::VERSION <= $self->essg_hax_ver ) {
            if ( $self->try_receipts || $self->try_priority ) {

                # end charset header
                $charset .= "\n";

                if ( $self->try_priority ) {

                    # flag as important to help them see it:
                    $charset .= "X-Priority: 1\n";
                    $charset .= "Priority: Urgent\n";
                    $charset .= "Importance: high";             # !! no newline !! (\n is appended to -charset call in Email::Send::SMTP::Gmail)
                    $charset .= "\n" if $self->try_receipts;    # so we can continue the hack
                }

                if ( $self->try_receipts ) {

                    # at least try to get some response:
                    $charset .= "X-Confirm-Reading-To: " . $self->gmail_user . "\n";
                    $charset .= "Return-Receipt-To: " . $self->gmail_user . "\n";
                    $charset .= "Disposition-Notification-To: " . $self->gmail_user;    # !! no newline !! (\n is appended to -charset call in Email::Send::SMTP::Gmail)
                }
            }
        }
        else {
            if ( $self->try_receipts || $self->try_priority ) {
                my $essg_hax_ver = $self->essg_hax_ver;
                $self->warning("Email::Send::SMTP::Gmail is newer than $essg_hax_ver, skipping header-via-charset hack");
            }
        }

        my $mail = Email::Send::SMTP::Gmail->new(
            '-smtp'  => 'smtp.gmail.com',
            '-login' => $self->{'gmail_user'},
            '-pass'  => $self->{'gmail_pass'},
        );

        $mail->send(
            '-to' => ( $self->debug ? $self->gmail_user : $to ),
            '-from' => $self->gmail_user,
            ( $self->cc_self ? ( '-cc' => $self->gmail_user ) : () ),
            '-subject' => $subject,
            '-charset' => $charset,
            '-verbose' => $self->debug,
            '-body'    => $body . $self->signature,
        );

        $@ = $@;    # send() is eval()

        $mail->bye;
    };

    if ($@) {
        $self->warning($@);
        return;
    }

    return 1;
}

1;

__END__