view release on metacpan or  search on metacpan

lib/App/JobLog/Log.pm  view on Meta::CPAN

use constant WINDOW   => 30;
use constant LOW_LIM  => 1 / 10;
use constant HIGH_LIM => 1 - LOW_LIM;

# some indices
use constant IO          => 0;
use constant FIRST_EVENT => 1;
use constant LAST_EVENT  => 2;
use constant FIRST_INDEX => 3;
use constant LAST_INDEX  => 4;

# timestamp format
use constant TS => '%Y/%m/%d';


sub new {
    my $class = shift;
    $class = ref $class if ref $class;

    # touch log into existence
    unless ( -e log ) {
        init_file log;
        my $fh = FileHandle->new( log, 'w' );
        $fh->close;
    }

    # using an array to make things a little snappier
    my $self = bless [], $class;
    $self->[IO] = io log;
    return $self;
}


sub lines {
  [ shift->[IO]->getlines ];
}


sub all_taglines {
    my ($self) = @_;

    # reopen log in sequential reading mode
    $self->[IO] = io log;
    my (@lines);
    while ( my $line = $self->[IO]->getline ) {
        my $ll = App::JobLog::Log::Line->parse($line);
        push @lines, $ll if $ll->is_beginning;
    }
    return \@lines;
}


sub all_events {
    my ($self) = @_;

    # reopen log in sequential reading mode
    $self->[IO] = io log;
    my ( @events, $previous );
    while ( my $line = $self->[IO]->getline ) {
        my $ll = App::JobLog::Log::Line->parse($line);
        if ( $ll->is_endpoint ) {
            $previous->end = $ll->time if $previous;
            if ( $ll->is_beginning ) {
                $previous = App::JobLog::Log::Event->new($ll);
                push @events, $previous;
            }
            else {
                $previous = undef;
            }
        }
    }
    return \@events;
}


sub all_notes {
    my ($self) = @_;

    # reopen log in sequential reading mode
    $self->[IO] = io log;
    my @notes;
    while ( my $line = $self->[IO]->getline ) {
        my $ll = App::JobLog::Log::Line->parse($line);
        push @notes, App::JobLog::Log::Note->new($ll) if $ll->is_note;
    }
    return \@notes;
}


sub validate {
    my ($self) = @_;
    my ( $i, $previous_event ) = (0);
    my $errors = 0;
    while ( my $line = $self->[IO][$i] ) {
        my $ll = App::JobLog::Log::Line->parse($line);
        if ( $ll->is_malformed ) {
            $errors++;
            print STDERR "line $i -- '$line' -- is malformed; commenting out\n";
            splice @{ $self->[IO] }, $i, 0,
              App::JobLog::Log::Line->new( comment => 'ERROR; malformed line' );
            $self->[IO][ ++$i ] = $ll->comment_out;
        }
        elsif ( $ll->is_event ) {
            if ($previous_event) {
                if ( DateTime->compare( $previous_event->time, $ll->time ) > 0 )
                {
                    $errors++;
                    print STDERR
"line $i -- '$line' -- is out of order relative to the last event; commenting out\n";
                    splice @{ $self->[IO] }, $i, 0,
                      App::JobLog::Log::Line->new(
                        comment => 'ERROR; dates out of order' );
                    $self->[IO][ ++$i ] = $ll->comment_out;
                }
                elsif ( $previous_event->is_end && $ll->is_end ) {
                    $errors++;
                    print STDERR
"line $i -- '$line' -- specifies the end of a task not yet begun; commenting out\n";
                    splice @{ $self->[IO] }, $i, 0,
                      App::JobLog::Log::Line->new( comment =>
                          'ERROR; task end without corresponding beginning' );
                    $self->[IO][ ++$i ] = $ll->comment_out;
                }
                else {
                    $previous_event = $ll;
                }
            }
            elsif ( $ll->is_end ) {
                $errors++;
                print STDERR
"line $i -- '$line' -- specifies the end of a task not yet begun; commenting out\n";
                splice @{ $self->[IO] }, $i, 0,
                  App::JobLog::Log::Line->new( comment =>
                      'ERROR; task end without corresponding beginning' );
                $self->[IO][ ++$i ] = $ll->comment_out;
            }
            else {
                $previous_event = $ll;
            }
        }
        $i++;
    }
    return $errors;
}


