[32205] | 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
|
---|