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 iCal::Parser             ();
use DateTime                 ();

our $VERSION = '0.5';

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.88 } );

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 {
        warn "date_format_obj() is deprecated and will be removed soon, please update your code";
        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' : '';

        my $url  = "http://www.google.com/calendar/ical/$gcal/basic.ics?$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 $ics = eval {
            iCal::Parser->new(
                start    => $self->base_date->format_cldr('yyyyMMdd'),
                end      => $q_end->format_cldr('yyyyMMdd'),
                no_todos => 1,

                # TODO 2: best thing to do here ?tz => $self->time_zone,
            )->parse($file);
        };

        if ($@) {
            die "Could not parse ICS ($file): $@";
        }

        my %cal;

        my $gcal_title        = $ics->{cals}[0]{'X-WR-CALNAME'};
        my $gcal_updated      = undef;                              # set if possible via BUILD_EVENT_LIST
        my $gcal_updated_date = undef;
        my $gcal_tz           = $ics->{cals}[0]{'X-WR-TIMEZONE'};
        my $gcal_uri          = $gcal;
        $gcal_uri =~ s{/p.*$}{};
        my @entries;

      BUILD_EVENT_LIST:
        for my $year ( sort { $a <=> $b } keys %{ $ics->{events} } ) {
            for my $month ( sort { $a <=> $b } keys %{ $ics->{events}{$year} } ) {
                for my $day ( sort { $a cmp $b } keys %{ $ics->{events}{$year}{$month} } ) {
                    for my $cuid ( sort { $ics->{events}{$year}{$month}{$day}{$a}{DTSTART}->iso8601() cmp $ics->{events}{$year}{$month}{$day}{$b}{DTSTART}->iso8601() } keys %{ $ics->{events}{$year}{$month}{$day} } ) {

                        my $entry = $ics->{events}{$year}{$month}{$day}{$cuid};

                        if ( !defined $gcal_updated || $gcal_updated->epoch() < $entry->{'LAST-MODIFIED'}->epoch() ) {
                            $gcal_updated = $entry->{'LAST-MODIFIED'};    # because ical cals data dies not contain last updated we have to get it from the events, needs set before BUILD_EVENTS_HASH
                        }

                        # TODO 2 ?: $event_dt_obj->set_time_zone($gcal_tz);

                        push @entries, $entry;                            # processed via BUILD_EVENTS_HASH
                    }
                }
            }
        }

        if ( defined $gcal_updated ) {
            $gcal_updated_date = $gcal_updated->format_cldr("E MMM d");
            $gcal_updated      = $gcal_updated->iso8601();
        }

      BUILD_EVENTS_HASH:
        for my $entry (@entries) {

            # use Devel::Kit::TAP;d($entry->{DTSTART}."");
            # 'SUMMARY',
            # 'LOCATION',
            # 'hours',
            # 'LAST-MODIFIED',
            # 'UID',
            # 'idref',
            # 'STATUS',
            # 'TRANSP',
            # 'DTSTAMP',
            # 'DTEND',
            # 'CREATED',
            # 'ORGANIZER',
            # 'DESCRIPTION',
            # 'DTSTART',
            # 'ATTENDEE'

            my $event_dt_obj = $entry->{DTSTART};

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

            my $date = $event_dt_obj->format_cldr("E MMM d");
            push @{ $cal{$date} }, {
                'title' => $entry->{SUMMARY},
                'desc'  => $entry->{DESCRIPTION},
                'url'   => "https://www.google.com/calendar/embed?src=$gcal_uri",    # TODO 1: URL to event, what is it given the data in the iCal?
                '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->{'LOCATION'},
                'guests'   => \@who,

                'gcal_title'        => $gcal_title,
                'gcal_uri'          => $url,                                         # "https://www.google.com/calendar/embed?src=$gcal_uri",
                '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__