File Coverage

blib/lib/Mojo/Date.pm
Criterion Covered Total %
statement 30 30 100.0
branch 18 18 100.0
condition 3 3 100.0
subroutine 9 9 100.0
pod 4 4 100.0
total 64 64 100.0


line stmt bran cond sub pod time code
1             package Mojo::Date;
2 60     60   68656 use Mojo::Base -base;
  60         160  
  60         486  
3 60     60   458 use overload bool => sub {1}, '""' => sub { shift->to_string }, fallback => 1;
  60     81   194  
  60     16   859  
  1         105  
  98         260  
4              
5 60     60   39959 use Time::Local qw(timegm);
  60         106119  
  60         55201  
6              
7             has epoch => sub {time};
8              
9             my $RFC3339_RE = qr/
10             ^(\d+)-(\d+)-(\d+)\D+(\d+):(\d+):(\d+(?:\.\d+)?) # Date and time
11             (?:Z|([+-])(\d+):(\d+))?$ # Offset
12             /xi;
13              
14             my @DAYS = qw(Sun Mon Tue Wed Thu Fri Sat);
15             my @MONTHS = qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec);
16             my %MONTHS;
17             @MONTHS{@MONTHS} = (0 .. 11);
18              
19 1286 100   1286 1 33907 sub new { @_ > 1 ? shift->SUPER::new->parse(@_) : shift->SUPER::new }
20              
21             sub parse {
22 339     339 1 852 my ($self, $date) = @_;
23              
24             # epoch (784111777)
25 339 100       2388 return $self->epoch($date) if $date =~ /^\d+$|^\d+\.\d+$/;
26              
27             # RFC 822/1123 (Sun, 06 Nov 1994 08:49:37 GMT)
28             # RFC 850/1036 (Sunday, 06-Nov-94 08:49:37 GMT)
29 155         281 my $offset = 0;
30 155         286 my ($day, $month, $year, $h, $m, $s);
31 155 100       962 if ($date =~ /^\w+\W+(\d+)\W+(\w+)\W+(\d+)\W+(\d+):(\d+):(\d+)\W*\w+$/) {
    100          
    100          
32 134         732 ($day, $month, $year, $h, $m, $s) = ($1, $MONTHS{$2}, $3, $4, $5, $6);
33             }
34              
35             # RFC 3339 (1994-11-06T08:49:37Z)
36             elsif ($date =~ $RFC3339_RE) {
37 10         60 ($year, $month, $day, $h, $m, $s) = ($1, $2 - 1, $3, $4, $5, $6);
38 10 100       44 $offset = (($8 * 3600) + ($9 * 60)) * ($7 eq '+' ? -1 : 1) if $7;
    100          
39             }
40              
41             # ANSI C asctime() (Sun Nov 6 08:49:37 1994)
42             elsif ($date =~ /^\w+\s+(\w+)\s+(\d+)\s+(\d+):(\d+):(\d+)\s+(\d+)$/) {
43 2         13 ($month, $day, $h, $m, $s, $year) = ($MONTHS{$1}, $2, $3, $4, $5, $6);
44             }
45              
46             # Invalid
47 9         27 else { return $self->epoch(undef) }
48              
49 146         233 my $epoch = eval { timegm $s, $m, $h, $day, $month, $year };
  146         442  
50 146 100 100     5863 return $self->epoch((defined $epoch && ($epoch += $offset) >= 0) ? $epoch : undef);
51             }
52              
53             sub to_datetime {
54              
55             # RFC 3339 (1994-11-06T08:49:37Z)
56 5     5 1 14 my ($s, $m, $h, $day, $month, $year) = gmtime(my $epoch = shift->epoch);
57 5         34 my $str = sprintf '%04d-%02d-%02dT%02d:%02d:%02d', $year + 1900, $month + 1, $day, $h, $m, $s;
58 5 100       39 return $str . ($epoch =~ /(\.\d+)$/ ? $1 : '') . 'Z';
59             }
60              
61             sub to_string {
62              
63             # RFC 7231 (Sun, 06 Nov 1994 08:49:37 GMT)
64 1128     1128 1 3220 my ($s, $m, $h, $mday, $month, $year, $wday) = gmtime shift->epoch;
65 1128         10914 return sprintf '%s, %02d %s %04d %02d:%02d:%02d GMT', $DAYS[$wday], $mday, $MONTHS[$month], $year + 1900, $h, $m, $s;
66             }
67              
68             1;
69              
70             =encoding utf8
71              
72             =head1 NAME
73              
74             Mojo::Date - HTTP date
75              
76             =head1 SYNOPSIS
77              
78             use Mojo::Date;
79              
80             # Parse
81             my $date = Mojo::Date->new('Sun, 06 Nov 1994 08:49:37 GMT');
82             say $date->epoch;
83              
84             # Build
85             my $date = Mojo::Date->new(time + 60);
86             say "$date";
87              
88             =head1 DESCRIPTION
89              
90             L implements HTTP date and time functions, based on L, L
91             7231|https://tools.ietf.org/html/rfc7231> and L.
92              
93             =head1 ATTRIBUTES
94              
95             L implements the following attributes.
96              
97             =head2 epoch
98              
99             my $epoch = $date->epoch;
100             $date = $date->epoch(784111777);
101              
102             Epoch seconds, defaults to the current time.
103              
104             =head1 METHODS
105              
106             L inherits all methods from L and implements the following new ones.
107              
108             =head2 new
109              
110             my $date = Mojo::Date->new;
111             my $date = Mojo::Date->new('Sun Nov 6 08:49:37 1994');
112              
113             Construct a new L object and L date if necessary.
114              
115             =head2 parse
116              
117             $date = $date->parse('Sun Nov 6 08:49:37 1994');
118              
119             Parse date.
120              
121             # Epoch
122             say Mojo::Date->new('784111777')->epoch;
123             say Mojo::Date->new('784111777.21')->epoch;
124              
125             # RFC 822/1123
126             say Mojo::Date->new('Sun, 06 Nov 1994 08:49:37 GMT')->epoch;
127              
128             # RFC 850/1036
129             say Mojo::Date->new('Sunday, 06-Nov-94 08:49:37 GMT')->epoch;
130              
131             # Ansi C asctime()
132             say Mojo::Date->new('Sun Nov 6 08:49:37 1994')->epoch;
133              
134             # RFC 3339
135             say Mojo::Date->new('1994-11-06T08:49:37Z')->epoch;
136             say Mojo::Date->new('1994-11-06T08:49:37')->epoch;
137             say Mojo::Date->new('1994-11-06T08:49:37.21Z')->epoch;
138             say Mojo::Date->new('1994-11-06T08:49:37+01:00')->epoch;
139             say Mojo::Date->new('1994-11-06T08:49:37-01:00')->epoch;
140              
141             =head2 to_datetime
142              
143             my $str = $date->to_datetime;
144              
145             Render L date and time.
146              
147             # "1994-11-06T08:49:37Z"
148             Mojo::Date->new(784111777)->to_datetime;
149              
150             # "1994-11-06T08:49:37.21Z"
151             Mojo::Date->new(784111777.21)->to_datetime;
152              
153             =head2 to_string
154              
155             my $str = $date->to_string;
156              
157             Render date suitable for HTTP messages.
158              
159             # "Sun, 06 Nov 1994 08:49:37 GMT"
160             Mojo::Date->new(784111777)->to_string;
161              
162             =head1 OPERATORS
163              
164             L overloads the following operators.
165              
166             =head2 bool
167              
168             my $bool = !!$date;
169              
170             Always true.
171              
172             =head2 stringify
173              
174             my $str = "$date";
175              
176             Alias for L.
177              
178             =head1 SEE ALSO
179              
180             L, L, L.
181              
182             =cut