line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package App::TimelogTxt::Utils; |
2
|
|
|
|
|
|
|
|
3
|
4
|
|
|
4
|
|
68377
|
use warnings; |
|
4
|
|
|
|
|
8
|
|
|
4
|
|
|
|
|
146
|
|
4
|
4
|
|
|
4
|
|
23
|
use strict; |
|
4
|
|
|
|
|
6
|
|
|
4
|
|
|
|
|
138
|
|
5
|
|
|
|
|
|
|
|
6
|
4
|
|
|
4
|
|
2345
|
use POSIX qw(strftime); |
|
4
|
|
|
|
|
27242
|
|
|
4
|
|
|
|
|
24
|
|
7
|
4
|
|
|
4
|
|
5644
|
use Time::Local; |
|
4
|
|
|
|
|
2163
|
|
|
4
|
|
|
|
|
4861
|
|
8
|
|
|
|
|
|
|
|
9
|
|
|
|
|
|
|
our $VERSION = '0.21'; |
10
|
|
|
|
|
|
|
|
11
|
|
|
|
|
|
|
my $LAX_DATE_RE = qr<[0-9]{4}[-/](?:0[1-9]|1[0-2])[-/](?:0[1-9]|[12][0-9]|3[01])>; |
12
|
|
|
|
|
|
|
my $TIME_RE = qr<(?:[01][0-9]|2[0-3]):[0-5][0-9]:[0-6][0-9]>; |
13
|
|
|
|
|
|
|
|
14
|
|
|
|
|
|
|
my $DATE_FMT = '%Y-%m-%d'; |
15
|
|
|
|
|
|
|
my $DATETIME_FMT = "$DATE_FMT %H:%M:%S"; |
16
|
|
|
|
|
|
|
my $ONE_DAY = 86400; |
17
|
|
|
|
|
|
|
my $TODAY = 'today'; |
18
|
|
|
|
|
|
|
my $YESTERDAY = 'yesterday'; |
19
|
|
|
|
|
|
|
my @DAYS = qw/sunday monday tuesday wednesday thursday friday saturday/; |
20
|
|
|
|
|
|
|
|
21
|
1
|
|
|
1
|
1
|
12
|
sub TODAY { return $TODAY; } |
22
|
10
|
|
|
10
|
1
|
77
|
sub STOP_CMD { return 'stop'; } |
23
|
|
|
|
|
|
|
|
24
|
|
|
|
|
|
|
sub parse_event_line |
25
|
|
|
|
|
|
|
{ |
26
|
3
|
|
|
3
|
1
|
4
|
my ($line) = @_; |
27
|
3
|
|
|
|
|
100
|
my ( $stamp, $time, $task ) = $line =~ m<\A |
28
|
|
|
|
|
|
|
( $LAX_DATE_RE ) \s ( $TIME_RE ) |
29
|
|
|
|
|
|
|
\s+(.*) # the log entry |
30
|
|
|
|
|
|
|
\Z>x; |
31
|
3
|
100
|
|
|
|
22
|
die "Not a valid event line.\n" unless $stamp; |
32
|
2
|
|
|
|
|
9
|
return ( $stamp, $time, $task ); |
33
|
|
|
|
|
|
|
} |
34
|
|
|
|
|
|
|
|
35
|
|
|
|
|
|
|
sub fmt_time |
36
|
|
|
|
|
|
|
{ |
37
|
2
|
|
|
2
|
1
|
2
|
my ( $time ) = @_; |
38
|
2
|
|
|
|
|
96
|
return strftime( $DATETIME_FMT, localtime $time ); |
39
|
|
|
|
|
|
|
} |
40
|
|
|
|
|
|
|
|
41
|
|
|
|
|
|
|
sub fmt_date |
42
|
|
|
|
|
|
|
{ |
43
|
39
|
|
|
39
|
1
|
128
|
my ( $time ) = @_; |
44
|
39
|
|
|
|
|
1387
|
return strftime( $DATE_FMT, localtime $time ); |
45
|
|
|
|
|
|
|
} |
46
|
|
|
|
|
|
|
|
47
|
|
|
|
|
|
|
sub is_today |
48
|
|
|
|
|
|
|
{ |
49
|
22
|
|
|
22
|
1
|
26
|
my ($day) = @_; |
50
|
22
|
|
66
|
|
|
140
|
return (!$day or $day eq $TODAY or $day eq today_stamp()); |
51
|
|
|
|
|
|
|
} |
52
|
|
|
|
|
|
|
|
53
|
|
|
|
|
|
|
sub is_stop_cmd |
54
|
|
|
|
|
|
|
{ |
55
|
6
|
|
|
6
|
1
|
11
|
my ($task) = @_; |
56
|
6
|
|
|
|
|
15
|
return $task eq STOP_CMD(); |
57
|
|
|
|
|
|
|
} |
58
|
|
|
|
|
|
|
|
59
|
|
|
|
|
|
|
sub has_project |
60
|
|
|
|
|
|
|
{ |
61
|
3
|
|
|
3
|
1
|
6
|
my ($task) = @_; |
62
|
3
|
|
|
|
|
21
|
return scalar( $task =~ /(?: |\A)\+\w+/ ); |
63
|
|
|
|
|
|
|
} |
64
|
|
|
|
|
|
|
|
65
|
|
|
|
|
|
|
sub today_stamp |
66
|
|
|
|
|
|
|
{ |
67
|
20
|
|
|
20
|
1
|
42
|
return App::TimelogTxt::Utils::fmt_date( time ); |
68
|
|
|
|
|
|
|
} |
69
|
|
|
|
|
|
|
|
70
|
|
|
|
|
|
|
sub day_end |
71
|
|
|
|
|
|
|
{ |
72
|
1
|
|
|
1
|
1
|
3
|
my ( $stamp ) = @_; |
73
|
1
|
50
|
|
|
|
7
|
return unless defined $stamp; |
74
|
1
|
|
|
|
|
5
|
return App::TimelogTxt::Utils::fmt_date( stamp_to_localtime( $stamp ) + $ONE_DAY ); |
75
|
|
|
|
|
|
|
} |
76
|
|
|
|
|
|
|
|
77
|
|
|
|
|
|
|
sub stamp_to_localtime |
78
|
|
|
|
|
|
|
{ |
79
|
2
|
|
|
2
|
1
|
3
|
my ( $stamp ) = @_; |
80
|
2
|
50
|
|
|
|
7
|
return unless is_datestamp( $stamp ); |
81
|
2
|
|
|
|
|
8
|
my @date = split /-/, $stamp; |
82
|
2
|
50
|
|
|
|
6
|
return unless @date == 3; |
83
|
2
|
|
|
|
|
4
|
$date[0] -= 1900; |
84
|
2
|
|
|
|
|
4
|
--$date[1]; |
85
|
2
|
|
|
|
|
10
|
return timelocal( 59, 59, 23, reverse @date ); |
86
|
|
|
|
|
|
|
} |
87
|
|
|
|
|
|
|
|
88
|
|
|
|
|
|
|
sub prev_stamp |
89
|
|
|
|
|
|
|
{ |
90
|
0
|
|
|
0
|
1
|
0
|
my ($stamp) = @_; |
91
|
0
|
|
|
|
|
0
|
my $epoch = stamp_to_localtime( $stamp ) - 12 * 3600; # noon today |
92
|
0
|
|
|
|
|
0
|
return fmt_date( $epoch - 86400 ); # noon yesterday |
93
|
|
|
|
|
|
|
} |
94
|
|
|
|
|
|
|
|
95
|
|
|
|
|
|
|
sub day_stamp |
96
|
|
|
|
|
|
|
{ |
97
|
19
|
|
|
19
|
1
|
8294
|
my ( $day ) = @_; |
98
|
19
|
100
|
|
|
|
32
|
return today_stamp() if is_today( $day ); |
99
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
# Parse the string to generate a reasonable guess for the day. |
101
|
17
|
100
|
|
|
|
39
|
return canonical_datestamp( $day ) if is_datestamp( $day ); |
102
|
|
|
|
|
|
|
|
103
|
16
|
|
|
|
|
31
|
$day = lc $day; |
104
|
16
|
50
|
|
|
|
24
|
return unless grep { $day eq $_ } $YESTERDAY, @DAYS; |
|
128
|
|
|
|
|
150
|
|
105
|
|
|
|
|
|
|
|
106
|
16
|
|
|
|
|
14
|
my $now = time; |
107
|
16
|
|
|
|
|
13
|
my $delta = 0; |
108
|
16
|
100
|
|
|
|
26
|
if( $day eq $YESTERDAY ) |
109
|
|
|
|
|
|
|
{ |
110
|
2
|
|
|
|
|
3
|
$delta = 1; |
111
|
|
|
|
|
|
|
} |
112
|
|
|
|
|
|
|
else |
113
|
|
|
|
|
|
|
{ |
114
|
14
|
|
|
|
|
20
|
my $index = day_num_from_name( $day ); |
115
|
14
|
50
|
|
|
|
29
|
return if $index < 0; |
116
|
14
|
|
|
|
|
139
|
my $wday = ( localtime $now )[6]; |
117
|
14
|
|
|
|
|
20
|
$delta = $wday - $index; |
118
|
14
|
100
|
|
|
|
30
|
$delta += 7 if $delta < 1; |
119
|
|
|
|
|
|
|
} |
120
|
16
|
|
|
|
|
56
|
return fmt_date( $now - $ONE_DAY * $delta ); |
121
|
|
|
|
|
|
|
} |
122
|
|
|
|
|
|
|
|
123
|
|
|
|
|
|
|
sub day_num_from_name |
124
|
|
|
|
|
|
|
{ |
125
|
28
|
|
|
28
|
1
|
5410
|
my ($day) = @_; |
126
|
28
|
|
|
|
|
38
|
$day = lc $day; |
127
|
28
|
|
|
|
|
21
|
my $index = 0; |
128
|
28
|
|
|
|
|
37
|
foreach my $try ( @DAYS ) |
129
|
|
|
|
|
|
|
{ |
130
|
112
|
100
|
|
|
|
203
|
return $index if $try eq $day; |
131
|
84
|
|
|
|
|
69
|
++$index; |
132
|
|
|
|
|
|
|
} |
133
|
0
|
|
|
|
|
0
|
return -1; |
134
|
|
|
|
|
|
|
} |
135
|
|
|
|
|
|
|
|
136
|
|
|
|
|
|
|
sub is_datestamp |
137
|
|
|
|
|
|
|
{ |
138
|
41
|
|
|
41
|
1
|
6263
|
my ($stamp) = @_; |
139
|
41
|
|
|
|
|
468
|
return scalar ($stamp =~ m/\A$LAX_DATE_RE\z/); |
140
|
|
|
|
|
|
|
} |
141
|
|
|
|
|
|
|
|
142
|
|
|
|
|
|
|
sub canonical_datestamp |
143
|
|
|
|
|
|
|
{ |
144
|
4
|
|
|
4
|
1
|
333
|
my ($stamp) = @_; |
145
|
4
|
|
|
|
|
12
|
$stamp =~ tr{/}{-}; |
146
|
4
|
|
|
|
|
45
|
return $stamp; |
147
|
|
|
|
|
|
|
} |
148
|
|
|
|
|
|
|
|
149
|
|
|
|
|
|
|
1; |
150
|
|
|
|
|
|
|
__END__ |