File Coverage

script/tt
Criterion Covered Total %
statement 80 471 16.9
branch 24 238 10.0
condition 17 217 7.8
subroutine 19 55 34.5
pod n/a
total 140 981 14.2


line stmt bran cond sub pod time code
1             #!/usr/bin/env perl
2             BEGIN {
3 1 50 33 1   847 if (@ARGV and @ARGV[0] =~ /^\w/) {
4 0 0       0 @ARGV = grep { (/^-{1,2}h\w{0,3}$/ ? ($ENV{APP_TT_HELP} = $ARGV[0], 0) : (1, 1))[1] } @ARGV;
  0         0  
5             }
6             }
7              
8             # Inspired by Mojo::File
9             package App::tt::file;
10 1     1   8 use strict;
  1         3  
  1         27  
11 1     1   4 use warnings;
  1         2  
  1         32  
12 1     1   5 use Cwd ();
  1         1  
  1         13  
13 1     1   21 use File::Basename ();
  1         3  
  1         44  
14 1     1   7 use File::Find qw(find);
  1         1  
  1         72  
15 1     1   6 use File::Path ();
  1         1  
  1         32  
16 1     1   556 use File::Spec::Functions qw(canonpath catfile splitdir);
  1         861  
  1         72  
17 1     1   763 use JSON::XS ();
  1         3560  
  1         80  
18 1     1   8 use overload '@{}' => sub { [splitdir ${$_[0]}] }, '""' => sub { ${$_[0]} }, fallback => 1;
  1     0   2  
  1         9  
  0         0  
  0         0  
  0         0  
  0         0  
19              
20             sub new {
21 0     0   0 my $class = shift;
22 0 0       0 my $value = @_ == 1 ? $_[0] : @_ > 1 ? catfile @_ : canonpath(Cwd::getcwd());
    0          
23 0   0     0 return bless \$value, ref $class || $class;
24             }
25              
26 0     0   0 sub basename { File::Basename::basename ${shift()}, @_ }
  0         0  
27 0     0   0 sub child { $_[0]->new(${shift()}, @_) }
  0         0  
28 0     0   0 sub dirname { $_[0]->new(scalar File::Basename::dirname ${$_[0]}) }
  0         0  
29 0     0   0 sub make_path { File::Path::make_path(${$_[0]}, @_); shift }
  0         0  
  0         0  
