Remind::Parser - parse `remind -lp' output

    use Remind::Parser;

    $parser = Remind::Parser->new(...);

    $parser->parse(\*STDIN);

    $reminders = $parser->reminders;
    foreach $rem (@$reminders) {
        ($Y, $M, $D) = @$rem{qw(year month day)};
        $descrip = $rem->{'description'};
    }

    $days = $parser->days;
    foreach $day (@$days) {
        $reminders_for_day = $day->{'reminders'};
        foreach $rem (@$reminders_for_day) {
            ...
        }
    }

package Remind::Parser;

use strict;
use warnings;

use vars qw($VERSION);

use Date::DayOfWeek qw(dayofweek);

$VERSION = '0.07';

# --- Constructor

sub new {
    my $cls = shift;
    my $self = bless {
        @_,
    }, $cls;
    return $self->_init;
}

sub _init {
    my ($self) = @_;
    # Nothing to do
    return $self;
}

# --- Accessors

sub reminders { scalar(@_) > 1 ? $_[0]->{'reminders'} = $_[1] : $_[0]->{'reminders'} }
sub strict { scalar(@_) > 1 ? $_[0]->{'strict'} = $_[1] : $_[0]->{'strict'} }
sub strip_times { scalar(@_) > 1 ? $_[0]->{'strip_times'} = $_[1] : $_[0]->{'strip_times'} }
sub fill_gaps { scalar(@_) > 1 ? $_[0]->{'fill_gaps'} = $_[1] : $_[0]->{'fill_gaps'} }

# --- Other public methods

sub parse {
    my ($self, $fh) = @_;
    delete $self->{'days'};  # We'll regenerate later if asked
    my ($file, $line, $loc, %file);
    my ($past_header, $all_done);
    my @reminders;
    my %loc2event;
    my %loc2count;
    my $next_event = 1;
    my $start = <$fh>;
    return [] unless defined $start;
    if ($start !~ /^# rem2ps begin$/) {
        die "First line of input is not the proper header: $_"
            if $self->strict;
    }
    while (<$fh>) {
        chomp;
        if ($all_done) { 
            if ($_ !~ /^# rem2ps begin$/ ) {
                die "Spurious input at end of input: $_"
                    if $self->strict;
                last;
            } 
            else { $past_header = 0 ; $all_done = 0 }
        }
        if (/^# fileinfo (\d+) (.+)/) {
            ($line, $file) = ($1, $2);
            $loc = "$file:$line";
            $past_header = 1;
        }
        elsif ($past_header) {
            # We've skipped past the header
            if (/^# rem2ps end$/) {
                # All done
                $all_done = 1;
            }
            else {
                unless (defined $loc) {
                    die "Input does not contain file and line offsets; you must use option -p with remind";
                }
                my ($date, $special, $tag, $duration, $offset, $description) = split / +/, $_, 6;
                my ($year, $month, $day) = split m{[-/]}, $date;
                if ($self->strip_times && $description =~ s/^((\d\d?):(\d\d)([ap]m) )//) {
                    # Strip the time -- but then restore it if it doesn't match
                    #   the offset in minutes
                    my ($stripped, $H, $M, $pm) = ($1, $2, $3, $4 eq 'pm');
                    $description = $stripped . $description
                        unless $offset == _HMpm2min($H, $M, $pm);
                }
                my $event = $loc2event{$loc} ||= $next_event++;
                my $instance = ++$loc2count{$loc};
                my %reminder = (
                    'event'       => $event,
                    'instance'    => $instance,
                    'file'        => $file,
                    'line'        => $line,
                    'year'        => $year  + 0,
                    'month'       => $month + 0,
                    'day'         => $day   + 0,
                    'description' => $description,
                    $tag eq '*'     ? () : ('tag'     => $tag),
                    $special eq '*' ? () : ('special' => $special),
                );
                $reminder{'date'} = sprintf('%04d%02d%02d', @reminder{qw(year month day)});
                my ($begin, $end);
                if ($offset eq '*') {
                    # Untimed (whole day) reminder
                    $reminder{'all_day'} = 1;
                }
                else {
                    # Timed reminder
                    $reminder{'hour'}   = int($offset / 60);
                    $reminder{'minute'} = $offset % 60;
                    $reminder{'second'} = 0;
                    if ($duration ne '*') {
                        $reminder{'duration'} = {
                            'hours'   => int($duration / 60),
                            'minutes' => $duration % 60,
                            'seconds' => 0,
                        };
                    }
                }
                push @reminders, \%reminder;
            }
        }
    }
    return $self->{'reminders'} = \@reminders;
}

sub days {
    my ($self, %args) = @_;
    return $self->{'days'} if $self->{'days'};
    my ($begin_date, $end_date) = @args{qw(begin end)};
    my $reminders = $self->reminders;
    my %date_info;
    _consolidate_reminders($reminders, \%date_info);
    _sort_date_reminders(\%date_info);
    if (exists $args{'fill_gaps'}) {
        _fill_gaps(\%date_info) if $args{'fill_gaps'};
    }
    elsif ($self->fill_gaps) {
        _fill_gaps(\%date_info);
    }
    if (defined $begin_date) {
        foreach (sort keys %date_info) {
            delete $date_info{$_}
                if $_ lt $begin_date;
        }
    }
    if (defined $end_date) {
        foreach (sort keys %date_info) {
            delete $date_info{$_}
                if $_ gt $end_date;
        }
    }
    return $self->{'days'} = [ map { $date_info{$_} } sort keys %date_info ];
}

sub _HMpm2min {
    my ($H, $M, $pm) = @_;
    my $base = $pm ? 12 * 60 : 0;
    $H = 0 if $H == 12;  # 12:XXam --> 00:XXam, 12:XXpm --> 00:XXpm
    return $base + $H * 60 + $M;
}

# -------------------------------- Functions

sub _consolidate_reminders {
    my ($reminders, $date_info) = @_;
    foreach my $r (@$reminders) {
        my ($year, $month, $day) = @$r{qw/year month day/};
        my $ymd = _format_date($year, $month, $day);
        my $info = $date_info->{$ymd} ||= _norm_reminder({
            'year'  => $year,
            'month' => $month,
            'day'   => $day,
            'reminders' => [],
        });
        delete $date_info->{$ymd}->{'date_time'};
        push @{ $info->{'reminders'} }, $r;
    }
}

sub _sort_date_reminders {
    my ($date_info) = @_;
    foreach my $ymd (keys %$date_info) {
        my $reminders = $date_info->{$ymd}->{'reminders'};
        foreach my $r (@$reminders) {
            $r->{'date_time'} = $ymd;
            $r->{'date_time'} .= sprintf('T%02d%02d00', $r->{'hour'}, $r->{'minute'})
                unless $r->{'all_day'};
        }
        # Sort reminders within the date
        @$reminders = sort { $a->{'date_time'} cmp $b->{'date_time'} } @$reminders;
    }
}

sub _fill_gaps {
    my ($date_info) = @_;
    my @dates = sort keys %$date_info;
    my $iter = _iter_dates($dates[0], $dates[-1]);
    while (my $dt = $iter->()) {
        if (!exists $date_info->{$dt}) {
            my ($y, $m, $d) = _parse_date($dt);
            my $ymd = _format_date($y, $m, $d);
            $date_info->{$dt} = _norm_reminder({
                'year'      => $y,
                'month'     => $m,
                'day'       => $d,
                'reminders' => [],
            });
            delete $date_info->{$ymd}->{'date_time'};
        }
    }
}

BEGIN {
    # Adapted from Date::ISO8601 by Zefram
    my @days_in_month = (undef, 31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31);
    sub _is_leap_year {
        my ($y) = @_;
        return $y % 4 == 0 && ($y % 100 != 0 || $y % 400 == 0);
    }
    sub _last_day_in_month {
        my ($y, $m) = @_;
        #die unless $m >= 1 && $m <= 12;
        return $m == 2
            ? ( _is_leap_year($y) ? 29 : 28 )
            : $days_in_month[$m];
    }
}

sub _norm_reminder {
    my ($r) = @_;
    my ($y, $m, $d) = @$r{qw(year month day)};
    $r->{'date'} = _format_date($y, $m, $d);
    $r->{'day_of_week'} = dayofweek($d, $m, $y) || 7;  # Sun --> 7, not 0
    if ($r->{'all_day'}) {
        $r->{'date_time'} = $r->{'date'};
    }
    else {
        my ($H, $M, $S) = @$r{qw(hour minute second)};
        $r->{'date_time'} = $r->{'date'} . _format_time($H, $M, $S);
    }
    return $r;
}

sub _norm_date {
    _format_date(_parse_date($_[0]))
}

sub _parse_date {
    my ($dt) = @_;
    $dt =~ m{^(\d\d\d\d)[-/]?(\d\d)[-/]?(\d\d)} or die;
    return ($1, $2, $3);
}

sub _format_date {
    my ($y, $m, $d) = @_;
    return sprintf('%04d%02d%02d', $y, $m, $d);
}

sub _format_time {
    my ($H, $M, $S) = @_;
    return '' unless defined $H;
    return sprintf('T%02d%02d%02d', $H || 0, $M || 0, $S || 0);
}

sub _day_after {
    my ($dt) = @_;
    my ($y, $m, $d) = _parse_date($dt);
    my $n = _last_day_in_month($y, $m);
    if ($d == $n) {
        if ($m == 12) {
            # YYYY-12-31 --> (YYYY+1)-01-01
            $y++;
            $m = 1;
            $d = 1;
        }
        else {
            # YYYY-MM-nn --> YYYY-(MM+1)-01
            $m++;
            $d = 1;
        }
    }
    else {
        # YYYY-MM-DD --> YYYY-MM-(DD+1)
        $d++;
    }
    return _format_date($y, $m, $d);
}

sub _day_before {
    my ($dt) = @_;
    my ($y, $m, $d) = _parse_date($dt);
    if ($d == 1) {
        if ($m == 1) {
            $y--;
            $m = 12;
            $d = 1;
        }
        else {
            $d = _last_day_in_month($y, --$m);
        }
    }
    else {
        $d--;
    }
    return _format_date($y, $m, $d);
}

sub _iter_dates {
    my ($dt1, $dtn) = @_;
    return if $dt1 > $dtn;
    my ($y, $m, $d)    = _parse_date($dt1);
    my ($yn, $mn, $dn) = _parse_date($dtn);
    my $dlim = _last_day_in_month($y, $m);
    return sub {
        my $dt = _format_date($y, $m, $d++);
        return if $dt gt $dtn;
        if ($d > $dlim) {
            $d = 1;
            $m++;
            if ($m > 12) {
                $y++;
                $m = 1;
            }
            $dlim = _last_day_in_month($y, $m);
        }
        return $dt;
    }
}

1;

# vim:fenc=utf-8:et:sw=4:ts=4:sts=4