File Coverage

blib/lib/Date/Easy/Date.pm
Criterion Covered Total %
statement 78 79 98.7
branch 22 22 100.0
condition 4 6 66.6
subroutine 23 23 100.0
pod 10 10 100.0
total 137 140 97.8


line stmt bran cond sub pod time code
1             package Date::Easy::Date;
2              
3 15     15   112 use strict;
  15         30  
  15         471  
4 15     15   74 use warnings;
  15         27  
  15         399  
5 15     15   71 use autodie;
  15         30  
  15         73  
6              
7             our $VERSION = '0.09'; # VERSION
8              
9 15     15   79245 use Exporter;
  15         56  
  15         843  
10 15     15   98 use parent 'Exporter';
  15         35  
  15         100  
11             our @EXPORT_OK = qw< date today >;
12             our %EXPORT_TAGS = ( all => \@EXPORT_OK );
13              
14 15     15   1916 use parent 'Date::Easy::Datetime';
  15         32  
  15         76  
15              
16 15     15   818 use Carp;
  15         31  
  15         922  
17 15     15   94 use Scalar::Util 'blessed';
  15         26  
  15         671  
18 15     15   84 use Time::Local 1.26, qw< timegm_modern >;
  15         27  
  15         16245  
19              
20              
21             ##############################
22             # FUNCTIONS (*NOT* METHODS!) #
23             ##############################
24              
25              
26             sub date
27             {
28 277     277 1 381450 my $date = shift;
29 277 100       2083 if ( $date =~ /^-?\d+$/ )
    100          
30             {
31 13 100 100     82 if ($date < 29000000 and $date >= 10000000)
32             {
33 6         53 my @time = $date =~ /^(\d{4})(\d{2})(\d{2})$/;
34 6         26 return Date::Easy::Date->new(@time);
35             }
36 7         35 return Date::Easy::Date->new($date);
37             }
38             elsif ( $date !~ /\d/ )
39             {
40 19         68 my $time = _parsedate($date);
41 19 100       9442 croak("Illegal date: $date") unless defined $time;
42 18         73 return Date::Easy::Date->new($time);
43             }
44             else
45             {
46 245         820 my (undef,undef,undef, $d, $m, $y) # ignore first 3 values (time portion)
47             = Date::Easy::Datetime::_strptime($date, 'local'); # remember: parse as local, store as UTC
48 245 100       619 if (defined $y) # they're either all defined, or it's bogus
49             {
50             # return value from _strptime for month is still in the funky 0 - 11 range
51 153         568 return Date::Easy::Date->new($y, $m + 1, $d);
52             }
53             else
54             {
55 92         282 my $time = _parsedate($date);
56 92 100       30238 croak("Illegal date: $date") unless defined $time;
57 75         286 return Date::Easy::Date->new($time);
58             }
59             }
60 0         0 die("reached unreachable code");
61             }
62              
63 5     5 1 3215 sub today () { Date::Easy::Date->new }
64              
65              
66             sub _parsedate
67             {
68 111     111   1441 require Time::ParseDate;
69 111         10613 my $string = shift;
70              
71             # Remove any timezone specifier so we get the date as it was in that timezone.
72             # I've gathered up all timezone matching code from Time::ParseDate as of v2015.103.
73             # matching code from Time/ParseDate.pm:
74 111         395 my $break = qr{(?:\s+|\Z|\b(?![-:.,/]\d))}; # line 67
75 111         1545 $string =~ s/
76             (?:
77             [+-] \d\d:?\d\d \s+ \( "? (?: [A-Z]{1,4}[TCW56] | IDLE ) \) # lines 424-435
78             | GMT \s* [-+]\d{1,2} # line 441
79             | (?: GMT \s* )? [+-] \d\d:?\d\d # line 452
80             | "? (?: [A-Z]{1,4}[TCW56] | IDLE ) # line 457 (and 695-700)
81             ) $break //x;
82              
83             # We *must* force scalar context. Remember, parsedate called in list context also returns the
84             # "remainder" of the parsed string (which is often undef, which could wreak havoc with a call
85             # that incorporates our return value, particularly one to _mktime).
86 111         376 return scalar Time::ParseDate::parsedate($string, DATE_REQUIRED => 1);
87             }
88              
89              
90             #######################
91             # REGULAR CLASS STUFF #
92             #######################
93              
94              
95             sub new
96             {
97 2121     2121 1 182754 my $class = shift;
98 2121         3851 my ($y, $m, $d);
99 2121 100       4782 if (@_ == 3)
100             {
101 275         575 ($y, $m, $d) = @_;
102 275         476 --$m; # timegm will expect month as 0..11
103             }
104             else
105             {
106 1846         3019 my ($time) = @_;
107 1846 100       3808 $time = time unless defined $time;
108 1846 100       5900 if (my $conv_class = blessed $time)
109             {
110 1739 100       4985 if ( $time->isa('Time::Piece') )
111             {
112 1737         3855 ($d, $m, $y) = ($time->mday, $time->_mon, $time->year);
113             }
114             else
115             {
116 2         27 croak("Don't know how to convert $conv_class to $class");
117             }
118             }
119             else
120             {
121 107         1820 ($d, $m, $y) = (localtime $time)[3..5]; # `Date`s are parsed relative to local time ...
122 107         388 $y += 1900; # (no 2-digit dates allowed!)
123             }
124             }
125              
126             my $truncated_date =
127 2119         21157 eval { timegm_modern( 0,0,0, $d,$m,$y ) }; # ... but stored as UTC
  2119         5913  
128 2119 100       71234 croak("Illegal date: $y/" . ($m + 1) . "/$d") unless defined $truncated_date;
129 2116         4953 return $class->_mkdate($truncated_date);
130             }
131              
132             sub _mkdate
133             {
134 2116     2116   3747 my ($invocant, $epoch) = @_;
135 2116   33     7250 my $class = ref $invocant || $invocant;
136 2116         6631 return bless Date::Easy::Datetime->new(UTC => $epoch), $class; # always UTC
137             }
138              
139              
140             ############################
141             # OVERRIDDEN FROM DATETIME #
142             ############################
143              
144              
145             sub split
146             {
147 1     1 1 566 my $impl = shift->{impl};
148 1         5 ( $impl->year, $impl->mon, $impl->mday )
149             }
150              
151              
152             # override addition and subtraction
153             # numbers added to a ::Date are days
154              
155 978     978   2315 sub _add_integer { $_[0]->add_days($_[1]) }
156 246     246   575 sub _subtract_integer { $_[0]->subtract_days($_[1]) }
157              
158              
159             # These are illegal to call.
160 2     2 1 474 sub add_seconds { die("cannot call add_seconds on a Date value") }
161 2     2 1 421 sub add_minutes { die("cannot call add_minutes on a Date value") }
162 2     2 1 371 sub add_hours { die("cannot call add_hours on a Date value") }
163 2     2 1 394 sub subtract_seconds { die("cannot call subtract_seconds on a Date value") }
164 2     2 1 378 sub subtract_minutes { die("cannot call subtract_minutes on a Date value") }
165 2     2 1 371 sub subtract_hours { die("cannot call subtract_hours on a Date value") }
166              
167              
168              
169             1;
170              
171              
172              
173             # ABSTRACT: easy date class
174             # COPYRIGHT
175              
176             __END__