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   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__