File Coverage

blib/lib/App/TimelogTxt/Utils.pm
Criterion Covered Total %
statement 66 70 94.2
branch 17 22 77.2
condition 2 3 66.6
subroutine 19 20 95.0
pod 16 16 100.0
total 120 131 91.6


line stmt bran cond sub pod time code
1             package App::TimelogTxt::Utils;
2              
3 4     4   53830 use warnings;
  4         6  
  4         98  
4 4     4   13 use strict;
  4         5  
  4         82  
5              
6 4     4   1513 use POSIX qw(strftime);
  4         16962  
  4         15  
7 4     4   3104 use Time::Local;
  4         1074  
  4         2716  
8              
9             our $VERSION = '0.20';
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 8 sub TODAY { return $TODAY; }
22 10     10 1 53 sub STOP_CMD { return 'stop'; }
23              
24             sub parse_event_line
25             {
26 3     3 1 4 my ($line) = @_;
27 3         111 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       12 die "Not a valid event line.\n" unless $stamp;
32 2         5 return ( $stamp, $time, $task );
33             }
34              
35             sub fmt_time
36             {
37 2     2 1 3 my ( $time ) = @_;
38 2         59 return strftime( $DATETIME_FMT, localtime $time );
39             }
40              
41             sub fmt_date
42             {
43 39     39 1 90 my ( $time ) = @_;
44 39         1145 return strftime( $DATE_FMT, localtime $time );
45             }
46              
47             sub is_today
48             {
49 22     22 1 19 my ($day) = @_;
50 22   66     118 return (!$day or $day eq $TODAY or $day eq today_stamp());
51             }
52              
53             sub is_stop_cmd
54             {
55 6     6 1 6 my ($task) = @_;
56 6         12 return $task eq STOP_CMD();
57             }
58              
59             sub has_project
60             {
61 3     3 1 5 my ($task) = @_;
62 3         16 return scalar( $task =~ /(?: |\A)\+\w+/ );
63             }
64              
65             sub today_stamp
66             {
67 20     20 1 32 return App::TimelogTxt::Utils::fmt_date( time );
68             }
69              
70             sub day_end
71             {
72 1     1 1 2 my ( $stamp ) = @_;
73 1 50       4 return unless defined $stamp;
74 1         3 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       3 return unless is_datestamp( $stamp );
81 2         7 my @date = split /-/, $stamp;
82 2 50       3 return unless @date == 3;
83 2         5 $date[0] -= 1900;
84 2         3 --$date[1];
85 2         6 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 7493 my ( $day ) = @_;
98 19 100       31 return today_stamp() if is_today( $day );
99              
100             # Parse the string to generate a reasonable guess for the day.
101 17 100       40 return canonical_datestamp( $day ) if is_datestamp( $day );
102              
103 16         24 $day = lc $day;
104 16 50       20 return unless grep { $day eq $_ } $YESTERDAY, @DAYS;
  128         137  
105              
106 16         14 my $now = time;
107 16         10 my $delta = 0;
108 16 100       21 if( $day eq $YESTERDAY )
109             {
110 2         2 $delta = 1;
111             }
112             else
113             {
114 14         17 my $index = day_num_from_name( $day );
115 14 50       22 return if $index < 0;
116 14         133 my $wday = ( localtime $now )[6];
117 14         19 $delta = $wday - $index;
118 14 100       27 $delta += 7 if $delta < 1;
119             }
120 16         27 return fmt_date( $now - $ONE_DAY * $delta );
121             }
122              
123             sub day_num_from_name
124             {
125 28     28 1 4504 my ($day) = @_;
126 28         31 $day = lc $day;
127 28         22 my $index = 0;
128 28         30 foreach my $try ( @DAYS )
129             {
130 112 100       185 return $index if $try eq $day;
131 84         58 ++$index;
132             }
133 0         0 return -1;
134             }
135              
136             sub is_datestamp
137             {
138 41     41 1 5144 my ($stamp) = @_;
139 41         321 return scalar ($stamp =~ m/\A$LAX_DATE_RE\z/);
140             }
141              
142             sub canonical_datestamp
143             {
144 4     4 1 279 my ($stamp) = @_;
145 4         9 $stamp =~ tr{/}{-};
146 4         25 return $stamp;
147             }
148              
149             1;
150             __END__