view release on metacpan or  search on metacpan

lib/Remind/Parser.pm  view on Meta::CPAN

    }, $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'} = _format_date(@reminder{qw(year month day)});
                my ($begin, $end);
                if ($offset eq '*') {
                    # Untimed (whole day) reminder
                    $reminder{'all_day'} = 1;
                }
                else {
                    # Timed reminder
                    my $H = $reminder{'hour'}   = int($offset / 60);
                    my $M = $reminder{'minute'} = $offset % 60;
                    my $S = $reminder{'second'} = 0;
                    if ($duration ne '*') {
                        $reminder{'duration'} = {
                            'hours'   => int($duration / 60),
                            'minutes' => $duration % 60,
                            'seconds' => 0,
                        };
                    }
                }
                push @reminders, _normalize_date(\%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);