line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package App::TimelogTxt::Day; |
2
|
|
|
|
|
|
|
|
3
|
2
|
|
|
2
|
|
53292
|
use warnings; |
|
2
|
|
|
|
|
2
|
|
|
2
|
|
|
|
|
47
|
|
4
|
2
|
|
|
2
|
|
6
|
use strict; |
|
2
|
|
|
|
|
2
|
|
|
2
|
|
|
|
|
35
|
|
5
|
|
|
|
|
|
|
|
6
|
2
|
|
|
2
|
|
291
|
use App::TimelogTxt::Utils; |
|
2
|
|
|
|
|
2
|
|
|
2
|
|
|
|
|
38
|
|
7
|
2
|
|
|
2
|
|
7
|
use List::Util qw/sum/; |
|
2
|
|
|
|
|
2
|
|
|
2
|
|
|
|
|
1866
|
|
8
|
|
|
|
|
|
|
|
9
|
|
|
|
|
|
|
our $VERSION = '0.20'; |
10
|
|
|
|
|
|
|
|
11
|
|
|
|
|
|
|
sub new { |
12
|
5
|
|
|
5
|
1
|
1797
|
my ($class, $stamp) = @_; |
13
|
5
|
100
|
|
|
|
17
|
die "Missing required stamp.\n" unless $stamp; |
14
|
4
|
100
|
|
|
|
9
|
die "Invalid stamp format.\n" unless App::TimelogTxt::Utils::is_datestamp( $stamp ); |
15
|
|
|
|
|
|
|
|
16
|
3
|
|
|
|
|
16
|
return bless { |
17
|
|
|
|
|
|
|
stamp => $stamp, |
18
|
|
|
|
|
|
|
start => undef, |
19
|
|
|
|
|
|
|
dur => 0, |
20
|
|
|
|
|
|
|
tasks => {}, |
21
|
|
|
|
|
|
|
proj_dur => {}, |
22
|
|
|
|
|
|
|
last_start => 0, |
23
|
|
|
|
|
|
|
}, $class; |
24
|
|
|
|
|
|
|
} |
25
|
|
|
|
|
|
|
|
26
|
1
|
|
|
1
|
1
|
303
|
sub is_empty { return !$_[0]->{dur}; } |
27
|
0
|
|
|
0
|
1
|
0
|
sub is_complete { return !$_[0]->{last_start}; } |
28
|
0
|
|
|
0
|
1
|
0
|
sub date_stamp { return $_[0]->{stamp}; } |
29
|
0
|
|
|
0
|
1
|
0
|
sub has_tasks { return !!keys %{$_[0]->{tasks}}; } |
|
0
|
|
|
|
|
0
|
|
30
|
|
|
|
|
|
|
|
31
|
|
|
|
|
|
|
sub update_dur |
32
|
|
|
|
|
|
|
{ |
33
|
9
|
|
|
9
|
1
|
329
|
my ($self, $last, $epoch) = @_; |
34
|
9
|
100
|
|
|
|
20
|
my $curr_dur = $last ? $epoch - $last->epoch : 0; |
35
|
|
|
|
|
|
|
|
36
|
9
|
100
|
100
|
|
|
26
|
$self->{tasks}->{$last->task}->{dur} += $curr_dur if $last && $last->task; |
37
|
9
|
100
|
100
|
|
|
45
|
$self->{proj_dur}->{$last->project} += $curr_dur if $last && $last->project; |
38
|
9
|
|
|
|
|
32
|
$self->{dur} += $curr_dur; |
39
|
|
|
|
|
|
|
|
40
|
9
|
|
|
|
|
10
|
return; |
41
|
|
|
|
|
|
|
} |
42
|
|
|
|
|
|
|
|
43
|
|
|
|
|
|
|
sub day_filtered_by_project |
44
|
|
|
|
|
|
|
{ |
45
|
0
|
|
|
0
|
1
|
0
|
my ($self, $project) = @_; |
46
|
0
|
|
|
|
|
0
|
my $result = __PACKAGE__->new( $self->date_stamp ); |
47
|
0
|
0
|
|
|
|
0
|
$project = qr/$project/ unless ref $project; |
48
|
0
|
|
|
|
|
0
|
my @tasks = grep { $self->{tasks}->{$_}->{proj} =~ $project } keys %{$self->{tasks}}; |
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
49
|
0
|
|
|
|
|
0
|
@{$result->{tasks}}{@tasks} = @{$self->{tasks}}{@tasks}; |
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
50
|
0
|
|
|
|
|
0
|
my @projs = grep { $_ =~ $project } keys %{$self->{proj_dur}}; |
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
51
|
0
|
|
|
|
|
0
|
@{$result->{proj_dur}}{@projs} = @{$self->{proj_dur}}{@projs}; |
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
52
|
0
|
|
|
|
|
0
|
$result->{dur} = sum( 0, values %{$result->{proj_dur}} ); |
|
0
|
|
|
|
|
0
|
|
53
|
0
|
|
|
|
|
0
|
return $result; |
54
|
|
|
|
|
|
|
} |
55
|
|
|
|
|
|
|
|
56
|
|
|
|
|
|
|
sub close_day |
57
|
|
|
|
|
|
|
{ |
58
|
0
|
|
|
0
|
1
|
0
|
my ($self, $last) = @_; |
59
|
0
|
0
|
|
|
|
0
|
return if $self->is_complete(); |
60
|
|
|
|
|
|
|
|
61
|
0
|
|
|
|
|
0
|
$self->update_dur( $last, $self->day_end() ); |
62
|
0
|
|
|
|
|
0
|
$self->{last_start} = 0; |
63
|
0
|
|
|
|
|
0
|
return; |
64
|
|
|
|
|
|
|
} |
65
|
|
|
|
|
|
|
|
66
|
|
|
|
|
|
|
sub start_task { |
67
|
7
|
|
|
7
|
1
|
12
|
my ($self, $event) = @_; |
68
|
7
|
100
|
|
|
|
11
|
if( $event->is_stop() ) |
69
|
|
|
|
|
|
|
{ |
70
|
1
|
|
|
|
|
3
|
$self->{last_start} = 0; |
71
|
1
|
|
|
|
|
1
|
return; |
72
|
|
|
|
|
|
|
} |
73
|
6
|
|
|
|
|
20
|
my $task = $event->task; |
74
|
6
|
|
|
|
|
12
|
$self->{last_start} = $event->epoch; |
75
|
6
|
100
|
|
|
|
17
|
return if $self->{tasks}->{$task}; |
76
|
4
|
|
|
|
|
5
|
$self->{tasks}->{$task} = { start => $event->epoch, proj => $event->project, dur => 0 }; |
77
|
4
|
|
|
|
|
17
|
return; |
78
|
|
|
|
|
|
|
} |
79
|
|
|
|
|
|
|
|
80
|
|
|
|
|
|
|
sub print_day_detail { |
81
|
3
|
|
|
3
|
1
|
832
|
my ($self, $fh) = @_; |
82
|
3
|
|
50
|
|
|
9
|
$fh ||= \*STDOUT; |
83
|
|
|
|
|
|
|
|
84
|
3
|
|
|
|
|
2
|
my ($tasks, $proj_dur) = @{$self}{ qw/tasks proj_dur/ }; |
|
3
|
|
|
|
|
7
|
|
85
|
3
|
|
|
|
|
4
|
my $last_proj = ''; |
86
|
|
|
|
|
|
|
|
87
|
3
|
|
|
|
|
2
|
print {$fh} "\n", _format_stamp_line( $self ); |
|
3
|
|
|
|
|
8
|
|
88
|
3
|
50
|
|
|
|
5
|
foreach my $t ( sort { ($tasks->{$a}->{proj} cmp $tasks->{$b}->{proj}) || ($tasks->{$b}->{start} <=> $tasks->{$a}->{start}) } keys %{$tasks} ) |
|
4
|
|
|
|
|
12
|
|
|
3
|
|
|
|
|
12
|
|
89
|
|
|
|
|
|
|
{ |
90
|
4
|
|
|
|
|
5
|
my $curr = $tasks->{$t}; |
91
|
4
|
100
|
|
|
|
7
|
if( $curr->{proj} ne $last_proj ) |
92
|
|
|
|
|
|
|
{ |
93
|
2
|
|
|
|
|
2
|
print {$fh} _format_project_line( $curr->{proj}, $proj_dur->{$curr->{proj}} ); |
|
2
|
|
|
|
|
5
|
|
94
|
2
|
|
|
|
|
2
|
$last_proj = $curr->{proj}; |
95
|
|
|
|
|
|
|
} |
96
|
4
|
|
|
|
|
4
|
my $task = $t; |
97
|
4
|
|
|
|
|
2
|
print {$fh} _format_task_line( $t, $curr->{dur} ); |
|
4
|
|
|
|
|
7
|
|
98
|
|
|
|
|
|
|
} |
99
|
3
|
|
|
|
|
5
|
return; |
100
|
|
|
|
|
|
|
} |
101
|
|
|
|
|
|
|
|
102
|
|
|
|
|
|
|
sub print_day_summary { |
103
|
2
|
|
|
2
|
1
|
532
|
my ($self, $fh) = @_; |
104
|
2
|
|
50
|
|
|
5
|
$fh ||= \*STDOUT; |
105
|
|
|
|
|
|
|
|
106
|
2
|
|
|
|
|
3
|
my $proj_dur = $self->{proj_dur}; |
107
|
|
|
|
|
|
|
|
108
|
2
|
|
|
|
|
2
|
print {$fh} _format_stamp_line( $self ); |
|
2
|
|
|
|
|
5
|
|
109
|
2
|
|
|
|
|
2
|
foreach my $p ( sort keys %{$proj_dur} ) |
|
2
|
|
|
|
|
6
|
|
110
|
|
|
|
|
|
|
{ |
111
|
2
|
|
|
|
|
2
|
print {$fh} _format_project_line( $p, $proj_dur->{$p} ); |
|
2
|
|
|
|
|
4
|
|
112
|
|
|
|
|
|
|
} |
113
|
2
|
|
|
|
|
4
|
return; |
114
|
|
|
|
|
|
|
} |
115
|
|
|
|
|
|
|
|
116
|
|
|
|
|
|
|
sub print_hours { |
117
|
1
|
|
|
1
|
1
|
245
|
my ($self, $fh) = @_; |
118
|
1
|
|
50
|
|
|
3
|
$fh ||= \*STDOUT; |
119
|
|
|
|
|
|
|
|
120
|
1
|
|
|
|
|
2
|
print {$fh} _format_stamp_line( $self, ':' ); |
|
1
|
|
|
|
|
2
|
|
121
|
1
|
|
|
|
|
2
|
return; |
122
|
|
|
|
|
|
|
} |
123
|
|
|
|
|
|
|
|
124
|
|
|
|
|
|
|
sub print_duration { |
125
|
0
|
|
|
0
|
1
|
0
|
my ($self, $fh) = @_; |
126
|
0
|
|
0
|
|
|
0
|
$fh ||= \*STDOUT; |
127
|
|
|
|
|
|
|
|
128
|
0
|
|
|
|
|
0
|
print {$fh} _format_dur( $self->{dur} ), "\n"; |
|
0
|
|
|
|
|
0
|
|
129
|
0
|
|
|
|
|
0
|
return; |
130
|
|
|
|
|
|
|
} |
131
|
|
|
|
|
|
|
|
132
|
|
|
|
|
|
|
sub day_end |
133
|
|
|
|
|
|
|
{ |
134
|
0
|
|
|
0
|
1
|
0
|
my ($self) = @_; |
135
|
|
|
|
|
|
|
|
136
|
0
|
|
|
|
|
0
|
return App::TimelogTxt::Utils::stamp_to_localtime( $self->{stamp} ); |
137
|
|
|
|
|
|
|
} |
138
|
|
|
|
|
|
|
|
139
|
|
|
|
|
|
|
sub _format_dur |
140
|
|
|
|
|
|
|
{ |
141
|
14
|
|
|
14
|
|
28
|
my ($dur) = @_; |
142
|
14
|
|
|
|
|
8
|
$dur += 30; # round, don't truncate. |
143
|
14
|
|
|
|
|
67
|
return sprintf( '%2d:%02d', int($dur/3600), int(($dur%3600)/60) ); |
144
|
|
|
|
|
|
|
} |
145
|
|
|
|
|
|
|
|
146
|
|
|
|
|
|
|
sub _format_stamp_line |
147
|
|
|
|
|
|
|
{ |
148
|
6
|
|
|
6
|
|
4
|
my ($self, $sep) = @_; |
149
|
6
|
|
100
|
|
|
17
|
$sep ||= ''; |
150
|
|
|
|
|
|
|
|
151
|
6
|
|
|
|
|
14
|
return "$self->{stamp}$sep " . _format_dur( $self->{dur} ) . "\n"; |
152
|
|
|
|
|
|
|
} |
153
|
|
|
|
|
|
|
|
154
|
|
|
|
|
|
|
sub _format_task_line |
155
|
|
|
|
|
|
|
{ |
156
|
4
|
|
|
4
|
|
4
|
my ($task, $dur) = @_; |
157
|
|
|
|
|
|
|
|
158
|
4
|
|
|
|
|
6
|
$task =~ s/\+\S+\s//; |
159
|
4
|
100
|
|
|
|
11
|
if ( $task =~ s/\@(\S+)\s*// ) |
160
|
|
|
|
|
|
|
{ |
161
|
2
|
100
|
|
|
|
7
|
if ( $task ) { |
162
|
1
|
|
|
|
|
6
|
return sprintf( " %-20s%s (%s)\n", $1, _format_dur( $dur ), $task ); |
163
|
|
|
|
|
|
|
} |
164
|
|
|
|
|
|
|
else { |
165
|
1
|
|
|
|
|
2
|
return sprintf( " %-20s%s\n", $1, _format_dur( $dur ) ); |
166
|
|
|
|
|
|
|
} |
167
|
|
|
|
|
|
|
} |
168
|
|
|
|
|
|
|
else { |
169
|
2
|
|
|
|
|
2
|
return sprintf( " %-20s%s\n", $task, _format_dur( $dur ) ); |
170
|
|
|
|
|
|
|
} |
171
|
0
|
|
|
|
|
0
|
return; |
172
|
|
|
|
|
|
|
} |
173
|
|
|
|
|
|
|
|
174
|
|
|
|
|
|
|
sub _format_project_line |
175
|
|
|
|
|
|
|
{ |
176
|
4
|
|
|
4
|
|
5
|
my ($proj, $dur) = @_; |
177
|
|
|
|
|
|
|
|
178
|
4
|
|
|
|
|
5
|
return sprintf( ' %-13s%s', $proj, _format_dur( $dur ). "\n" ); |
179
|
|
|
|
|
|
|
} |
180
|
|
|
|
|
|
|
|
181
|
|
|
|
|
|
|
1; |
182
|
|
|
|
|
|
|
__END__ |