1 | package Mojo::Date;
|
---|
2 | use Mojo::Base -base;
|
---|
3 | use overload bool => sub {1}, '""' => sub { shift->to_string }, fallback => 1;
|
---|
4 |
|
---|
5 | use Time::Local 'timegm';
|
---|
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 | sub new { @_ > 1 ? shift->SUPER::new->parse(@_) : shift->SUPER::new }
|
---|
20 |
|
---|
21 | sub parse {
|
---|
22 | my ($self, $date) = @_;
|
---|
23 |
|
---|
24 | # epoch (784111777)
|
---|
25 | 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 | my $offset = 0;
|
---|
30 | my ($day, $month, $year, $h, $m, $s);
|
---|
31 | if ($date =~ /^\w+\W+(\d+)\W+(\w+)\W+(\d+)\W+(\d+):(\d+):(\d+)\W*\w+$/) {
|
---|
32 | ($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 | ($year, $month, $day, $h, $m, $s) = ($1, $2 - 1, $3, $4, $5, $6);
|
---|
38 | $offset = (($8 * 3600) + ($9 * 60)) * ($7 eq '+' ? -1 : 1) if $7;
|
---|
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 | ($month, $day, $h, $m, $s, $year) = ($MONTHS{$1}, $2, $3, $4, $5, $6);
|
---|
44 | }
|
---|
45 |
|
---|
46 | # Invalid
|
---|
47 | else { return $self->epoch(undef) }
|
---|
48 |
|
---|
49 | my $epoch = eval { timegm $s, $m, $h, $day, $month, $year };
|
---|
50 | return $self->epoch(
|
---|
51 | (defined $epoch && ($epoch += $offset) >= 0) ? $epoch : undef);
|
---|
52 | }
|
---|
53 |
|
---|
54 | sub to_datetime {
|
---|
55 |
|
---|
56 | # RFC 3339 (1994-11-06T08:49:37Z)
|
---|
57 | my ($s, $m, $h, $day, $month, $year) = gmtime(my $epoch = shift->epoch);
|
---|
58 | my $str = sprintf '%04d-%02d-%02dT%02d:%02d:%02d', $year + 1900, $month + 1,
|
---|
59 | $day, $h, $m, $s;
|
---|
60 | return $str . ($epoch =~ /(\.\d+)$/ ? $1 : '') . 'Z';
|
---|
61 | }
|
---|
62 |
|
---|
63 | sub to_string {
|
---|
64 |
|
---|
65 | # RFC 7231 (Sun, 06 Nov 1994 08:49:37 GMT)
|
---|
66 | my ($s, $m, $h, $mday, $month, $year, $wday) = gmtime shift->epoch;
|
---|
67 | return sprintf '%s, %02d %s %04d %02d:%02d:%02d GMT', $DAYS[$wday], $mday,
|
---|
68 | $MONTHS[$month], $year + 1900, $h, $m, $s;
|
---|
69 | }
|
---|
70 |
|
---|
71 | 1;
|
---|
72 |
|
---|
73 | =encoding utf8
|
---|
74 |
|
---|
75 | =head1 NAME
|
---|
76 |
|
---|
77 | Mojo::Date - HTTP date
|
---|
78 |
|
---|
79 | =head1 SYNOPSIS
|
---|
80 |
|
---|
81 | use Mojo::Date;
|
---|
82 |
|
---|
83 | # Parse
|
---|
84 | my $date = Mojo::Date->new('Sun, 06 Nov 1994 08:49:37 GMT');
|
---|
85 | say $date->epoch;
|
---|
86 |
|
---|
87 | # Build
|
---|
88 | my $date = Mojo::Date->new(time + 60);
|
---|
89 | say "$date";
|
---|
90 |
|
---|
91 | =head1 DESCRIPTION
|
---|
92 |
|
---|
93 | L<Mojo::Date> implements HTTP date and time functions, based on
|
---|
94 | L<RFC 7230|http://tools.ietf.org/html/rfc7230>,
|
---|
95 | L<RFC 7231|http://tools.ietf.org/html/rfc7231> and
|
---|
96 | L<RFC 3339|http://tools.ietf.org/html/rfc3339>.
|
---|
97 |
|
---|
98 | =head1 ATTRIBUTES
|
---|
99 |
|
---|
100 | L<Mojo::Date> implements the following attributes.
|
---|
101 |
|
---|
102 | =head2 epoch
|
---|
103 |
|
---|
104 | my $epoch = $date->epoch;
|
---|
105 | $date = $date->epoch(784111777);
|
---|
106 |
|
---|
107 | Epoch seconds, defaults to the current time.
|
---|
108 |
|
---|
109 | =head1 METHODS
|
---|
110 |
|
---|
111 | L<Mojo::Date> inherits all methods from L<Mojo::Base> and implements the
|
---|
112 | following new ones.
|
---|
113 |
|
---|
114 | =head2 new
|
---|
115 |
|
---|
116 | my $date = Mojo::Date->new;
|
---|
117 | my $date = Mojo::Date->new('Sun Nov 6 08:49:37 1994');
|
---|
118 |
|
---|
119 | Construct a new L<Mojo::Date> object and L</"parse"> date if necessary.
|
---|
120 |
|
---|
121 | =head2 parse
|
---|
122 |
|
---|
123 | $date = $date->parse('Sun Nov 6 08:49:37 1994');
|
---|
124 |
|
---|
125 | Parse date.
|
---|
126 |
|
---|
127 | # Epoch
|
---|
128 | say Mojo::Date->new('784111777')->epoch;
|
---|
129 | say Mojo::Date->new('784111777.21')->epoch;
|
---|
130 |
|
---|
131 | # RFC 822/1123
|
---|
132 | say Mojo::Date->new('Sun, 06 Nov 1994 08:49:37 GMT')->epoch;
|
---|
133 |
|
---|
134 | # RFC 850/1036
|
---|
135 | say Mojo::Date->new('Sunday, 06-Nov-94 08:49:37 GMT')->epoch;
|
---|
136 |
|
---|
137 | # Ansi C asctime()
|
---|
138 | say Mojo::Date->new('Sun Nov 6 08:49:37 1994')->epoch;
|
---|
139 |
|
---|
140 | # RFC 3339
|
---|
141 | say Mojo::Date->new('1994-11-06T08:49:37Z')->epoch;
|
---|
142 | say Mojo::Date->new('1994-11-06T08:49:37')->epoch;
|
---|
143 | say Mojo::Date->new('1994-11-06T08:49:37.21Z')->epoch;
|
---|
144 | say Mojo::Date->new('1994-11-06T08:49:37+01:00')->epoch;
|
---|
145 | say Mojo::Date->new('1994-11-06T08:49:37-01:00')->epoch;
|
---|
146 |
|
---|
147 | =head2 to_datetime
|
---|
148 |
|
---|
149 | my $str = $date->to_datetime;
|
---|
150 |
|
---|
151 | Render L<RFC 3339|http://tools.ietf.org/html/rfc3339> date and time.
|
---|
152 |
|
---|
153 | # "1994-11-06T08:49:37Z"
|
---|
154 | Mojo::Date->new(784111777)->to_datetime;
|
---|
155 |
|
---|
156 | # "1994-11-06T08:49:37.21Z"
|
---|
157 | Mojo::Date->new(784111777.21)->to_datetime;
|
---|
158 |
|
---|
159 | =head2 to_string
|
---|
160 |
|
---|
161 | my $str = $date->to_string;
|
---|
162 |
|
---|
163 | Render date suitable for HTTP messages.
|
---|
164 |
|
---|
165 | # "Sun, 06 Nov 1994 08:49:37 GMT"
|
---|
166 | Mojo::Date->new(784111777)->to_string;
|
---|
167 |
|
---|
168 | =head1 OPERATORS
|
---|
169 |
|
---|
170 | L<Mojo::Date> overloads the following operators.
|
---|
171 |
|
---|
172 | =head2 bool
|
---|
173 |
|
---|
174 | my $bool = !!$date;
|
---|
175 |
|
---|
176 | Always true.
|
---|
177 |
|
---|
178 | =head2 stringify
|
---|
179 |
|
---|
180 | my $str = "$date";
|
---|
181 |
|
---|
182 | Alias for L</"to_string">.
|
---|
183 |
|
---|
184 | =head1 SEE ALSO
|
---|
185 |
|
---|
186 | L<Mojolicious>, L<Mojolicious::Guides>, L<https://mojolicious.org>.
|
---|
187 |
|
---|
188 | =cut
|
---|