sub first_event {
    my ($self) = @_;
    return $self->[FIRST_EVENT], $self->[FIRST_INDEX] if $self->[FIRST_EVENT];
    my $io = $self->[IO];
    my ( $i, $e ) = 0;
    while ( $i <= $#$io ) {
        my $line = $io->[$i];
        my $ll   = App::JobLog::Log::Line->parse($line);
        if ( $ll->is_endpoint ) {
            if ($e) {
                $e->end = $ll->time;
                last;
            }
            else {
                $e = App::JobLog::Log::Event->new($ll);
                $self->[FIRST_INDEX] = $i;
            }
        }
        $i++;
    }
    $self->[FIRST_EVENT] = $e;
    return $e, $self->[FIRST_INDEX];
}


sub last_ts {
    my ($self) = @_;
    my $io     = $self->[IO];
    my $i      = $#$io;
    for ( ; $i >= 0 ; $i-- ) {
        my $ll = App::JobLog::Log::Line->parse( $io->[$i] );
        return ( $ll->time, $i ) if $ll->is_event;
    }
    return;
}


sub first_ts {
    my ($self) = @_;
    my $io     = $self->[IO];
    my $i      = 0;
    for ( my $lim = $#$io ; $i <= $lim ; $i++ ) {
        my $ll = App::JobLog::Log::Line->parse( $io->[$i] );
        return ( $ll->time, $i ) if $ll->is_event;
    }
    return;
}


sub last_event {
    my ($self) = @_;
    return $self->[LAST_EVENT], $self->[LAST_INDEX] if $self->[LAST_EVENT];
    my $io = $self->[IO];

    # was hoping to use IO::All::backwards for this, but seems to be broken
    # uncertain how to handle utf8 issue with File::ReadBackwards
    my @lines;
    my $i = $#$io;
    for ( ; $i >= 0 ; $i-- ) {
        my $line = $self->[IO][$i];
        my $ll   = App::JobLog::Log::Line->parse($line);
        if ( $ll->is_endpoint ) {
            push @lines, $ll;
            last if $ll->is_beginning;
        }
    }
    return () unless @lines;
    my $e = App::JobLog::Log::Event->new( pop @lines );
    $e->end = $lines[0]->time if @lines;
    $self->[LAST_EVENT] = $e;
    $self->[LAST_INDEX] = $i;
    return $e, $i;
}


sub last_note {
    my ($self) = @_;
    my $io = $self->[IO];
    for ( my $i = $#$io ; $i >= 0 ; $i-- ) {
        my $line = $io->[$i];
        my $ll   = App::JobLog::Log::Line->parse($line);
        return ( App::JobLog::Log::Note->new($ll), $i ) if $ll->is_note;
    }
    return ();
}


