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