App-JobLog
view release on metacpan or search on metacpan
* fixed --columns option of summary command
1.014 2011-03-20 05:15:15 America/New_York
* fixed more empty log bugs
1.013 2011-03-19 20:37:32 America/New_York
* more monkeying with dist.ini to get the dependencies to list in the right order
* fixed empty log bug in summary command
1.012 2011-03-19 14:18:26 America/New_York
* added error handling for time zones unfamiliar to DateTime::TimeZone
* made sure time zones were handled uniformly throughout application
* added undiscovered File::HomeDir prerequisite
* added Module::Build prerequisite so install will succeed on a clean Ubuntu box
* fixed empty log bug in add command
1.011 2011-03-16 05:44:21 America/New_York
* cosmetic changes to info command
* further improvement to perldocs
* added time zone configuration parameter with Cygwin test so the Cygwin smoke test will pass
1.010 2011-03-15 17:26:53 America/New_York
* fixed "last/this week" bug due to DateTime choosing Monday as first day in week
* fixed edit command so checksums are calculated correctly and backup is only saved in case of change
* fixed TimeGrammar; "jan 1 - 10" and such are properly handled
* fixed TimeGrammar; '2010' and such are properly handled
* fixed bug caused by end of month wrapping in DateTime
* changing the options for the info command so minimal information is returned by default
* improved text wrapping of full description for commands
* finished text of info command
1.009 2011-03-13 15:14:27 America/New_York
* changed date format code to show year if span in question stretches over more than one year
* unrolled slow loop in summary after Devel::NYTProf profiling
1.007 2011-03-12 12:32:32 America/New_York
* added File::ReadBackwards prerequisite to dist.ini
version: '1.4'
name: App-JobLog
no_index:
file:
- t/make_log.pl
requires:
App::Cmd::Setup: '0'
Carp: '0'
Class::Autouse: '0'
Config::Tiny: '0'
DateTime: '0.66'
DateTime::TimeZone: '1.30'
Exporter: '0'
File::HomeDir: '0'
File::Path: '2.06'
File::ReadBackwards: '0'
FileHandle: '0'
IO::All: '0'
Modern::Perl: '0'
Module::Build: '0.3601'
Term::ReadKey: '2.30'
Text::Wrap: '0'
Makefile.PL view on Meta::CPAN
"bin/job"
],
"LICENSE" => "perl",
"MIN_PERL_VERSION" => "5.006",
"NAME" => "App::JobLog",
"PREREQ_PM" => {
"App::Cmd::Setup" => 0,
"Carp" => 0,
"Class::Autouse" => 0,
"Config::Tiny" => 0,
"DateTime" => "0.66",
"DateTime::TimeZone" => "1.30",
"Exporter" => 0,
"File::HomeDir" => 0,
"File::Path" => "2.06",
"File::ReadBackwards" => 0,
"FileHandle" => 0,
"IO::All" => 0,
"Modern::Perl" => 0,
"Module::Build" => "0.3601",
"Term::ReadKey" => "2.30",
"Text::Wrap" => 0,
Makefile.PL view on Meta::CPAN
);
my %FallbackPrereqs = (
"App::Cmd::Setup" => 0,
"App::Cmd::Tester" => 0,
"Capture::Tiny" => 0,
"Carp" => 0,
"Class::Autouse" => 0,
"Config::Tiny" => 0,
"DateTime" => "0.66",
"DateTime::TimeZone" => "1.30",
"Exporter" => 0,
"ExtUtils::MakeMaker" => 0,
"File::HomeDir" => 0,
"File::Path" => "2.06",
"File::ReadBackwards" => 0,
"File::Spec" => 0,
"File::Temp" => 0,
"FileHandle" => 0,
"IO::All" => 0,
"IO::Handle" => 0,
filename = Changelog
[PruneCruft]
[PkgVersion]
[Test::Compile]
[Prereqs]
Config::Tiny = 0
File::ReadBackwards = 0
File::Path = 2.06
File::HomeDir = 0
Module::Build = 0.3601
DateTime = 0.66
DateTime::TimeZone = 1.30
Term::ReadKey = 2.30
[AutoPrereqs]
[PodWeaver]
[Git::Tag]
[MetaNoIndex]
file = t/make_log.pl
[ExecDir]
dir = bin
[Test::ReportPrereqs]
lib/App/JobLog.pm view on Meta::CPAN
will only be interested in the most recent ones. Even when we don't just want the most recent events we
don't need truly random access to the whole log but an interval -- all the lines from one point to another.
We only need a slightly glorified log. A database is overkill. Finally, as soon as we maintain our data in
a database it becomes an opaque blob and our editing interface becomes much more complicated to
write, use, and maintain. We need to write a shell, GUI, or ncurses interface and figure out how to provide
the editor with search facilities, the context in which she is making edits, and perhaps an undo/redo stack.
If it's a text file we just pop up an editor and validate the log on close. So I stuck with a log.
=head1 ACKNOWLEDGEMENTS
Thanks to Ricardo Signes for the redoubtable L<App::Cmd> which wires this all together, Dave Rolsky for L<DateTime>,
which does all the calendar math, and Ingy dE<ouml>t Net for L<IO::All>, which, via L<Tie::File> (thanks, Mark Jason
Dominus), makes random access to a log file trivial.
Thanks also to my wife Paula, who was my only beta tester other than myself.
=head1 SEE ALSO
L<App::Cmd>, L<DateTime>, L<IO::All>
=head1 AUTHOR
David F. Houghton <dfhoughton@gmail.com>
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2011 by David F. Houghton.
This is free software; you can redistribute it and/or modify it under
lib/App/JobLog/Command/configure.pm view on Meta::CPAN
my %booleans = map { $_ => 1 } qw(
sunday_begins_week
);
my ( $l1, $l2, %h ) = ( 0, 0 );
for my $method (@params) {
my $l = length $method;
my $value = eval "App::JobLog::Config::$method()";
$value = $value ? 'true' : 'false' if $booleans{$method};
$value = 'not defined' unless defined $value;
$value = $value->strftime('%F') if ref $value eq 'DateTime';
$l1 = $l if $l > $l1;
$l = length $value;
$l2 = $l if $l > $l2;
$h{$method} = $value;
}
my $format = '%-' . $l1 . 's %' . $l2 . "s\n";
for my $method (@params) {
my $value = $h{$method};
$method =~ s/_/ /g;
printf $format, $method, $value;
lib/App/JobLog/Command/configure.pm view on Meta::CPAN
}
else {
$found_something ||= 1;
}
}
$self->usage_error(
"you have specified that something should be hidden and that nothing should be hidden"
) if $found_none && $found_something;
}
if ( defined $opt->time_zone ) {
require DateTime::TimeZone;
eval { DateTime::TimeZone->new( name => $opt->time_zone ) };
$self->usage_error(
'DateTime::TimeZone does not like the time zone name '
. $opt->time_zone
. "\n$@" )
if $@;
}
}
1;
__END__
lib/App/JobLog/Command/configure.pm view on Meta::CPAN
This parameter specifies the number of digits appearing after the decimal point in the reported duration of events.
=item start pay period
In order to calculate the beginnings and ends of pay periods, and hence how many hours one has left to work
in a particular pay period, for instance, one needs to know both their length generally and the beginning
of some particular pay period. This parameter supplies the latter.
=item sunday begins week
L<App::JobLog> uses L<DateTime> for all calendar math. L<DateTime> regards Monday as the first day of the week.
Another convention is to regard Sunday as the first day of the week. This is significant because it changes the
meaning of phrases such as I<this week> and I<March 1 until the end of the week>. Use this parameter to choose
your preferred interpretation of such phrases.
=item time zone
This is the time zone used for converting the system time to the time of the day. Most likely you will not need
to set this parameter, but go here if your times look funny.
=item workdays
lib/App/JobLog/Config.pm view on Meta::CPAN
# default precision
use constant PRECISION => 2;
# default pay period
use constant PERIOD => 14;
# hours worked in day
use constant HOURS => 8;
# whether Sunday is the first day of the week
# otherwise it's Monday, as in DateTime
use constant SUNDAY_BEGINS_WEEK => 1;
# environment variables
# identifies directory to write files into
use constant DIRECTORY => 'JOB_LOG_DIRECTORY';
# expected abbreviations for working days in week
use constant WORKDAYS => 'MTWHF';
lib/App/JobLog/Config.pm view on Meta::CPAN
sub sunday_begins_week {
my ($value) = @_;
return _param( 'sunday-begins-week', SUNDAY_BEGINS_WEEK, 'time', $value );
}
sub start_pay_period {
my ($value) = @_;
require DateTime;
if ( ref $value eq 'DateTime' ) {
$value = sprintf '%d %d %d', $value->year, $value->month, $value->day;
}
$value = _param( 'start-pay-period', undef, 'time', $value );
if ($value) {
my @parts = split / /, $value;
return DateTime->new(
year => $parts[0],
month => $parts[1],
day => $parts[2],
time_zone => _tz(),
);
}
return;
}
# abstracts out code for maintaining config file
lib/App/JobLog/Config.pm view on Meta::CPAN
my %workdays;
sub is_workday {
my ($date) = @_;
# initialize map
unless (%workdays) {
my @days = split //, DAYS;
# move Sunday into DateTime's expected position
push @days, shift @days;
my %day_map;
for ( 0 .. $#days ) {
$day_map{ $days[$_] } = $_ + 1;
}
for ( split //, workdays() ) {
$workdays{ $day_map{$_} } = 1;
}
}
return $workdays{ $date->day_of_week };
lib/App/JobLog/Config.pm view on Meta::CPAN
sub time_zone {
my ($value) = @_;
return _param( 'time_zone', TIME_ZONE, 'time', $value );
}
our $tz;
# removed from App::JobLog::Time to prevent dependency cycle
sub _tz {
if ( !defined $tz ) {
require DateTime::TimeZone;
eval { $tz = DateTime::TimeZone->new( name => time_zone() ) };
if ($@) {
print STDERR 'DateTime::TimeZone doesn\'t like the time zone '
. time_zone()
. "\nreverting to floating time\n full error: $@";
$tz = DateTime::TimeZone->new( name => 'floating' );
}
}
return $tz;
}
1;
__END__
=pod
lib/App/JobLog/Config.pm view on Meta::CPAN
The number of hours one is expected to work in a day.
=head2 pay_period_length
The number of days between paychecks.
=head2 sunday_begins_week
Whether to regard Sunday or Monday as the first day in the week
when interpreting time expressions such as 'last week'. L<DateTime>
uses Monday. The default for L<App::JobLog> is Sunday. For the purposes
of calculating hours worked this will make no difference for most people.
=head2 start_pay_period
Returns DateTime representing start date of pay period or null if none is defined.
=head2 editor
Log editing program.
=head2 columns
The number of columns available in the terminal. This defaults to
76 when L<Term::ReadKey> is unable to determine terminal width.
=head2 workdays
The days of the week when one expects to be working.
=head2 is_workday
Returns whether a particular L<DateTime> object represents a workday.
=head2 hidden_columns
Returns those columns never displayed by summary command.
=head2 is_hidden
Whether a particular column is among those hidden.
=head2 time_zone
lib/App/JobLog/Log.pm view on Meta::CPAN
use Modern::Perl;
use App::JobLog::Config qw(log init_file);
use App::JobLog::Log::Line;
use IO::All -utf8;
use autouse 'Carp' => qw(carp);
use autouse 'App::JobLog::Time' => qw(now);
use Class::Autouse qw(
App::JobLog::Log::Event
App::JobLog::Log::Note
DateTime
FileHandle
);
no if $] >= 5.018, warnings => "experimental::smartmatch";
# some stuff useful for searching log
use constant WINDOW => 30;
use constant LOW_LIM => 1 / 10;
use constant HIGH_LIM => 1 - LOW_LIM;
# some indices
lib/App/JobLog/Log.pm view on Meta::CPAN
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 ) {
lib/App/JobLog/Log.pm view on Meta::CPAN
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;
}
}
}
lib/App/JobLog/Log.pm view on Meta::CPAN
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;
}
lib/App/JobLog/Log.pm view on Meta::CPAN
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
lib/App/JobLog/Log.pm view on Meta::CPAN
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;
}
# 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, @notes );
while ( my $line = $io->getline ) {
chomp $line;
my $ll = App::JobLog::Log::Line->parse($line);
if ( $ll->is_event ) {
$c2 = DateTime->compare( $ll->time, $start );
last if $c2 < 0;
unshift @notes, App::JobLog::Log::Note->new($ll)
if $ll->is_note;
last unless $c2;
}
}
return \@notes;
}
# otherwise, do binary search for first note in range
lib/App/JobLog/Log.pm view on Meta::CPAN
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 start time (improbably but fortuitously) happens to be what we're
# looking for, return it
return ( $start_event, $top )
if DateTime->compare( $start_event->start, $e ) == 0;
# likewise for the end time
return ( $end_event, $bottom ) if $end_event->start < $e;
# return the empty list if the event in question precede the first
# event in the log
return () unless $start_event->start < $e;
# otherwise, do binary search for first event in range
my ( $et, $eb ) = ( $start_event->start, $end_event->start );
lib/App/JobLog/Log.pm view on Meta::CPAN
# search was too clever by half; we've entered an infinite loop
return $self->_scan_for_previous( $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_beginning ) {
my $do_next = 1;
for ( DateTime->compare( $ll->time, $e ) ) {
when ( $_ < 0 ) {
$top = $i;
$et = $ll->time;
}
when ( $_ > 0 ) {
$bottom = $i;
$eb = $ll->time;
}
default {
lib/App/JobLog/Log.pm view on Meta::CPAN
# 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;
}
lib/App/JobLog/Log.pm view on Meta::CPAN
# 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];
lib/App/JobLog/Log.pm view on Meta::CPAN
my ($last_ts) = $self->last_ts;
if ( !$last_ts || _different_day( $last_ts, $note->time ) ) {
$io->append(
App::JobLog::Log::Line->new( comment => $note->time->strftime(TS) )
)->append("\n");
}
$io->append($note)->append("\n");
$io->close; # flush contents
}
# a test to determine whether two DateTime objects
# represent different days
sub _different_day {
my ( $d1, $d2 ) = @_;
return !( $d1->day == $d2->day
&& $d1->month == $d2->month
&& $d1->year == $d2->year );
}
sub close {
lib/App/JobLog/Log.pm view on Meta::CPAN
are commented out and a warning is emitted. The number of errors found is
returned.
=head2 first_event
C<first_event> returns the first event in the log and the index
of its line. Its return object is an L<App::JobLog::Log::Event>.
=head2 last_ts
Returns last L<DateTime> timestamp in log and the index of this timestamp.
=head2 first_ts
Returns first L<DateTime> timestamp in log.
=head2 last_event
C<last_event> returns the last event in the log and the index
of its line. Its return object is an L<App::JobLog::Log::Event>.
=head2 last_note
Returns most recent note in log and its index, or the empty list if none is found.
=head2 reverse_iterator
C<reverse_iterator> returns a closure that allows you to iterate
over the events in the log in reverse. Every time you call the closure
it returns the next unvisited event.
If you pass this method an optional argument, either a L<DateTime> or a
L<App::JobLog::Log::Event>, it will iterate from the event beginning at or
after this event or time.
=head2 find_events
C<find_events> expects two L<DateTime> objects representing the
termini of an interval. It returns an array reference containing
the portion of all logged events falling within this interval. These
portions are represented as L<App::JobLog::Log::Event> objects.
=head2 find_notes
C<find_notes> expects two L<DateTime> objects representing the
termini of an interval. It returns an array reference containing
the portion of all logged notes falling within this interval. These
portions are represented as L<App::JobLog::Log::Note> objects.
=head2 find_previous
C<find_previous> looks for the logged event previous to a given
moment, returning the L<App::JobLog::Log::Event> objects and the
appropriate log line number, or the empty list if no such
event exists. It expects a L<DateTime> object as its parameter.
=head2 find_previous
C<find_previous> looks for the logged event previous to a given
moment, returning the L<App::JobLog::Log::Event> objects and the
appropriate log line number, or the empty list if no such
event exists. It expects a L<DateTime> object as its parameter.
=head2 append_event
C<append_event> expects an array of event properties. It constructs an event
object and appends its stringification to the log, returning a L<DateTime::Duration>
object if the previous event was left open and spanned more than one day.
=head2 append_note
Takes a description and a set of tags and appends it to the log as a note with the
current timestamp.
=head2 close
C<close> closes the L<IO::All> object, if it exists and is open, forcing
lib/App/JobLog/Log/Event.pm view on Meta::CPAN
package App::JobLog::Log::Event;
$App::JobLog::Log::Event::VERSION = '1.042';
# ABSTRACT: basically adds an end time to App::JobLog::Log::Line events
use parent qw(App::JobLog::Log::Note);
use Modern::Perl;
use Class::Autouse qw{DateTime};
use autouse 'App::JobLog::Time' => qw(now);
use autouse 'Carp' => qw(carp);
# for debugging
use overload '""' => sub {
$_[0]->data->to_string . '-->'
. ( $_[0]->is_closed ? $_[0]->end : 'ongoing' );
};
lib/App/JobLog/Log/Event.pm view on Meta::CPAN
my $clone = $self->new( $self->data->clone );
$clone->end = $self->end->clone unless $self->is_open;
return $clone;
}
sub overlap {
my ( $self, $start, $end ) = @_;
# if this falls entirely within interval, return this
my $c1 = DateTime->compare( $start, $self->start ) || 0;
my $c2 = DateTime->compare( $end, $self->end ) || 0;
if ( $c1 <= 0 && $c2 >= 0 ) {
return $self;
}
return if $self->start >= $end || $start >= $self->end;
my $s = $c1 < 0 ? $self->start : $start;
my $e = $c2 < 0 ? $end : $self->end;
my $clone = $self->clone;
$clone->start = $s;
$clone->end = $e;
return $clone;
lib/App/JobLog/Log/Event.pm view on Meta::CPAN
}
sub cmp {
my ( $self, $other ) = @_;
my $comparison = $self->SUPER::cmp($other);
unless ($comparison) {
if ( $other->isa(__PACKAGE__) ) {
if ( $self->is_closed ) {
if ( $other->is_closed ) {
return DateTime->compare( $self->end, $other->end );
}
else {
return 1;
}
}
elsif ( $other->is_closed ) {
return -1;
}
else {
return 0;
lib/App/JobLog/Log/Event.pm view on Meta::CPAN
handle the properties of intervals of time as distinct from points.
=head1 METHODS
=head2 clone
Create a duplicate of this event.
=head2 overlap
Expects two L<DateTime> objects as arguments. Returns the portion of this event
overlapping the interval so defined.
=head2 end
End of event. Is lvalue method.
=head2 cmp
Used to sort events. E.g.,
lib/App/JobLog/Log/Line.pm view on Meta::CPAN
package App::JobLog::Log::Line;
$App::JobLog::Log::Line::VERSION = '1.042';
# ABSTRACT: encapsulates one line of log text
use Modern::Perl;
use Class::Autouse qw{DateTime};
use autouse 'App::JobLog::Time' => qw(now tz);
# represents a single non-comment line in the log
# not using Moose to keep CLI snappy
# to_string method for convenience
use overload '""' => \&to_string;
use overload 'bool' => sub { 1 };
# some global variables for use in BNF regex
lib/App/JobLog/Log/Line.pm view on Meta::CPAN
# validate %opts
my $self = bless {}, $class;
if ( exists $opts{comment} ) {
$self->{comment} = $opts{comment};
delete $opts{comment};
die 'inconsistent arguments: ' . join( ', ', @args ) if keys %opts;
}
elsif ( exists $opts{done} ) {
my $time = $opts{time};
die "invalid value for time: $time"
if $time && ref $time ne 'DateTime';
$self->{time} = $time || now;
$self->{done} = 1;
delete $opts{done};
delete $opts{time};
die 'inconsistent arguments: ' . join( ', ', @args ) if keys %opts;
}
elsif ( exists $opts{time} ) {
my $time = $opts{time};
die "invalid value for time: $time"
if $time && ref $time ne 'DateTime';
$self->{time} = $time;
my $tags = $opts{tags};
die 'invalid value for tags: ' . $tags
if defined $tags && ref $tags ne 'ARRAY';
unless ($tags) {
$tags = [];
$self->{tags_unspecified} = 1;
}
$self->{tags} = $tags;
my $description = $opts{description};
lib/App/JobLog/Log/Line.pm view on Meta::CPAN
delete $obj->{text};
}
return $obj;
}
local ( $date, @tags, @description, $is_beginning, $is_note );
if ( $text =~ $re ) {
# must use to_string to obtain text
delete $obj->{text};
my @time = split /\s++/, $date;
$date = DateTime->new(
year => $time[0],
month => $time[1],
day => $time[2],
hour => $time[3],
minute => $time[4],
second => $time[5],
time_zone => tz,
);
$obj->{time} = $date;
if ($is_beginning) {
lib/App/JobLog/Log/Line.pm view on Meta::CPAN
Produces an object semantically identical to that on which it was invoked but
stored without shared references so changes to the latter will not effect the former.
=head2 to_string
Serializes object to the string that would represent it in a log.
=head2 time_stamp
Represents optional L<DateTime> object in the format used in the log. If no
argument is provided, the timestamp of the line itself is returned.
=head2 text
Accessor to text attribute of line, if any. Should only be defined for well formed
log lines. Is lvalue.
=head2 tags
Accessor to array reference containing tags, if any. Is lvalue.
lib/App/JobLog/Log/Note.pm view on Meta::CPAN
package App::JobLog::Log::Note;
$App::JobLog::Log::Note::VERSION = '1.042';
# ABSTRACT: timestamped annotation in log
use Modern::Perl;
use Class::Autouse qw{DateTime};
use autouse 'App::JobLog::Time' => qw(now);
use autouse 'Carp' => qw(carp);
# for debugging
use overload '""' => sub {
$_[0]->data->to_string;
};
use overload 'bool' => sub { 1 };
lib/App/JobLog/Log/Note.pm view on Meta::CPAN
sub cmp {
my ( $self, $other ) = @_;
carp 'argument must also be time' unless $other->isa(__PACKAGE__);
# defer to subclass sort order if other is a subclass and self isn't
return -$other->cmp($self)
if ref $self eq __PACKAGE__ && ref $other ne __PACKAGE__;
return DateTime->compare( $self->start, $other->start );
}
sub split_days {
return $_[0];
}
sub intersects {
my ( $self, $other ) = @_;
lib/App/JobLog/Log/Synopsis.pm view on Meta::CPAN
MERGE_SAME_DAY
MERGE_SAME_DAY_SAME_TAGS
MERGE_NONE
)
]
);
use Modern::Perl;
use autouse 'Carp' => qw(carp);
use autouse 'App::JobLog::Time' => qw(now);
use Class::Autouse qw(DateTime);
no if $] >= 5.018, warnings => "experimental::smartmatch";
use constant MERGE_ALL => 1;
use constant MERGE_ADJACENT => 2;
use constant MERGE_ADJACENT_SAME_TAGS => 3;
use constant MERGE_SAME_TAGS => 4;
use constant MERGE_SAME_DAY => 5;
use constant MERGE_SAME_DAY_SAME_TAGS => 6;
use constant MERGE_NONE => 0;
lib/App/JobLog/Log/Synopsis.pm view on Meta::CPAN
&& $d1->month == $d2->month
&& $d1->year == $d2->year;
}
# whether given event is immediately adjacent to last event in synopsis
sub adjacent {
my ( $self, $event ) = @_;
return 1 if !$event->can('end'); # notes are always considered adjacent
my $d1 = ( $self->events )[-1]->end || now;
my $d2 = $event->start;
return DateTime->compare( $d1, $d2 ) == 0;
}
# add an event to the events described
sub merge { push @{ $_[0]{events} }, $_[1] }
sub date { $_[0]->{events}[0]->start }
sub description {
lib/App/JobLog/Log/Synopsis.pm view on Meta::CPAN
=head2 collect
Only exported function of B<App::JobLog::Log::Synopsis>, C<collect> exects a reference
to a L<App::JobLog::Log::Day> and a merge level. It then generates all the synopses
appropriate to the given level in the given day, storing these in the day under the
key C<synopses>.
=head2 date
L<DateTime> object representing first moment in first event in synopsis.
=head2 description
Returns unformatted string containing all unique descriptions
in events described, listing them in the order in which they
appeared and separating distinct events with semicolons when they
end in a word character.
=head2 tags
lib/App/JobLog/Time.pm view on Meta::CPAN
use Exporter 'import';
our @EXPORT_OK = qw(
now
today
tz
);
use Modern::Perl;
use DateTime;
use DateTime::TimeZone;
use App::JobLog::Config qw(_tz);
# cached values
our ( $today, $now );
sub now {
$now //= DateTime->now( time_zone => tz() );
return $now->clone;
}
sub today {
$today //= now()->truncate( to => 'day' );
return $today->clone;
}
lib/App/JobLog/TimeGrammar.pm view on Meta::CPAN
# ABSTRACT: parse natural (English) language time expressions
use Exporter 'import';
our @EXPORT = qw(
parse
daytime
);
use Modern::Perl;
use DateTime;
use Class::Autouse qw(
App::JobLog::Log
);
use Carp 'croak';
use autouse 'App::JobLog::Config' => qw(
log
sunday_begins_week
pay_period_length
start_pay_period
DIRECTORY
lib/App/JobLog/TimeGrammar.pm view on Meta::CPAN
if ( is_fixed($h1) ) {
( $h1, $h2 ) = fixed_start( $h1, $h2, $count == 2 );
}
elsif ( is_fixed($h2) ) {
( $h1, $h2 ) = fixed_end( $h1, $h2 );
}
else {
( $h1, $h2 ) = before_now( $h1, $h2, $count == 2 );
}
croak "dates in \"$phrase\" are out of order"
unless DateTime->compare( $h1, $h2 ) <= 0;
$h1->set(%t1);
$h2->set(%t2);
if ( $h1 > $h2 ) {
if ( $h1->year == $h2->year
&& $h1->month == $h2->month
&& $h1->day == $h2->day
&& $h2->hour < 12
&& $s2 eq 'x' )
{
lib/App/JobLog/TimeGrammar.pm view on Meta::CPAN
# produces interpretation of date expression consistent with a fixed end date
sub fixed_end {
my ( $h1, $h2 ) = @_;
$h2 = fix_date($h2);
if ( is_fixed($h1) ) {
$h1 = fix_date( $h1, 1 );
}
else {
my ( $unit, $amt ) = time_unit($h1);
$h1 = decontextualized_date( $h1, 1 );
if ( ref $h1 eq 'DateTime' ) {
while ( DateTime->compare( $h1, $h2 ) > 0 ) {
$h1->subtract( $unit => $amt );
}
}
else {
# we just have a floating weekday
$h1 = adjust_weekday( $h1, $h2 );
}
}
return ( $h1, $h2 );
lib/App/JobLog/TimeGrammar.pm view on Meta::CPAN
unless ( $two_endpoints || $h2->{type} ne 'numeric' ) {
return $h1, $h1->clone if defined $h2->{day};
return $h1, $h1->clone->add( years => 1 )->subtract( days => 1 );
}
if ( is_fixed($h2) ) {
$h2 = fix_date($h2);
}
else {
my ( $unit, $amt ) = time_unit($h2);
$h2 = decontextualized_date($h2);
$h2 = adjust_weekday( $h2, $h1 ) unless ref $h2 eq 'DateTime';
$h2->subtract( $unit => $amt ) while $h2 > $h1;
$h2->add( $unit => $amt );
}
return ( $h1, $h2 );
}
# date relative to now not yet adjusted relative to its position in the span or
# another fixed date
sub decontextualized_date {
my ( $h, $is_start ) = @_;
lib/App/JobLog/TimeGrammar.pm view on Meta::CPAN
}
sub decontextualized_numeric_date {
my ( $h, $is_start ) = @_;
my $date = today;
delete $h->{type};
delete $h->{modifier};
$h->{year} //= $date->year;
$h->{month} //= $date->month;
my $day_unspecified = !exists $h->{day};
$date = DateTime->new( time_zone => tz(), %$h, day => $h->{day} // 1 );
if ( !( exists $h->{day} || $is_start ) ) {
$date->add( months => 1 );
$date->subtract( days => 1 );
}
return $date;
}
sub fix_date {
my ( $d, $is_start ) = @_;
if ( $d->{type} eq 'verbal' ) {
if ( $d->{year} ) {
init_month_abbr();
$d->{month} = $month_abbr{ $d->{month} };
delete $d->{type};
return DateTime->new( time_zone => tz(), %$d );
}
elsif ( my $day = $d->{day} ) {
my $date = today;
return $date if $day eq 'tod';
if ( $day eq 'yes' ) {
$date->subtract( days => 1 );
return $date;
}
elsif ( $day eq 'tom' ) {
$date->add( days => 1 );
lib/App/JobLog/TimeGrammar.pm view on Meta::CPAN
}
$delta-- unless $is_start;
$date->subtract( months => $delta );
}
$date->subtract( days => 1 ) unless $is_start;
return $date;
}
# numeric date
delete $d->{type};
return DateTime->new( time_zone => tz(), %$d );
}
# lazy initialization of verbal -> numeric month map
sub init_month_abbr {
unless (%month_abbr) {
my @months = qw(jan feb mar apr may jun jul aug sep oct nov dec);
init_hash( \%month_abbr, \@months );
}
}
lib/App/JobLog/TimeGrammar.pm view on Meta::CPAN
# produces interpretation of date expression such that neither date ends after
# the present
sub before_now {
my ( $h1, $h2, $two_endpoints ) = @_;
infer_missing( $h1, $h2 ) if $two_endpoints;
my $now = today;
my ( $u1, $amt1, $u2, $amt2 ) = ( time_unit($h1), time_unit($h2) );
( $h1, $h2 ) =
( decontextualized_date( $h1, 1 ), decontextualized_date($h2) );
$h2 = adjust_weekday( $h2, $now ) unless ref $h2 eq 'DateTime';
$h1 = adjust_weekday( $h1, $now ) unless ref $h1 eq 'DateTime';
while ( $now < $h2 ) {
$h2->subtract( $u2 => $amt2 );
}
while ( $h2 < $h1 ) {
$h1->subtract( $u1 => $amt1 );
}
if ($two_endpoints) {
# move the two dates as close together as possible
lib/App/JobLog/TimeGrammar.pm view on Meta::CPAN
=head1 VERSION
version 1.042
=head1 SYNOPSIS
#!/usr/bin/perl
use Modern::Perl;
use DateTime;
use App::JobLog::Time qw(tz);
use App::JobLog::TimeGrammar qw(parse);
# for demonstration purposes we modify "today"
$App::JobLog::Time::today =
DateTime->new( year => 2011, month => 2, day => 17, time_zone => tz );
for my $phrase ( 'Monday until the end of the week', 'Tuesday at 9:00 p.m.' ) {
my ( $start, $end, $endpoints ) = parse($phrase);
say $phrase;
say "$start - $end; both endpoints specified? "
. ( $endpoints ? 'yes' : 'no' );
}
produces
Monday until the end of the week
2011-02-14T00:00:00 - 2011-02-20T23:59:59; both endpoints specified? yes
Tuesday at 9:00 p.m.
2011-02-08T21:00:00 - 2011-02-15T23:59:59; both endpoints specified? no
=head1 DESCRIPTION
C<App::JobLog::TimeGrammar> converts natural language time expressions into pairs of
C<DateTime> objects representing intervals. This requires disambiguating ambiguous
terms such as 'yesterday', whose interpretation varies from day to day, and 'Friday', whose
interpretation must be fixed by some frame of reference. The heuristic used by this code
is to look first for a fixed date, either a fully specified date such as 2011/2/17 or
one fixed relative to the current moment such as 'now'. If such a date is present in the time
expression it determines the context for the other date, if it is present. Otherwise
it is assumed that the closest appropriate pair of dates immediately before the current
moment are intended.
Given a pair consisting of fixed and an ambiguous date, we assume the ambiguous date has the
sense such that it is ordered correctly relative to the fixed date and the interval between
lib/App/JobLog/TimeGrammar.pm view on Meta::CPAN
=head2 daytime
Parses a time expression such as "11:00" or "8:15:40 pm". Returns a map from
C<hour>, C<minute>, C<second>, and C<suffix> to the appropriate value, where
'x' represents an ambiguous suffix.
=head2 parse
This function (it isn't actually a method) is the essential function of this module.
It takes a time expression and returns a pair of C<DateTime> objects representing the
endpoints of the corresponding interval and whether it was given a pair of dates.
If you are parsing an expression defining a point rather than an interval you should be
safe ignoring the second endpoing, but you should check the count to make sure the expression
didn't provide a second endpoint.
This code croaks when it cannot parse the expression, so exception handling is recommended.
=head1 SEE ALSO
lib/App/JobLog/Vacation/Period.pm view on Meta::CPAN
use Exporter 'import';
our @EXPORT_OK = qw(
FLEX
FIXED
ANNUAL
MONTHLY
);
use base 'App::JobLog::Log::Event';
use DateTime;
use App::JobLog::Log::Line;
use App::JobLog::Time qw(tz);
use Carp qw(carp);
use overload '""' => \&to_string;
use overload 'bool' => sub { 1 };
use constant FLEX => 1;
use constant FIXED => 2;
use constant ANNUAL => 1;
lib/App/JobLog/Vacation/Period.pm view on Meta::CPAN
return $obj;
}
else {
carp "malformed line in vacation file: '$text'";
}
return;
}
sub _parse_time {
my @time = split /\s++/, $_[0];
$date = DateTime->new(
year => $time[0],
month => $time[1],
day => $time[2],
hour => $time[3],
minute => $time[4],
second => $time[5],
time_zone => tz,
);
return $date;
}
simple_test.pl view on Meta::CPAN
#!/usr/bin/perl
# ABSTRACT: for debugging single time expressions
use Modern::Perl;
use lib 'lib';
use App::JobLog::TimeGrammar;
use File::Temp;
use DateTime;
use App::JobLog::Config qw(
start_pay_period
pay_period_length
DIRECTORY
);
my $dir = File::Temp->newdir();
$ENV{ DIRECTORY() } = $dir;
my $start_pay_period = DateTime->new( year => 2011, month => 2, day => 13 );
start_pay_period($start_pay_period);
pay_period_length(14);
my $line = join( ' ', @ARGV );
eval {
if ( my ( $h1, $h2 ) = parse($line) )
{
print "$line: $h1 - $h2\n";
}
t/00-report-prereqs.dd view on Meta::CPAN
'requires' => {
'ExtUtils::MakeMaker' => '0'
}
},
'runtime' => {
'requires' => {
'App::Cmd::Setup' => '0',
'Carp' => '0',
'Class::Autouse' => '0',
'Config::Tiny' => '0',
'DateTime' => '0.66',
'DateTime::TimeZone' => '1.30',
'Exporter' => '0',
'File::HomeDir' => '0',
'File::Path' => '2.06',
'File::ReadBackwards' => '0',
'FileHandle' => '0',
'IO::All' => '0',
'Modern::Perl' => '0',
'Module::Build' => '0.3601',
'Term::ReadKey' => '2.30',
'Text::Wrap' => '0',
use warnings;
use autodie;
use File::Path qw(remove_tree);
use File::Temp ();
use App::JobLog::Config qw(log DIRECTORY);
use App::JobLog::Log::Line;
use App::JobLog::Log;
use App::JobLog::Time qw(tz);
use Capture::Tiny qw(capture);
use DateTime;
use File::Spec;
use IO::All -utf8;
use FileHandle;
use Test::More;
use Test::Fatal;
# create a working directory
my $dir = File::Temp->newdir();
$ENV{ DIRECTORY() } = $dir;
# use a constant time zone so as to avoid crafting data to fit various datelight savings time adjustments
$App::JobLog::Config::tz =
DateTime::TimeZone->new( name => 'America/New_York' );
subtest 'empty log' => sub {
my $log = App::JobLog::Log->new;
my $date =
DateTime->new( year => 2011, month => 1, day => 1, time_zone => tz );
my $end = $date->clone->add( days => 1 )->subtract( seconds => 1 );
is(
exception {
my $events = $log->find_events( $date, $end );
ok( @$events == 0, 'no events in empty log' );
},
undef,
'no error thrown with empty log',
);
is(
while ( my $line = $io->getline ) {
chomp $line;
if ( $line =~ /^(\d{4})\s++(\d++)\s++(\d++)/ ) {
my $ll = App::JobLog::Log::Line->parse($line);
if ( $ll->is_beginning ) {
$first = $ll unless $first;
$last = $ll;
}
my $ts = sprintf '%d/%02d/%02d', $1, $2, $3;
unless ( $dates{$ts} ) {
my $date = DateTime->new(
year => $1,
month => $2,
day => $3,
time_zone => tz
);
$dates{$ts} = 1;
push @dates, $date;
}
}
}
is( $ts1, $ts2, "found tags of first event correctly for $size log" );
($e) = $log->last_event;
$ts1 = join ' ', @{ $last->tags };
$ts2 = join ' ', @{ $e->tags };
is( $ts1, $ts2, "found tags of last event correctly for $size log" );
ok( !( $last->is_beginning ^ $e->is_open ),
"correctly determined whether last event in log is ongoing" );
for (
my $d = $dates[0]->clone ;
DateTime->compare( $d, $dates[$#dates] ) <= 0 ;
$d = $d->add( days => 1 )
)
{
my $ts = $d->strftime('%Y/%m/%d');
my $end = $d->clone;
$end->add( days => 1 )->subtract( seconds => 1 );
my $events = $log->find_events( $d, $end );
if ( $dates{$ts} ) {
ok( @$events, "found events for $ts" );
my $e = $events->[-1];
subtest 'finding notes' => sub {
# copy log data over
my $file = File::Spec->catfile( 't', 'data', 'notes.log' );
my $io = io $file;
$io > io log;
my $log = App::JobLog::Log->new;
my $start =
DateTime->new( year => 2012, month => 3, day => 1, time_zone => tz );
my $end = $start->clone->add( days => 2 )->subtract( seconds => 1 );
my $notes = $log->find_notes( $start, $end );
ok( @$notes == 3, 'found all notes at end of log' );
$start = $start->subtract( days => 1 );
$end = $start->clone->add( days => 1 )->subtract( seconds => 1 );
$notes = $log->find_notes( $start, $end );
ok( @$notes == 7, 'found all notes at top of log' );
$start = $start->add( days => 1 );
$end = $start->clone->add( days => 1 )->subtract( seconds => 1 );
$notes = $log->find_notes( $start, $end );
use strict;
use warnings;
use autodie;
use File::Path qw(remove_tree);
use File::Temp ();
use App::JobLog::Config qw(log DIRECTORY);
use App::JobLog::Log::Line;
use App::JobLog::Log;
use App::JobLog::Time qw(tz);
use DateTime;
use File::Spec;
use IO::All -utf8;
use FileHandle;
use Test::More;
use Test::Fatal;
# create a working directory
my $dir = File::Temp->newdir();
$ENV{ DIRECTORY() } = $dir;
# use a constant time zone so as to avoid crafting data to fit various datelight savings time adjustments
$App::JobLog::Config::tz =
DateTime::TimeZone->new( name => 'America/New_York' );
subtest 'append and retrieve last note' => sub {
my $log = App::JobLog::Log->new;
is(
exception {
$log->append_note( description => 'foo' );
is(
exception {
my ($ll) = $log->last_note;
if ( defined $ll ) {
'got same description back that was put in' );
$log->append_note(
description => 'bar',
tags => ['quux']
);
($ll) = $log->last_note;
is( $ll->data->description->[0],
'bar',
'got correct description back for second note' );
is( $ll->data->tags->[0], 'quux', 'got tag back' );
my $date = DateTime->new(
year => 2011,
month => 1,
day => 1,
time_zone => tz
);
$log->append_event( description => 'test event' );
($ll) = $log->last_note;
is( $ll->data->description->[0], 'bar',
'found last note correctly when there was an intervening event'
);
my $notes = $log->find_notes( $q1, $q3 );
is( scalar(@$notes), 1, 'found correct number of notes' );
};
done_testing();
remove_tree $dir;
sub make_date {
my ( $year, $month, $day, $hour, $minute, $second ) = @_;
return DateTime->new(
year => $year,
month => $month,
day => $day,
hour => $hour,
minute => $minute,
second => $second,
time_zone => $App::JobLog::Config::tz,
);
}
t/TimeGrammar.t view on Meta::CPAN
use Modern::Perl;
use App::JobLog::Config qw(
DIRECTORY
log
pay_period_length
start_pay_period
);
use App::JobLog::Time qw(tz);
use App::JobLog::TimeGrammar;
use DateTime;
use File::Temp;
use Test::More;
use Test::Fatal;
# create working directory
my $dir = File::Temp->newdir();
$ENV{ DIRECTORY() } = $dir;
# fix current moment
my $now = DateTime->new( year => 2011, month => 2, day => 18, time_zone => tz );
$App::JobLog::Time::now = $now;
subtest 'regressions' => sub {
my %dates = (
'jan 1 - 10' => [ [qw(2011 1 1 0 0 0)], [qw(2011 1 10 23 59 59)] ],
'jan 1' => [ [qw(2011 1 1 0 0 0)], [qw(2011 1 1 23 59 59)] ],
'december 2010' => [ [qw(2010 12 1 0 0 0)], [qw(2010 12 31 23 59 59)] ],
'2010.12' => [ [qw(2010 12 1 0 0 0)], [qw(2010 12 31 23 59 59)] ],
'2011' => [ [qw(2011 1 1 0 0 0)], [qw(2011 12 31 23 59 59)] ],
'jan 1 - 28' => [ [qw(2011 1 1 0 0 0)], [qw(2011 1 28 23 59 59)] ],
t/TimeGrammar.t view on Meta::CPAN
for my $interval (@intervals) {
my ( $expression, $start, $end ) = @$interval;
my ( $s, $e, $is_interval ) = parse($expression);
ok( time_test( $s, $start ), "found start date of '$expression'" );
ok( time_test( $e, $end ), "found end date of '$expression'" );
}
};
subtest 'pay period' => sub {
my $start_pay_period =
DateTime->new( year => 2011, month => 2, day => 13, time_zone => tz );
start_pay_period($start_pay_period);
pay_period_length(14);
my $expression = '2011/1/4 - pp';
my ( undef, $e ) = parse($expression);
ok(
$e->year == 2011 && $e->month == 1 && $e->day == 15,
"correctly determined end of '$expression'"
);
$expression = 'pp - 2011/1/4';
use warnings;
use autodie;
use File::Path qw(remove_tree);
use File::Temp ();
use App::JobLog;
use App::JobLog::Config qw(log DIRECTORY);
use App::JobLog::Log::Line;
use App::JobLog::Log;
use App::JobLog::Time qw(tz);
use DateTime;
use File::Spec;
use IO::All -utf8;
use FileHandle;
use DateTime::TimeZone;
use POSIX qw(tzset);
use Test::More;
use App::Cmd::Tester;
use Test::Fatal;
# create a working directory
my $dir = File::Temp->newdir();
$ENV{ DIRECTORY() } = $dir;
# use a constant time zone so as to avoid crafting data to fit various datelight savings time adjustments
$ENV{'TZ'} = 'America/New_York';
tzset();
$App::JobLog::Config::tz =
DateTime::TimeZone->new( name => 'America/New_York' );
subtest 'basic test' => sub {
# make a big log
my $log = App::JobLog::Log->new;
my $start = make_date(qw(2011 1 1 0 0 0));
my $end = $start->clone->add( months => 1 );
my $t = $start->clone;
my $count = 1;
while ( $t <= $end ) {
like $result->stdout, qr/\b$d\b/, "correct description for @$command";
}
};
SKIP: {
skip 'developer test', 1 unless $ENV{JOBLOG_TESTING};
subtest 'last event error message' => sub {
local $App::JobLog::Time::now;
local $App::JobLog::Config::tz;
$App::JobLog::Config::tz =
DateTime::TimeZone->new( name => 'America/New_York' );
my $now = DateTime->new(
year => 2012,
month => 3,
day => 3,
hour => 12,
minute => 16,
time_zone => tz
);
$App::JobLog::Time::now = $now;
# make a big log
'properly reported ongoing event spanning day boundary' );
};
}
done_testing();
remove_tree $dir;
sub make_date {
my ( $year, $month, $day, $hour, $minute, $second ) = @_;
return DateTime->new(
year => $year,
month => $month,
day => $day,
hour => $hour,
minute => $minute,
second => $second,
time_zone => $App::JobLog::Config::tz,
);
}
t/make_log.pl view on Meta::CPAN
#!/usr/bin/perl
# ABSTRACT: generates data for testing (recursive, since uses some of modules to test; best to eyeball data)
use Modern::Perl;
use File::Temp ();
use App::JobLog::Config qw(log DIRECTORY);
use App::JobLog::Time qw(tz);
use App::JobLog::Log::Line;
use App::JobLog::Log;
use DateTime;
use IO::All -utf8;
use String::Random qw(random_string);
use constant MAX_LENGTH => 24 * 60 * 60 / 4; # quarter of a day
my ( $length, $destination ) = @ARGV;
# create a working directory
my $dir = File::Temp->newdir();
$ENV{ DIRECTORY() } = $dir;
my $log = App::JobLog::Log->new;
my $time = DateTime->new(
year => 2011,
month => 1,
day => 1,
hour => 1,
minute => 0,
second => 0,
time_zone => tz,
);
# create log lines
t/regression.t view on Meta::CPAN
use warnings;
use autodie;
use File::Path qw(remove_tree);
use File::Temp ();
use App::JobLog;
use App::JobLog::Config qw(log DIRECTORY);
use App::JobLog::Log::Line;
use App::JobLog::Log;
use App::JobLog::Time qw(tz);
use DateTime;
use File::Spec;
use IO::All -utf8;
use FileHandle;
use DateTime::TimeZone;
use POSIX qw(tzset);
use Test::More;
use App::Cmd::Tester;
use Test::Fatal;
# create a working directory
my $dir = File::Temp->newdir();
$ENV{ DIRECTORY() } = $dir;
# use a constant time zone so as to avoid crafting data to fit various datelight savings time adjustments
$ENV{'TZ'} = 'America/New_York';
tzset();
$App::JobLog::Config::tz =
DateTime::TimeZone->new( name => 'America/New_York' );
# fix current moment
my $now =
DateTime->new( year => 2012, month => 12, day => 24, time_zone => tz );
$App::JobLog::Time::now = $now;
subtest 'summary with open task' => sub {
# make a big log
my $file = File::Spec->catfile( 't', 'data', 'regression1.log' );
my $io = io $file;
$io > io log;
my $result = test_app( 'App::JobLog' => [qw(summary last week)] );
unlike(
( run in 0.496 second using v1.01-cache-2.11-cpan-2b0bae70ee8 )