sub reverse_iterator {
    my ( $self, $event ) = @_;
    if ( ref $event ) {
        if ( $event->isa('DateTime') ) {
            my $events =
              $self->find_events( $event, $self->first_event->start );
            if (@$events) {
                $event = $events->[$#$events];
            }
            else {
                $event = undef;
            }
        }
    }
    else {
        ($event) = $self->last_event;
    }
    return sub { }
      unless $event;
    my ( undef, $index, $io ) =
      ( $self->find_previous( $event->start ), $self->[IO] );
    return sub {
        return () unless $event;
        my $e        = $event;
        my $end_time = $event->start;
        $event = undef;
        while ( --$index >= 0 ) {
            my $line = $io->[$index];
            my $ll   = App::JobLog::Log::Line->parse($line);
            if ( $ll->is_beginning ) {
                $event = App::JobLog::Log::Event->new($ll);
                $event->end = $end_time;
                last;
            }
            elsif ( $ll->is_end ) {
                $end_time = $ll->time;
            }
        }
        return $e;
    };
}


sub find_events {
    my ( $self, $start, $end ) = @_;
    my $io = $self->[IO];
    my ( $end_event, $bottom, $start_event, $top ) =
      ( $self->last_event, $self->first_event );

    # if the log is empty, return empty list
    return [] unless $start_event && $end_event;

    # if the log concerns events before the time in question, return empty list
    return []
      unless $end_event->is_open
          || DateTime->compare( $start, $end_event->end ) < 0;

    # likewise if it concerns events after
    return [] if DateTime->compare( $start_event->start, $end ) > 0;

    # narrow time range to that in log
    my $c1 = DateTime->compare( $start, $start_event->start ) <= 0;
    my $c2 =
      $end_event->is_open
      ? DateTime->compare( $end, $end_event->start ) >= 0
      : DateTime->compare( $end, $end_event->end ) >= 0;
    return $self->all_events if $c1 && $c2;
    $start = $start_event->start if $c1;
    $end   = $end_event->end     if $c2;

    # matters are simple if what we want is at the start of the log
    if ($c1) {
        my ( $line, $previous, @events );
        while ( my $line = $io->getline ) {
            chomp $line;
            my $ll = App::JobLog::Log::Line->parse($line);
            if ( $ll->is_endpoint ) {
                if ( DateTime->compare( $ll->time, $end ) >= 0 ) {
                    $previous->end = $end if $previous->is_open;
                    last;
                }
                if ( $previous && $previous->is_open ) {
                    $previous->end = $ll->time;
                }
                if ( $ll->is_beginning ) {
                    $previous = App::JobLog::Log::Event->new($ll);
                    push @events, $previous;
                }
            }
        }
        return \@events;
    }

    # matters are likewise simple if what we want is at the end of the log
    if ($c2) {

        # must restart io
        $io = $self->[IO] = io log;
        $io->backwards;
        my ( $line, $previous, @events );
        while ( my $line = $io->getline ) {
            chomp $line;
            my $ll = App::JobLog::Log::Line->parse($line);
            if ( $ll->is_endpoint ) {
                my $e;
                if ( $ll->is_beginning ) {
                    $e = App::JobLog::Log::Event->new($ll);
                    $e->end = $previous->time if $previous;
                    unshift @events, $e;
                }
                if ( DateTime->compare( $ll->time, $start ) <= 0 ) {
                    $e->start = $start if $e;
                    last;
                }
                $previous = $ll;
            }
        }
        return \@events;
    }

    # otherwise, do binary search for first event in range
    my ( undef, $i ) = $self->find_previous($start);
    return $self->_scan_from( $i, $start, $end );
}


sub find_notes {
    my ( $self, $start, $end ) = @_;
    my $io = $self->[IO];
    my ( $end_time, $bottom, $start_time, $top ) =
      ( $self->last_ts, $self->first_ts );

    # if the log is empty, return empty list
    return [] unless $start_time && $end_time;

    # if the log concerns events before the time in question, return empty list
    return []
      unless DateTime->compare( $start, $end_time ) <= 0;

    # likewise if it concerns events after
    return [] if DateTime->compare( $start_time, $end ) > 0;

    # narrow time range to that in log
    my $c1 = DateTime->compare( $start, $start_time ) <= 0;
    my $c2 = DateTime->compare( $end,   $end_time ) >= 0;
    return $self->all_notes if $c1 && $c2;
    $start = $start_time if $c1;
    $end   = $end_time   if $c2;

    # matters are simple if what we want is at the start of the log
    if ($c1) {
        my ( $line, @notes );
        while ( my $line = $io->getline ) {
            chomp $line;
            my $ll = App::JobLog::Log::Line->parse($line);
            if ( $ll->is_event ) {
                if ( DateTime->compare( $ll->time, $end ) >= 0 ) {
                    last;
                }
                push @notes, App::JobLog::Log::Note->new($ll) if $ll->is_note;
            }
        }
        return \@notes;
    }

lib/App/JobLog/Log.pm  view on Meta::CPAN

        }
    }
}


sub _find_previous_note {
    my ( $self, $e, $eb, $bottom, $et, $top ) = @_;
    my $io = $self->[IO];

    # binary search for first note in range
    my $previous_index;
  OUTER: while (1) {
        return $self->_scan_for_previous_note( $top, $e )
          if $bottom - $top + 1 <= WINDOW / 2;
        my $index = _estimate_index( $top, $bottom, $et, $eb, $e );
        if ( defined $previous_index && $previous_index == $index ) {

            # search was too clever by half; we've entered an infinite loop
            return $self->_scan_for_previous_note( $top, $e );
        }
        $previous_index = $index;
        my $event;
        for my $i ( $index .. $#$io ) {
            my $line = $io->[$i];
            my $ll   = App::JobLog::Log::Line->parse($line);
            if ( $ll->is_event ) {
                for ( DateTime->compare( $ll->time, $e ) ) {
                    when ( $_ < 0 ) {
                        $top = $i;
                        $et  = $ll->time;
                        next OUTER;
                    }
                    when ( $_ > 0 ) {
                        $bottom = $i;
                        $eb     = $ll->time;
                        next OUTER;
                    }
                    default {

                        # found beginning!!
                        # this should happen essentially never
                        return $self->_scan_for_previous_note( $i, $e );
                    }
                }
            }
        }
    }
}