30              
31             sub list_tree {
32 0     0   0 my ($self, $cb) = (shift, shift);
33 0         0 my %all;
34 0 0   0   0 my $wanted = sub { $all{$File::Find::name}++ unless -d $File::Find::name };
  0         0  
35 0 0       0 find {wanted => $wanted, no_chdir => 1}, $$self if -d $$self;
36 0         0 delete $all{$$self};
37 0 0       0 return map { my $f = $self->new(canonpath $_); $cb ? $cb->($f) : $f } sort keys %all;
  0         0  
  0         0  
38             }
39              
40             sub slurp {
41 0     0   0 my $self = shift;
42 0 0       0 die qq{Can't open file "$self": $!} unless open my $file, '<', $$self;
43 0         0 my $content = '';
44 0         0 while ($file->sysread(my $buffer, 131072, 0)) { $content .= $buffer }
  0         0  
45 0         0 $content =~ s!\s+$!!s; # Remove newlines and extra space
46 0         0 return $content;
47             }
48              
49             sub spurt {
50 0     0   0 my ($self, $content) = @_;
51 0 0       0 die qq{Can't open file "$self": $!} unless open my $file, '>', $$self;
52 0 0       0 die qq{Can't write to file "$self": $!} unless defined $file->syswrite($content);
53 0         0 return $self;
54             }
55              
56             package main;
57 1     1   1551 use Applify;
  1         5962  
  1         7  
58 1     1   1510 use File::Temp ();
  1         19415  
  1         35  
59 1     1   508 use File::HomeDir;
  1         6550  
  1         83  
60 1     1   31 use List::Util qw(uniq);
  1         2  
  1         98  
61 1     1   6 use Scalar::Util qw(blessed);
  1         2  
  1         46  
62 1     1   666 use Time::Piece;
  1         10779  
  1         6  
63 1     1   99 use Time::Seconds;
  1         3  
  1         100  
64              
65 1   50 1   6 use constant DEBUG => $ENV{APP_TT_DEBUG} || 0;
  1         2  
  1         6976  
66              
67             option str => project => 'Project name. Normally autodetected', alias => 'p';
68             option str => tag => 'Tags for an event', alias => 't', n_of => '@';
69             option str => description => 'Description for an event', alias => 'd';
70             option str => group_by => 'Group log output: --group-by day', alias => 'g';
71             option str => month => 'Mass edit a month';
72             option str => year => 'Mass edit a year';
73              
74             documentation 'App::tt';
75             version 'App::tt';
76              
77             our $PTY = -t STDOUT;
78             our $NOW = localtime;
79              
80             $SIG{__DIE__} = sub { Carp::confess($_[0]) }
81             if DEBUG;
82              
83             # Attributes
84             sub root {
85             shift->{root}
86             //= App::tt::file->new($ENV{TT_HOME}
87             || $ENV{TIMETRACKER_HOME}
88 0   0 0   0 || (File::HomeDir->my_home, '.TimeTracker'));
      0        
89             }
90              
91             sub command_edit {
92 0     0   0 my $self = shift;
93 0 0 0     0 return $self->_edit_with_editor($_[0]) if @_ and -f $_[0]; # Edit a given file
94 0 0 0     0 return $self->_mass_edit(@_) if $self->year or $self->month or !-t STDIN;
      0        
95 0         0 return $self->_edit_with_editor;
96             }
97              
98             sub command_export {
99 0     0   0 my $self = shift;
100 0         0 my $res = $self->_log(@_);
101              
102 0         0 my @cols = split /,/, $self->config('export_columns');
103 0         0 my $format = join ',', map {'"%s"'} @cols;
  0         0  
104              
105 0         0 $res->{rounded} = 0;
106 0         0 $self->_print($format, @cols);
107              
108 0         0 for my $event (sort { $a->{start} <=> $b->{start} } @{$res->{log}}) {
  0         0  
  0         0  
109 0         0 $event->{date} = $event->{start};
110 0         0 $event->{hours} = int($event->{seconds} / 3600);
111 0         0 $event->{seconds} -= $event->{hours} * 3600;
112 0         0 $event->{minutes} = int($event->{seconds} / 60);
113             $event->{rounded}
114 0 0       0 = $event->{hours} + ($event->{minutes} >= $self->config('round_up_at') ? 1 : 0);
115 0         0 $event->{hours} += sprintf '%.1f', $event->{minutes} / 60;
116 0         0 $res->{rounded} += $event->{rounded};
117              
118             $self->_print(
119             $format,
120             map {
121 0   0     0 my $val = $event->{$_} // '';
  0         0  
122 0 0 0     0 $val = $val->ymd if blessed $val and $val->can('ymd');
123 0 0       0 $val = join ',', @$val if ref $val eq 'ARRAY';
124 0         0 $val =~ s!"!""!g;
125 0         0 $val;
126             } @cols
127             );
128             }
129              
130             $self->_print(
131             '> Exact hours: %s. Rounded hours: %s Events: %s',
132             $self->_duration($res->{seconds}, 'hm'),
133 0         0 @$res{qw(rounded events)},
134             );
135              
136 0         0 return 0;
137             }
138              
139             sub command_help {
140 0     0   0 my $self = shift;
141 0   0     0 my $for = shift || 'app';
142 0 0       0 return $self->_script->print_help, 0 if $for eq 'app';
143              
144 0         0 my ($today, @help) = ($NOW->ymd);
145 0         0 require App::tt;
146 0 0       0 open my $POD, '<', $INC{'App/tt.pm'} or die "Cannot open App/tt.pm: $!";
147 0         0 while (<$POD>) {
148 0         0 s/\b2020-01-01(T\d+:)/$today$1/g; # make "register" command easier to copy/paste
149 0 0       0 push @help, $_ if /^=head2 $for/ ... /^=(head|cut)/;
150             }
151              
152 0         0 shift @help;
153 0         0 pop @help; # remove =head and =cut lines
154 0 0       0 die "Could not find help for $for.\n" unless @help;
155 0         0 $self->_print("@help");
156 0         0 return 0;
157             }
158              
159             sub command_log {
160 0     0   0 my $self = shift;
161 0         0 my $res = $self->_log(@_);
162              
163 0         0 my @table = (['Month', 'Date', 'Start', 'Duration', 'Project', 'Tags'], '-');
164 0         0 for my $event (sort { $a->{start} <=> $b->{start} } @{$res->{log}}) {
  0         0  
  0         0  
165 0         0 my $start = $event->{start};
166             push @table,
167             [
168             $start->month,
169             sprintf('%2s', $start->mday),
170             sprintf('%2s:%02s', $start->hour, $start->minute),
171             $self->_duration($event->{seconds}, 'hm'),
172             $event->{project} || '---',
173 0   0     0 join(',', @{$event->{tags}}),
  0         0  
174             ];
175             }
176              
177             $res->{interval} eq 'month'
178 0         0 ? $self->_print('> Log for %s %s', map { $res->{when}->$_ } qw(fullmonth year))
179 0 0       0 : $self->_print('> Log for %s', $res->{when}->year);
180 0 0       0 push @table, '-' if @table > 3;
181 0         0 $self->_print(\@table);
182              
183 0         0 @table = ();
184 0         0 push @table, ['Total events', ':', $res->{events}];
185 0         0 push @table, ['Total time', ':', $self->_duration($res->{seconds}, 'hms')];
186              
187 0         0 my ($time_left, @time_left) = ('');
188 0 0 0     0 if ($self->config('hours_per_month') and $res->{interval} eq 'month') {
189 0         0 my ($days, $sec) = $self->_time_left($res);
190 0 0       0 push @table, ['Remaining days', ':', $days > 0 ? $days : 0];
191 0 0       0 push @table,
192             ['Remaining time', ':', $self->_duration($sec / ($days <= 0 ? 1 : $days), '-hm') . '/day'];
193             }
194              
195 0         0 $self->_print(\@table);
196              
197 0         0 return 0;
198             }
199              
200             sub command_register {
201 0     0   0 my ($self, $start, $stop) = @_;
202 0 0 0     0 return $self->command_help('register') unless $start and $stop;
203              
204 0         0 $start = $self->_time(str => $start);
205 0         0 $stop = $self->_time(str => $stop, ref => $start);
206              
207 0   0     0 my %event = (
208             __CLASS__ => 'App::TimeTracker::Data::Task',
209             project => $self->project || $self->config('project'),
210             start => $start,
211             stop => $stop,
212             user => scalar(getpwuid $<),
213             tags => [$self->_tags],
214             description => $self->description,
215             );
216              
217 0         0 my $trc_file = $self->_trc_path($event{project}, $start);
218 0 0       0 if (-e $trc_file) {
219 0         0 $self->_print("! $trc_file already exists.");
220 0         0 return 1;
221             }
222              
223 0 0       0 $self->_print('Registered %s at %s with duration %s.', @event{qw(project start duration)})
224             if $self->_save(\%event);
225 0         0 return $!;
226             }
227              
228             sub command_start {
229 0     0   0 my ($self, @args) = @_;
230              
231 0         0 my $event = {};
232 0         0 $event->{start} = $self->_time(+(grep {/\d+\:/} @args)[0]);
  0         0  
233              
234 0   0     0 $event->{project} ||= $self->project;
235 0   0     0 $event->{project} ||= (grep {/^[A-Za-z0-9-]+$/} @args)[0];
  0         0  
236 0 0 0     0 $event->{project} ||= App::tt::file->new->basename if -d '.git';
237 0   0     0 $event->{project} ||= $self->config('project');
238 0 0       0 return $self->command_help('start') unless $event->{project};
239              
240 0         0 $self->_stop_previous(@args);
241 0 0       0 return $! unless $self->_save($event);
242 0         0 $self->root->child('previous')->spurt($event->{path});
243             $self->_print('> Started working on project %s at %s.',
244 0         0 $event->{project}, $event->{start}->hms(':'));
245 0         0 return 0;
246             }
247              
248             sub command_stop {
249 0     0   0 my $self = shift;
250 0         0 my $exit_code = $self->_stop_previous(@_);
251 0 0       0 $self->_print('! No previous event to stop.') if $exit_code == 3;
252 0         0 return $exit_code;
253             }
254              
255             sub command_status {
256 0     0   0 my $self = shift;
257 0         0 my $event = $self->_get_previous_event;
258 0         0 warn "[APP_TT] status $event->{path}\n" if DEBUG;
259              
260 0 0       0 if (!$event->{start}) {
    0          
261 0         0 $self->_print('! No event is being tracked.');
262 0         0 return 3; # No such process
263             }
264             elsif ($event->{stop}) {
265             $self->_print('> Stopped working on %s at %s after %s.',
266 0         0 $event->{project}, $event->{stop}, $self->_duration($event->{seconds}));
267 0         0 return 0;
268             }
269             else {
270 0         0 my $duration = $NOW - $event->{start} + $NOW->tzoffset;
271             $self->_print('> Been working on %s for %s.',
272 0         0 $event->{project}, $self->_duration($duration, 'hms'));
273 0         0 return 0;
274             }
275             }
276              
277             sub config {
278 0     0   0 my ($self, $key) = @_;
279              
280 0 0       0 unless ($self->{config}) {
281 0         0 local %ENV = %ENV;
282 0         0 for my $path ($self->root->child('config'), '.env') {
283 0 0       0 next unless -r $path;
284 0 0       0 open my $CONFIG, '<', $path or die qq{Can't open file "$path": $!};
285 0         0 while (my $line = readline $CONFIG) {
286 0 0       0 next unless $line =~ m!^(?:TT_)?(\w+)=(.+)!;
287 0         0 $ENV{$1} = $2;
288 0         0 $self->{config}{lc($1)} = $2;
289             }
290             }
291              
292             $self->{defaults} ||= {
293             editor => $ENV{EDITOR} || 'nano',
294             export_columns => $ENV{TT_COLUMNS} || 'date,project,hours,rounded,tags,description',
295             hours_per_month => $ENV{TT_HOURS_PER_MONTH} || 0,
296             min_time => $ENV{TT_MIN_TIME} || 300,
297 0   0     0 round_up_at => $ENV{TT_ROUND_UP_AT} || 30,
      0        
      0        
      0        
      0        
      0        
298             };
299             }
300              
301 0   0     0 return $self->{config}{$key} // $self->{defaults}{$key} // die "Missing option '$key'.\n";
      0        
302             }
303              
304             sub _edit_with_editor {
305 0     0   0 my ($self, $trc_file) = @_;
306 0 0       0 my ($event, $prev) = $trc_file ? ($self->_load($trc_file), 0) : ($self->_get_previous_event, 1);
307              
308 0   0     0 $trc_file = $event->{path} //= 'Not found';
309 0 0       0 die "Could not find file to edit. ($event->{path})\n" unless $event->{start};
310              
311 0         0 my $fh = File::Temp->new;
312 0         0 printf $fh "# %s\n", $event->{path};
313 0         0 for my $k (qw(project tags description start stop user)) {
314 0 0       0 $event->{$k} = join ', ', @{$event->{$k} || []} if $k eq 'tags';
  0 0       0  
315 0 0 0     0 $event->{$k} = $event->{$k}->datetime if $k eq 'start' or $k eq 'stop' and $event->{$k};
      0        
316 0   0     0 printf $fh "%-12s %s\n", "$k:", $event->{$k} // '';
317             }
318              
319 0         0 close $fh;
320 0         0 $self->_print("Edit $event->{path}");
321 0         0 system $self->config('editor') => "$fh";
322              
323 0         0 for (split /\n/, App::tt::file->new("$fh")->slurp) {
324 0 0       0 my ($k, $v) = /^(\w+)\s*:\s*(.+)/ or next;
325 0 0       0 $v = [grep {length} split /[\s,]+/, $v] if $k eq 'tags';
  0         0  
326 0 0       0 $v = $self->_time(str => $v) if $k eq 'start';
327 0 0       0 $v = $self->_time(str => $v, ref => $event->{start}) if $k eq 'stop';
328 0         0 $event->{$k} = $v;
329             }
330              
331 0 0       0 return $! unless $self->_save($event);
332 0 0       0 $self->root->child('previous')->spurt($event->{path}) if $prev;
333 0 0 0     0 unlink $trc_file or die "rm $trc_file: $!" unless $trc_file eq $event->{path};
334 0         0 return 0;
335             }
336              
337             sub _print {
338 0     0   0 my ($self, $data, @args) = @_;
339              
340 0 0       0 if (ref $data eq 'ARRAY') {
341 0 0       0 my $th = $data->[0][-1] eq '{X}' ? 1 : 0;
342 0 0       0 my @margin = $PTY ? ('') : ();
343 0         0 my ($width, @lines, @spec);
344              
345 0         0 for my $row (@$data) {
346 0 0 0     0 push @lines, $row and next unless ref $row eq 'ARRAY';
347 0         0 my $w = 0;
348 0         0 for my $col (0 .. $#$row) {
349 0   0     0 ($row->[$col] //= '') =~ y/\r\n//d;
350 0         0 my $len = length $row->[$col];
351 0 0 0     0 $spec[$col] = $len if $len >= ($spec[$col] // 0);
352 0         0 $w += $spec[$col] + 2;
353             }
354 0 0 0     0 $width = $w if $w >= ($width // 0);
355             }
356              
357 0         0 $width -= 2;
358 0         0 my @fm = (map({"\%-${_}s"} @spec[0 .. $#spec - 1]), '%s');
  0         0  
359             $data = join '', map {
360 0 0       0 ref $_
  0         0  
361             ? sprintf join(' ', @margin, @fm[0 .. $#$_]) . "\n", @$_
362             : ' ' . ($_ x $width) . "\n";
363             } @$data;
364             }
365              
366 0         0 my $fh = \*STDOUT;
367 0 0       0 if ($data =~ s/^(>|!)\s//) {
368 0         0 my $type = $1;
369 0         0 $fh = \*STDERR;
370 0         0 $data = "\n$data\n";
371 0 0       0 $data =~ s!\n!\n !g if $PTY;
372             }
373              
374 0 0       0 return print {$fh} "$data\n" if @_ == 2;
  0         0  
375 0         0 return printf {$fh} "$data\n", @args;
  0         0  
376             }
377              
378             sub _fill_log_days {
379 0     0   0 my ($self, $last, $now) = @_;
380 0         0 my $interval = int(($now - $last)->days);
381              
382             map {
383 0         0 my $t = $last + $_ * 86400;
  0         0  
384 0         0 +{seconds => 0, start => $t, tags => [$t->day]}
385             } 1 .. $interval;
386             }
387              
388             sub _get_previous_event {
389 0     0   0 my $self = shift;
390 0         0 my $previous = $self->root->child('previous');
391 0   0     0 my $trc_file = -r $previous
392             && App::tt::file->new($previous->slurp); # $ROOT/previous contains path to last .trc file
393 0 0 0     0 return $trc_file && -r $trc_file ? $self->_load($trc_file) : {path => $trc_file};
394             }
395              
396             sub _group_by_day {
397 0     0   0 my ($self, $res) = @_;
398 0         0 my $pl = 0;
399 0         0 my %log;
400              
401 0         0 for my $e (@{$res->{log}}) {
  0         0  
402 0         0 my $k = $e->{start}->ymd;
403 0   0     0 $log{$k} ||= {%$e, seconds => 0};
404 0         0 $log{$k}{seconds} += $e->{seconds};
405 0         0 $log{$k}{_project}{$e->{project}} = 1;
406 0         0 $log{$k}{_tags}{$_} = 1 for @{$e->{tags}};
  0         0  
407             }
408              
409             $res->{log} = [
410             map {
411 0         0 my $p = join ', ', keys %{$_->{_project}};
  0         0  
412 0 0       0 $pl = length $p if $pl < length $p;
413 0         0 +{%$_, project => $p, tags => [keys %{$_->{_tags}}]};
  0         0  
414 0         0 } map { $log{$_} } sort keys %log
  0         0  
415             ];
416             }
417              
418             sub _duration {
419 0     0   0 my ($self, $duration, $sep) = @_;
420 0 0       0 my $seconds = int(ref $duration ? $duration->seconds : $duration);
421 0         0 my ($hours, $minutes);
422              
423 0         0 $hours = int($seconds / 3600);
424 0         0 $seconds -= $hours * 3600;
425 0         0 $minutes = int($seconds / 60);
426 0         0 $seconds -= $minutes * 60;
427              
428 0 0       0 return sprintf '%s:%02s:%02s', $hours, $minutes, $seconds if !$sep;
429 0 0       0 return sprintf '%s:%02s', $hours, $minutes if $sep eq '-hm';
430 0 0       0 return sprintf '%2s:%02s', $hours, $minutes if $sep eq 'hm';
431 0         0 return sprintf '%sh %sm %ss', $hours, $minutes, $seconds;
432             }
433              
434             sub _load {
435 0     0   0 my ($self, $path) = @_;
436 0         0 my $event = JSON::XS::decode_json($path->slurp);
437 0         0 $event->{path} = $path;
438 0 0       0 $event->{tags} = [map { split /\s*,\s*/, $_ } @{$event->{tags} || []}];
  0         0  
  0         0  
439 0         0 $event->{$_} = $self->_time($event->{$_}) for grep { $event->{$_} } qw(start stop);
  0         0  
440 0         0 return $event;
441             }
442              
443             sub _log {
444 0     0   0 my $self = shift;
445 0         0 my $tags = join ',', $self->_tags;
446 0   0     0 my @project_re = map {qr{^$_\b}} split /,/, $self->project || '.+';
  0         0  
447              
448 0         0 my $res = {events => 0, log => [], seconds => 0};
449              
450 0         0 for (@_) {
451 0 0 0     0 /^(-\d+)(m|y|month|year)$/ and ($res->{start_at} = $1 and $res->{interval} = $2);
452 0 0 0     0 /^(-\d+)$/ and $res->{start_at} ||= $1;
453 0 0 0     0 /^(month|year)/ and $res->{interval} ||= $1;
454 0 0 0     0 /^--fill/ and $res->{fill} ||= 1;
455             }
456              
457 0   0     0 $res->{fill} ||= 0;
458 0   0     0 $res->{interval} ||= 'month';
459 0   0     0 $res->{start_at} ||= 0;
460              
461 0 0       0 if ($res->{interval} =~ m!^y!) {
462 0         0 $res->{when} = $self->_time(Y => $NOW->year + $res->{start_at}, m => 1, d => 1);
463 0         0 $res->{path} = $self->root->child($res->{when}->year);
464             }
465             else {
466 0         0 $res->{when} = $self->_time(m => $NOW->mon + $res->{start_at}, d => 1);
467 0         0 $res->{path} = $self->root->child($res->{when}->year, sprintf '%02s', $res->{when}->mon);
468             }
469              
470             $res->{path}->list_tree(sub {
471 0     0   0 my $file = shift;
472 0 0       0 return unless my ($date, $hms, $project) = $file->basename =~ m!^(\d+)-(\d+)_(.*)\.trc$!;
473 0         0 my $event = $self->_load($file);
474 0 0 0     0 return if @project_re and !grep { $event->{project} =~ $_ } @project_re;
  0         0  
475 0 0 0     0 return if $tags and !grep { $tags =~ /\b$_\b/ } @{$event->{tags}};
  0         0  
  0         0  
476 0   0     0 $event->{stop} ||= $NOW + $NOW->tzoffset;
477 0   0     0 $event->{seconds} ||= $event->{stop} - $event->{start};
478 0         0 push @{$res->{log}},
479 0         0 $self->_fill_log_days(@{$res->{log}} ? $res->{log}[-1]{start} : $res->{when}, $event->{start})
480 0 0       0 if $res->{fill};
    0          
481 0         0 pop @{$res->{log}}
482 0         0 if @{$res->{log}}
483             and !$res->{log}[-1]{project}
484 0 0 0     0 and $res->{log}[-1]{start}->mday == $event->{start}->mday;
      0        
485 0         0 push @{$res->{log}}, $event;
  0         0  
486 0         0 $res->{events}++;
487 0         0 $res->{seconds} += $event->{seconds};
488 0         0 });
489              
490 0 0 0     0 if (my $method = $self->can(sprintf '_group_by_%s', $self->group_by || 'nothing')) {
491 0         0 $self->$method($res);
492             }
493              
494 0         0 return $res;
495             }
496              
497             sub _mass_edit {
498 0     0   0 my $self = shift;
499              
500 0 0 0     0 $self->year($NOW->year) if $self->month and !$self->year;
501 0         0 my $path = $self->root;
502 0 0       0 $path = App::tt::file->new($path, $self->year) if $self->year;
503 0 0       0 $path = App::tt::file->new($path, sprintf '%02s', $self->month) if $self->month;
504              
505 0         0 my $re = '';
506 0   0     0 $re .= sprintf '(%s)', $self->year || '\d{4}'; # (year) = ($1)
507 0   0     0 $re .= sprintf '(%02s)', $self->month || '\d{2}'; # (month) = ($2)
508 0         0 $re .= '(\d{2})-(\d+)_'; # (day, hms) = ($3, $4)
509 0   0     0 $re .= sprintf '(%s)', $self->project || '[^.]+'; # (project) = ($5)
510 0         0 $re .= '\.trc';
511              
512             # Edit all files with code from STDIN
513 0         0 my $code = '';
514 0 0 0     0 if (!-t STDIN or !($self->year or $self->month)) {
      0        
515 0         0 $code .= $_ while ;
516 0 0       0 $code = "sub {$code}" unless $code =~ /^\s*sub\b/s;
517 0 0       0 $code = eval "use 5.10.1;use strict;use warnings;$code"
518             or die "Could not compile code from STDIN: $@\n";
519             }
520              
521             $path->list_tree(sub {
522 0     0   0 my %info = (file => shift);
523 0 0       0 return unless $info{file} =~ m!^$re$!;
524 0         0 @info{qw(year month day date hms project)} = ($1, $2, $3, "$1$2$3", $4, $5);
525 0 0       0 $self->command_edit($info{file}), next unless $code;
526 0         0 my $event = $self->_load($info{file});
527 0         0 local %_ = %info;
528 0 0 0     0 $self->_save($event) if $code and $self->$code($event);
529 0 0 0     0 unlink $info{file} or die "rm $info{file}: $!" unless $info{file} eq $event->{path};
530 0         0 });
531              
532 0         0 return 0;
533             }
534              
535             sub _save {
536 0     0   0 my ($self, $event) = @_;
537              
538 0   0     0 $event->{__CLASS__} ||= 'App::TimeTracker::Data::Task';
539 0   0     0 $event->{description} ||= $self->description // '';
      0        
540 0   0     0 $event->{project} ||= $self->project || $self->config('project');
      0        
541 0   0     0 $event->{seconds} ||= 0;
542 0 0 0     0 $event->{tags} ||= [uniq @{$event->{tags} || []}, $self->_tags];
  0         0  
543 0   0     0 $event->{user} ||= scalar(getpwuid $<);
544              
545 0 0 0     0 if (my $duration = $event->{stop} && $event->{start} && $event->{stop} - $event->{start}) {
546 0         0 $event->{seconds} = $duration->seconds;
547             }
548 0 0 0     0 if ($event->{stop} and $event->{seconds} < $self->config('min_time')) {
549 0         0 $self->_print('! Too short duration (%s)', $self->_duration($event->{duration}));
550 0         0 $! = 52;
551 0         0 return 0;
552             }
553              
554 0         0 $event->{duration} = $self->_duration($event->{seconds}); # Used by App::TimeTracker::Data::Task
555              
556 0         0 my %event = %$event;
557 0         0 delete $event{path};
558 0 0       0 $event{start} = $event->{start}->datetime if $event->{start};
559 0 0       0 $event{stop} = $event->{stop}->datetime if $event->{stop};
560              
561 0         0 $event->{path} = $self->_trc_path($event->{project}, $event->{start});
562 0 0       0 $event->{path}->dirname->make_path unless -d $event->{path}->dirname;
563 0         0 $event->{path}->spurt(JSON::XS::encode_json(\%event));
564 0         0 return 1;
565             }
566              
567             sub _tags {
568 0     0   0 my $self = shift;
569 0 0       0 return $self->tag(shift) if @_;
570 0 0       0 return uniq map { split /,/, $_ } @{$self->tag || []};
  0         0  
  0         0  
571             }
572              
573             sub _stop_previous {
574 0     0   0 my ($self, @args) = @_;
575              
576 0         0 my $event = $self->_get_previous_event;
577 0 0 0     0 return 3 if !$event->{start} or $event->{stop}; # 3 == No such process
578              
579 0         0 $event->{stop} = $self->_time(+(grep {/\d+\:/} @args)[0]);
  0         0  
580              
581 0         0 my $duration = $event->{stop} - $event->{start};
582 0 0       0 if ($duration->seconds < $self->config('min_time')) {
583             $self->_print(
584 0         0 qq(! Dropping log event for %s since worked less than @{[$self->config('min_time')]}s.),
585 0         0 $event->{project});
586 0 0       0 unlink $event->{path} or die "rm $event->{path}: $!";
587 0         0 return 52;
588             }
589              
590 0 0       0 if ($self->_save($event)) {
591             $self->_print('> Stopped working on %s after %s.',
592 0         0 $event->{project}, $self->_duration($duration, 'hms'));
593 0         0 return 0;
594             }
595              
596 0   0     0 return $! || 1;
597             }
598              
599             sub _time {
600 7     7   21736 my $self = shift;
601 7 50       29 my %t = @_ == 1 ? (str => shift) : (@_);
602              
603 7 50       19 if ($t{str}) {
604 7         48 my ($ymd, $hms) = split /[T\s]/, $t{str};
605 7 100 66     30 ($hms, $ymd) = ($ymd, '') if !$hms and $ymd =~ m!:!;
606 7 100       31 $t{Y} = $1 if $ymd =~ s!(\d{4})!!;
607 7 100       35 $t{m} = $1 if $ymd =~ s!0?(\d{1,2})-(\d+)!$2!;
608 7 100       34 $t{d} = $1 if $ymd =~ s!0?(\d{1,2})!!;
609 7 50       38 $t{H} = $1 if $hms =~ s!0?(\d{1,2})!!;
610 7 100       26 $t{M} = $1 if $hms =~ s!0?(\d{1,2})!!;
611 7 100       22 $t{S} = $1 if $hms =~ s!0?(\d{1,2})!!;
612             }
613              
614 7   33     99 my $ref = $t{ref} || $NOW;
615 7 50       383 $ref = $self->_time($ref) unless ref $ref;
616 7   66     34 $t{Y} ||= $ref->year;
617 7   66     47 $t{m} //= $ref->mon;
618 7   66     33 $t{d} //= $ref->mday;
619 7 50 33     54 $t{S} //= defined $t{H} || defined $t{M} ? 0 : $ref->second;
      66        
620 7 50 66     22 $t{M} //= defined $t{H} ? 0 : $ref->min;
621 7   33     13 $t{H} //= $ref->hour;
622              
623 7 50       16 @t{qw(m Y)} = (12 - $t{m}, $t{Y} - 1) if $t{m} <= 0;
624 7 50       17 @t{qw(m Y)} = (1, $t{Y} + 1) if $t{m} > 12;
625              
626             eval {
627 7         42 $t{iso} = sprintf '%s-%02s-%02sT%02s:%02s:%02s', @t{qw(Y m d H M S)};
628 7         32 $t{tp} = Time::Piece->strptime("$t{iso}+0000", '%Y-%m-%dT%H:%M:%S%z');
629 7 100       20 } or do {
630 1         33 $@ =~ s!\r?\n$!!;
631 1         7 $@ =~ s!\sat\s\W+.*!! unless DEBUG;
632 1 50       11 die "Invalid time: $t{str} ($t{iso}): $@\n" if $t{str};
633 0         0 die "Invalid time: $t{iso}: $@\n";
634             };
635              
636 6         597 return $t{tp};
637             }
638              
639             sub _time_left {
640 0     0     my ($self, $res) = @_;
641 0           my $start = $self->_time(d => 1, H => 0, M => 0, S => 0);
642 0           my $end = $self->_time(d => 1, m => $start->mon + 1, H => 0, M => 0, S => 0);
643 0           my $total_days = 0;
644 0           my $worked_days = 0;
645 0           while ($start < $end) {
646 0 0 0       if ($start->day_of_week != 0 and $start->day_of_week != 6) {
647 0 0         $worked_days++ if $start < $NOW;
648 0           $total_days++;
649             }
650 0           $start += ONE_DAY;
651             }
652              
653 0 0         my $remaining_days = $total_days - $worked_days + ($NOW->hour > 12 ? 0 : 1);
654 0           my $total_seconds = $self->config('hours_per_month') * 3600;
655 0           my $remaining_seconds = $total_seconds - $res->{seconds};
656 0           return $remaining_days, $remaining_seconds;
657             }
658              
659             sub _trc_path {
660 0     0     my ($self, $project, $t) = @_;
661 0           my $month = sprintf '%02s', $t->mon;
662 0           my $file;
663              
664 0           $project =~ s!\W!_!g;
665 0           $file = sprintf '%s-%s_%s.trc', $t->ymd(''), $t->hms(''), $project;
666              
667 0           return $self->root->child($t->year, $month, $file);
668             }
669              
670             app {
671             my ($self, $command) = (shift, shift);
672             return $self->command_help($ENV{APP_TT_HELP}) if $ENV{APP_TT_HELP};
673             return $self->command_status(@_) if !$command or $command eq 'status';
674             my $method = $self->can("command_$command");
675             return $self->$method(@_) if $method;
676             die qq(Unknown command "$command".\n);
677             };