| 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
|
|
|
|
|
|
|
}; |