# now that we're close to the section of the log we want, we
# scan it sequentially
sub _scan_from {
    my ( $self, $i, $start, $end ) = @_;
    my $io = $self->[IO];

    # collect events
    my ( $previous, @events );
    for my $index ( $i .. $#$io ) {
        my $line = $io->[$index];
        my $ll   = App::JobLog::Log::Line->parse($line);
        if ( $ll->is_endpoint ) {
            if ($previous) {
                $previous->end = $ll->time if $previous->is_open;
                push @events, $previous
                  if DateTime->compare( $start, $previous->end ) < 0;
            }
            if ( $ll->is_beginning ) {
                last if DateTime->compare( $ll->time, $end ) >= 0;
                $previous = App::JobLog::Log::Event->new($ll);
            }
            else {
                $previous = undef;
            }
        }
    }
    push @events, $previous
      if $previous
          && $previous->is_open
          && DateTime->compare( $previous->start, $end ) < 0;

    # return only overlap
    my @return = map { $_->overlap( $start, $end ) } @events;
    return \@return;
}

sub _scan_for_note_from {
    my ( $self, $i, $start, $end ) = @_;
    my $io = $self->[IO];

    # collect notes
    my @notes;
    for my $index ( $i .. $#$io ) {
        my $line = $io->[$index];
        my $ll   = App::JobLog::Log::Line->parse($line);
        if ( $ll->is_event ) {
            last if $ll->time > $end;
            if ( $ll->is_note && $ll->time >= $start ) {
                push @notes, App::JobLog::Log::Note->new($ll);
            }
        }
    }
    return \@notes;
}

sub _scan_for_previous {
    my ( $self, $i, $e ) = @_;
    my $io = $self->[IO];

    # collect events
    my ( $previous, $previous_index );
  OUTER: {
        for my $index ( $i .. $#$io ) {
            my $line = $io->[$index];
            my $ll   = App::JobLog::Log::Line->parse($line);
            if ( $ll->is_endpoint ) {
                $previous->end = $ll->time if $previous && $previous->is_open;
                if ( $ll->time > $e ) {
                    last if $previous;
                    $i--;
                    redo OUTER;
                }
                if ( $ll->is_beginning ) {
                    $previous       = App::JobLog::Log::Event->new($ll);
                    $previous_index = $index;
                }
            }
        }
    }
    return $previous, $previous_index;
}

sub _scan_for_previous_note {
    my ( $self, $i, $e ) = @_;
    my $io = $self->[IO];

    # collect events
    my ( $previous, $previous_index );
    for my $index ( $i .. $#$io ) {
        my $line = $io->[$index];
        my $ll   = App::JobLog::Log::Line->parse($line);
        if ( $ll->is_event ) {
            last if $ll->time > $e;
            if ( $ll->is_note ) {
                $previous       = App::JobLog::Log::Note->new($ll);
                $previous_index = $index;
            }
        }
    }
    return $previous_index // $i;
}

# your generic O(log_n) complexity bisecting search
sub _estimate_index {
    my ( $top, $bottom, $et, $eb, $s ) = @_;
    my $delta = $bottom - $top + 1;
    my $i;
    if ( $delta > WINDOW ) {
        my $d1       = $s->epoch - $et->epoch;
        my $d2       = $eb->epoch - $et->epoch;
        my $fraction = $d1 / $d2;
        if ( $fraction < LOW_LIM ) {
            $fraction = LOW_LIM;
        }
        elsif ( $fraction > HIGH_LIM ) {
            $fraction = HIGH_LIM;
        }
        $i = sprintf '%.0f', $delta * $fraction;
    }
    else {
        $i = sprintf '%.0f', $delta / 2;
    }
    $i ||= 1;
    return $top + $i;
}