App-JobLog
view release on metacpan or search on metacpan
lib/App/JobLog.pm view on Meta::CPAN
We basically want database functionality out of our job log -- random access, selecting rows by various
properties, nice reports. Why not use SQLite, say, or Berkeley DB? Well first of all, that adds dependencies,
and we want fewer of those. And except in extraordinary circumstances we are only adding events in sequence and we
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
lib/App/JobLog/Command.pm view on Meta::CPAN
}
}
push @gathered, Text::WrapI18N::wrap( '', '', $current )
if defined $current;
$$desc = join "\n", @gathered;
}
# override to make full description
sub full_description { }
sub validate_args {
my ( $self, $opt, $args ) = @_;
die $self->_usage_text if $opt->{help};
$self->validate( $opt, $args );
}
# obtains command name
sub name {
( my $command = shift ) =~ s/.*:://;
return $command;
}
# by default a command has no options other than --help
sub options { }
# by default a command does no argument validation
sub validate { }
# add to simple commands after argument signature so they'll complain if given arguments
sub simple_command_check {
my ( $self, $args ) = @_;
$self->usage_error("This command does not expect any arguments! No action taken.") if @$args;
}
1;
__END__
lib/App/JobLog/Command/add.pm view on Meta::CPAN
[
'clear-tags|T',
'inherit no tags from preceding event; '
. 'this is equivalent to -t ""; '
. 'this option has no effect if any tag is specified',
],
);
}
sub validate {
my ( $self, $opt, $args ) = @_;
$self->usage_error('no description provided') unless @$args;
}
1;
__END__
=pod
lib/App/JobLog/Command/configure.pm view on Meta::CPAN
$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;
}
}
sub validate {
my ( $self, $opt, $args ) = @_;
$self->usage_error('specify some parameter to set or display') unless %$opt;
$self->usage_error('cannot parse work days')
if $opt->workdays && $opt->workdays !~ /^[SMTWHFA]*+$/i;
$self->usage_error(
'cannot understand argument ' . $opt->sunday_begins_week )
if $opt->sunday_begins_week
&& $opt->sunday_begins_week !~ /^(?:true|false|[01])?$/i;
if ( defined $opt->merge ) {
lib/App/JobLog/Command/configure.pm view on Meta::CPAN
pay period length 14
precision 2
start pay period 2009-01-11
sunday begins week true
time zone local
workdays MTWHF
=head1 DESCRIPTION
B<App::JobLog::Command::configure> is the command one should use to edit F<~/.joblog/config.ini>. It will
validate the parameters, preventing you from producing a broken configuration file. If you specify
no configuration parameters sensible defaults will be used when possible. For some, such as the beginning
of the pay period, no such default is available. L<App::JobLog::TimeGrammar> will be unable to interpret
time expressions involving pay periods until this parameter is set. The other parameter for which there
is no default is editor. See L<App::JobLog::Command::editor> for further details.
=head1 PARAMETERS
=over 8
=item day length
lib/App/JobLog/Command/edit.pm view on Meta::CPAN
};
use autouse 'File::Temp' => qw(tempfile);
use autouse 'File::Copy' => qw(copy);
use autouse 'App::JobLog::Config' => qw(editor log);
use autouse 'Getopt::Long::Descriptive' => qw(prog_name);
use autouse 'App::JobLog::TimeGrammar' => qw(parse);
use autouse 'App::JobLog::Time' => qw(now);
sub execute {
my ( $self, $opt, $args ) = @_;
if ( $opt->close || $opt->validate ) {
eval {
my $log = App::JobLog::Log->new;
if ( $opt->close ) {
my $time = join ' ', @$args;
my ($s) = parse($time);
$self->usage_error(
'you may only insert closing times prior to present')
unless $s < now;
my ( $e, $i ) = $log->find_previous($s);
$self->usage_error('log does not contain appropriate event')
unless $e;
$self->usage_error('no open event at this time')
unless $e->is_open;
$log->insert( $i + 1,
App::JobLog::Log::Line->new( time => $s, done => 1 ) );
}
if ( $opt->validate ) {
my $errors = $log->validate;
_error_report($errors);
}
};
$self->usage_error($@) if $@;
}
elsif ( my $editor = editor ) {
if ( my $log = log ) {
my ( $fh, $fn ) = tempfile;
binmode $fh;
copy( $log, $fh );
lib/App/JobLog/Command/edit.pm view on Meta::CPAN
my $md51 = $md5->addfile($fh)->hexdigest;
system "$editor $log";
$fh = FileHandle->new($log);
my $md52 = $md5->reset->addfile($fh)->hexdigest;
if ( $md51 ne $md52 ) {
$fh = FileHandle->new( "$log.bak", 'w' );
copy( $fn, $fh );
$fh->close;
say "saved backup log in $log.bak";
my $errors = App::JobLog::Log->new->validate;
_error_report($errors);
}
else {
unlink $fn;
}
}
else {
say 'nothing in log to edit';
}
}
else {
$self->usage_error('no editor specified') unless $opt->close;
}
}
sub usage_desc {
'%c ' . __PACKAGE__->name . ' [--validate] [-c <date and time>]';
}
sub abstract { 'open a text editor to edit the log' }
sub full_description {
<<END;
Close an open task or open a text editor to edit the log.
Closing an open task is the only edit you'll commonly have to make (it's
easy to forget to close the last task of the day). Fortunately, it is the easiest
lib/App/JobLog/Command/edit.pm view on Meta::CPAN
environment variable.
END
}
sub options {
return (
[
'close|close-task|c' =>
'add a "DONE" line to the log at the specified moment'
],
[ 'validate|v' => 'check log for errors, commenting out any found' ],
);
}
sub _error_report {
my $errors = shift;
if ($errors) {
say "errors found: $errors";
say 'Error messages have been inserted into the log. Please edit.';
}
else {
say 'log is valid';
}
}
sub validate {
my ( $self, $opt, $args ) = @_;
if ( $opt->close ) {
$self->usage_error('no time expression provided') unless @$args;
}
}
1;
__END__
lib/App/JobLog/Command/edit.pm view on Meta::CPAN
=head1 VERSION
version 1.042
=head1 SYNOPSIS
houghton@NorthernSpy:~$ job edit --help
job <command>
job edit [--validate] [-c <date and time>]
-c --close-task --close add a "DONE" line to the log at the specified
moment
-v --validate check log for errors, commenting out any found
--help this usage screen
houghton@NorthernSpy:~$ job today
Monday, 7 March, 2011
8:01 am - ongoing 4.56 bar, foo something to add; and still more
TOTAL HOURS 4.56
bar 4.56
foo 4.56
houghton@NorthernSpy:~$ job e --close today at 8:05
houghton@NorthernSpy:~$ job t
lib/App/JobLog/Command/modify.pm view on Meta::CPAN
],
]
}
],
[ "tag|t=s@", "add tag; e.g., -t foo -t bar" ],
[ "untag|u=s@", "remove tag; e.g., -u foo -u bar" ],
[ "clear-tags|c", "remove all tags" ],
);
}
sub validate {
my ( $self, $opt, $args ) = @_;
my $has_modification = grep { $_ } @{$opt}{qw(desc tag untag clear_tags)};
$self->usage_error('no modification specified') unless $has_modification;
if ( $opt->desc ) {
$self->usage_error('no description provided') unless @$args;
}
}
lib/App/JobLog/Command/note.pm view on Meta::CPAN
[
'clear-tags|T',
'inherit no tags from preceding note; '
. 'this is equivalent to -t ""; '
. 'this option has no effect if any tag is specified',
],
);
}
sub validate {
my ( $self, $opt, $args ) = @_;
$self->usage_error('no note provided') unless @$args;
}
1;
__END__
=pod
lib/App/JobLog/Command/parse.pm view on Meta::CPAN
received: $expression
start time: $s
end time: $e
received interval: @{[$is_interval ? 'true' : 'false']}
END
};
$self->usage_error($@) if $@;
}
sub validate {
my ( $self, $opt, $args ) = @_;
$self->usage_error('no time expression provided') unless @$args;
}
sub usage_desc { '%c ' . __PACKAGE__->name }
sub abstract { 'parse a time expression' }
sub full_description {
<<END
lib/App/JobLog/Command/summary.pm view on Meta::CPAN
my $tags = $opt->{tag} || [];
my $excluded_tags = $opt->{exclude_tag} || [];
my $match = $opt->{match} || [];
my $no_match = $opt->{no_match} || [];
my $time_expr = join( ' ', @$args ) || $opt->{date};
my $time = $opt->{time};
$time_expr ||= $opt->{date};
# validate regexes, if any, while generating test
# NOTE: using $opt->{x} form rather than $opt->x to facilitate invoking summary
# from today command
my $test = _make_test( $tags, $excluded_tags, $match, $no_match, $time );
my $merge_level;
for ( $opt->{merge} || '' ) {
when ('no_merge') {
$merge_level = MERGE_NONE
}
lib/App/JobLog/Command/summary.pm view on Meta::CPAN
. ' by default the width of the terminal is automatically detected and, if that fails, a width of 76 is used'
],
[ 'no-wrap|W', 'do not wrap the text to fit columns' ],
]
}
],
[ 'hidden', 'display nothing', { hidden => 1 } ],
);
}
sub validate {
my ( $self, $opt, $args ) = @_;
$self->usage_error('no time expression provided')
unless @$args || $opt->date;
$self->usage_error('two time expression provided') if @$args && $opt->date;
$self->usage_error('columns must be positive')
if defined $opt->{columns} && $opt->columns < 1;
}
1;
lib/App/JobLog/Command/tags.pm view on Meta::CPAN
[
"Use '@{[prog_name]} help "
. __PACKAGE__->name
. '\' to see full details.'
],
[ 'notes|n', 'only list tags used on notes' ],
[ 'all|a', 'list tags for both notes and tasks' ],
);
}
sub validate {
my ( $self, $opt, $args ) = @_;
$self->usage_error('--notes conflicts will --all')
if $opt->notes && $opt->all;
}
1;
__END__
=pod
lib/App/JobLog/Command/truncate.pm view on Meta::CPAN
}
}
while (@buffer) {
$current_fh->print( shift @buffer );
}
$current_fh->close;
move( "$fh", log );
print "truncated portion of log saved in $old_f\n";
}
sub validate {
my ( $self, $opt, $args ) = @_;
$self->usage_error('no time expression provided') unless @$args;
if ( $opt->compression ) {
my $alg = _pick_compression( $opt->compression );
eval "require $alg";
$self->usage_error(
"$@: you must install $alg to use compression option --"
. $opt->compression )
if $@;
}
lib/App/JobLog/Command/vacation.pm view on Meta::CPAN
[
'remove|r=i',
'remove period with given index from list (see --list); e.g., -r 1'
],
]
}
]
);
}
sub validate {
my ( $self, $opt, $args ) = @_;
if ( $opt->modification ) {
$self->usage_error('either list or modify') if $opt->list;
$self->usage_error('no description provided')
if $opt->modification eq 'add'
&& !@$args;
}
else {
$self->usage_error('--tag requires that you add a date')
lib/App/JobLog/Command/when.pm view on Meta::CPAN
use constant SAME_DAY_FORMAT => '%l:%M:%S %p';
sub execute {
my ( $self, $opt, $args ) = @_;
my $tags = $opt->tag || [];
my $excluded_tags = $opt->exclude_tag || [];
my $match = $opt->match || [];
my $no_match = $opt->no_match || [];
# validate regexes, if any, while generating test
my $test =
App::JobLog::Command::summary::_make_test( $tags, $excluded_tags, $match,
$no_match, undef );
# parse time expression
my $days;
my $start = ( join ' ', @$args ) || 'today';
eval { ( $days, undef ) = summary "$start through today", $test, {} };
$self->usage_error($@) if $@;
lib/App/JobLog/Log.pm view on Meta::CPAN
$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' );
lib/App/JobLog/Log.pm view on Meta::CPAN
=head2 all_events
C<all_events> processes the log as a stream, extracting all events and
returning them as an array reference.
=head2 all_notes
C<all_notes> processes the log as a stream, extracting all notes and
returning them as an array reference.
=head2 validate
C<validate> makes sure the log contains only valid lines, all events are
in chronological order, and every ending follows a beginning. Invalid lines
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
lib/App/JobLog/Log/Line.pm view on Meta::CPAN
(?<description> ((?:[^;\\]|(?&escaped))++) (?{push @description, $^N}))
)
}xi;
sub new {
my ( $class, @args ) = @_;
$class = ref $class || $class;
my %opts = @args;
# 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';
};
subtest 'log validation' => sub {
# copy log data over
my $file = File::Spec->catfile( 't', 'data', 'invalid.log' );
my $io = io $file;
$io > io log;
my $log = App::JobLog::Log->new;
my ( $stdout, $stderr ) = capture {
$log->validate;
};
note $stderr;
my $text = io(log)->slurp;
ok( index( $text, <<END) > -1, 'found misplaced "DONE"' );
# ERROR; task end without corresponding beginning
# 2011 1 1 4 14 15:DONE
END
ok( index( $text, <<END) > -1, 'found malformed line' );
# ERROR; malformed line
# 2011 1 1 12 47 25:malformed line
( run in 0.875 second using v1.01-cache-2.11-cpan-beeb90c9504 )