=head1 NAME
HTML::Microformats::Datatype::DateTime::Parser - parse ISO8601 datetimes
=head1 DESCRIPTION
This module is a moderately modified version of L.
It allows datetimes to be expressed with a somewhat looser syntax, especially
support for whitespace between the date and time instead of a "T". It also
calculates the "resolution" of the datetime (e.g. is it specified to year,
month, day, hour, minute, second or nanosecond precision) which it places
in $dt->{'resolution'}.
Other than that, it can be used exactly as DateTime::Format::ISO8601 can.
It parses strings into normal DateTime objects.
=head1 BUGS
Please report any bugs to L.
=head1 SEE ALSO
L,
L.
=head1 AUTHOR
Toby Inkster Etobyink@cpan.orgE.
Based on DateTime::Format::ISO8601 by Joshua Hoblitt.
=head1 COPYRIGHT
Copyright 2003-2005 Joshua Hoblitt
Copyright 2008-2011 Toby Inkster
This library is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.
=head1 DISCLAIMER OF WARRANTIES
THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED
WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
=cut
package HTML::Microformats::Datatype::DateTime::Parser;
use common::sense;
use Carp qw( croak );
use DateTime;
use DateTime::Format::Builder;
use Params::Validate qw( validate validate_pos BOOLEAN OBJECT SCALAR );
use Object::AUTHORITY;
BEGIN {
$HTML::Microformats::Datatype::DateTime::Parser::AUTHORITY = 'cpan:TOBYINK';
$HTML::Microformats::Datatype::DateTime::Parser::VERSION = '0.104';
}
{
my $default_legacy_year;
sub DefaultLegacyYear {
my $class = shift;
( $default_legacy_year ) = validate_pos( @_,
{
type => BOOLEAN,
callbacks => {
'is 0, 1, or undef' =>
sub { ! defined( $_[0] ) || $_[0] == 0 || $_[0] == 1 },
},
}
) if @_;
return $default_legacy_year;
}
}
__PACKAGE__->DefaultLegacyYear( 1 );
{
my $default_cut_off_year;
sub DefaultCutOffYear {
my $class = shift;
( $default_cut_off_year ) = validate_pos( @_,
{
type => SCALAR,
callbacks => {
'is between 0 and 99' =>
sub { $_[0] >= 0 && $_[0] <= 99 },
},
}
) if @_;
return $default_cut_off_year;
}
}
# the same default value as DT::F::Mail
__PACKAGE__->DefaultCutOffYear( 49 );
sub new {
my( $class ) = shift;
my %args = validate( @_,
{
base_datetime => {
type => OBJECT,
can => 'utc_rd_values',
optional => 1,
},
legacy_year => {
type => BOOLEAN,
default => $class->DefaultLegacyYear,
callbacks => {
'is 0, 1, or undef' =>
sub { ! defined( $_[0] ) || $_[0] == 0 || $_[0] == 1 },
},
},
cut_off_year => {
type => SCALAR,
default => $class->DefaultCutOffYear,
callbacks => {
'is between 0 and 99' =>
sub { $_[0] >= 0 && $_[0] <= 99 },
},
},
}
);
$class = ref( $class ) || $class;
my $self = bless( \%args, $class );
if ( $args{ base_datetime } ) {
$self->set_base_datetime( object => $args{ base_datetime } );
}
return( $self );
}
# lifted from DateTime
sub clone { bless { %{ $_[0] } }, ref $_[0] }
sub base_datetime { $_[0]->{ base_datetime } }
sub set_base_datetime {
my $self = shift;
my %args = validate( @_,
{
object => {
type => OBJECT,
can => 'utc_rd_values',
},
}
);
# ISO8601 only allows years 0 to 9999
# this implimentation ignores the needs of expanded formats
my $dt = DateTime->from_object( object => $args{ object } );
my $lower_bound = DateTime->new( year => 0 );
my $upper_bound = DateTime->new( year => 10000 );
if ( $dt < $lower_bound ) {
croak "base_datetime must be greater then or equal to ",
$lower_bound->iso8601;
}
if ( $dt >= $upper_bound ) {
croak "base_datetime must be less then ", $upper_bound->iso8601;
}
$self->{ base_datetime } = $dt;
return $self;
}
sub legacy_year { $_[0]->{ legacy_year } }
sub set_legacy_year {
my $self = shift;
my @args = validate_pos( @_,
{
type => BOOLEAN,
callbacks => {
'is 0, 1, or undef' =>
sub { ! defined( $_[0] ) || $_[0] == 0 || $_[0] == 1 },
},
}
);
$self->{ legacy_year } = $args[0];
return $self;
}
sub cut_off_year { $_[0]->{ cut_off_year } }
sub set_cut_off_year {
my $self = shift;
my @args = validate_pos( @_,
{
type => SCALAR,
callbacks => {
'is between 0 and 99' =>
sub { $_[0] >= 0 && $_[0] <= 99 },
},
}
);
$self->{ cut_off_year } = $args[0];
return $self;
}
DateTime::Format::Builder->create_class(
parsers => {
parse_datetime => [
[ preprocess => \&_do_whitespace ],
{
#YYYYMMDD 19850412
length => [qw(8 9)],
regex => qr/^ (-?\d{4}) ([01]\d) ([0-3]\d) $/x,
params => [ qw( year month day ) ],
postprocess => \&_do_resolution,
},
{
# uncombined with above because
#regex => qr/^ (\d{4}) -?? (\d\d) -?? (\d\d) $/x,
# was matching 152746-05
#YYYY-MM-DD 1985-04-12
length => [qw(10 11)],
regex => qr/^ (-?\d{4}) - ([01]\d) - ([0-3]\d) $/x,
params => [ qw( year month day ) ],
postprocess => \&_do_resolution,
},
{
#YYYY-MM 1985-04
length => [qw(7 8)],
regex => qr/^ (-?\d{4}) - ([01]\d) $/x,
params => [ qw( year month ) ],
postprocess => \&_do_resolution,
},
{
#YYYY 1985
length => [qw(4 5)],
regex => qr/^ (-?\d{4}) $/x,
params => [ qw( year ) ],
postprocess => \&_do_resolution,
},
{
#YY 19 (century)
length => 2,
regex => qr/^ (\d\d) $/x,
params => [ qw( year ) ],
postprocess => [\&_normalize_century, \&_do_resolution],
},
{
#YYMMDD 850412
#YY-MM-DD 85-04-12
length => [ qw( 6 8 ) ],
regex => qr/^ (\d\d) -?? ([01]\d) -?? ([0-3]\d) $/x,
params => [ qw( year month day ) ],
postprocess => [\&_fix_2_digit_year, \&_do_resolution],
},
{
#-YYMM -8504
#-YY-MM -85-04
length => [ qw( 5 6 ) ],
regex => qr/^ - (\d\d) -?? ([01]\d) $/x,
params => [ qw( year month ) ],
postprocess => [\&_fix_2_digit_year, \&_do_resolution],
},
{
#-YY -85
length => 3,
regex => qr/^ - (\d\d) $/x,
params => [ qw( year ) ],
postprocess => [\&_fix_2_digit_year, \&_do_resolution],
},
{
#--MMDD --0412
#--MM-DD --04-12
length => [ qw( 6 7 ) ],
regex => qr/^ -- ([01]\d) -?? ([0-3]\d) $/x,
params => [ qw( month day ) ],
postprocess => [\&_add_year, \&_do_resolution],
},
{
#--MM --04
length => 4,
regex => qr/^ -- ([01]\d) $/x,
params => [ qw( month ) ],
postprocess => [\&_add_year, \&_do_resolution],
},
{
#---DD ---12
length => 5,
regex => qr/^ --- ([0-3]\d) $/x,
params => [ qw( day ) ],
postprocess => [ \&_add_year, \&_add_month, \&_do_resolution],
},
{
#+[YY]YYYYMMDD +0019850412
#+[YY]YYYY-MM-DD +001985-04-12
length => [ qw( 11 13 ) ],
regex => qr/^ \+ (\d{6}) -?? ([01]\d) -?? ([0-3]\d) $/x,
params => [ qw( year month day ) ],
postprocess => \&_do_resolution,
},
{
#+[YY]YYYY-MM +001985-04
length => 10,
regex => qr/^ \+ (\d{6}) - (\d\d) $/x,
params => [ qw( year month ) ],
postprocess => \&_do_resolution,
},
{
#+[YY]YYYY +001985
length => 7,
regex => qr/^ \+ (\d{6}) $/x,
params => [ qw( year ) ],
postprocess => \&_do_resolution,
},
{
#+[YY]YY +0019 (century)
length => 5,
regex => qr/^ \+ (\d{4}) $/x,
params => [ qw( year ) ],
postprocess => [\&_normalize_century, \&_do_resolution],
},
{
#YYYYDDD 1985102
#YYYY-DDD 1985-102
length => [ qw( 7 8 9 ) ],
regex => qr/^ (-?\d{4}) -?? (\d{3}) $/x,
params => [ qw( year day_of_year ) ],
constructor => [ 'DateTime', 'from_day_of_year' ],
postprocess => \&_do_resolution,
},
{
#YYDDD 85102
#YY-DDD 85-102
length => [ qw( 5 6 7 ) ],
regex => qr/^ (-?\d\d) -?? (\d{3}) $/x,
params => [ qw( year day_of_year ) ],
postprocess => [ \&_fix_2_digit_year, \&_do_resolution],
constructor => [ 'DateTime', 'from_day_of_year' ],
},
{
#-DDD -102
length => 4,
regex => qr/^ - (\d{3}) $/x,
params => [ qw( day_of_year ) ],
postprocess => [ \&_add_year, \&_do_resolution],
constructor => [ 'DateTime', 'from_day_of_year' ],
},
{
#+[YY]YYYYDDD +001985102
#+[YY]YYYY-DDD +001985-102
length => [ qw( 10 11 ) ],
regex => qr/^ \+ (\d{6}) -?? (\d{3}) $/x,
params => [ qw( year day_of_year ) ],
constructor => [ 'DateTime', 'from_day_of_year' ],
postprocess => \&_do_resolution,
},
{
#YYYYWwwD 1985W155
#YYYY-Www-D 1985-W15-5
length => [ qw( 8 9 10 11 ) ],
regex => qr/^ (-?\d{4}) -?? W (\d\d) -?? (\d) $/x,
params => [ qw( year week day_of_year ) ],
postprocess => [ \&_normalize_week, \&_do_resolution ],
constructor => [ 'DateTime', 'from_day_of_year' ],
},
{
#YYYYWww 1985W15
#YYYY-Www 1985-W15
length => [ qw( 7 8 9 ) ],
regex => qr/^ (-?\d{4}) -?? W (\d\d) $/x,
params => [ qw( year week ) ],
postprocess => [ \&_normalize_week, \&_do_resolution ],
constructor => [ 'DateTime', 'from_day_of_year' ],
},
{
#YYWwwD 85W155
#YY-Www-D 85-W15-5
length => [ qw( 6 7 8 9 ) ],
regex => qr/^ (-?\d\d) -?? W (\d\d) -?? (\d) $/x,
params => [ qw( year week day_of_year ) ],
postprocess => [ \&_fix_2_digit_year, \&_normalize_week, \&_do_resolution ],
constructor => [ 'DateTime', 'from_day_of_year' ],
},
{
#YYWww 85W15
#YY-Www 85-W15
length => [ qw( 5 6 7 ) ],
regex => qr/^ (-?\d\d) -?? W (\d\d) $/x,
params => [ qw( year week ) ],
postprocess => [ \&_fix_2_digit_year, \&_normalize_week, \&_do_resolution ],
constructor => [ 'DateTime', 'from_day_of_year' ],
},
{
#-YWwwD -5W155
#-Y-Www-D -5-W15-5
length => [ qw( 6 8 ) ],
regex => qr/^ - (\d) -?? W (\d\d) -?? (\d) $/x,
params => [ qw( year week day_of_year ) ],
postprocess => [ \&_fix_1_digit_year, \&_normalize_week, \&_do_resolution ],
constructor => [ 'DateTime', 'from_day_of_year' ],
},
{
#-YWww -5W15
#-Y-Www -5-W15
length => [ qw( 5 6 ) ],
regex => qr/^ - (\d) -?? W (\d\d) $/x,
params => [ qw( year week ) ],
postprocess => [ \&_fix_1_digit_year, \&_normalize_week, \&_do_resolution ],
constructor => [ 'DateTime', 'from_day_of_year' ],
},
{
#-WwwD -W155
#-Www-D -W15-5
length => [ qw( 5 6 ) ],
regex => qr/^ - W (\d\d) -?? (\d) $/x,
params => [ qw( week day_of_year ) ],
postprocess => [ \&_add_year, \&_normalize_week, \&_do_resolution ],
constructor => [ 'DateTime', 'from_day_of_year' ],
},
{
#-Www -W15
length => 4,
regex => qr/^ - W (\d\d) $/x,
params => [ qw( week ) ],
postprocess => [ \&_add_year, \&_normalize_week, \&_do_resolution ],
constructor => [ 'DateTime', 'from_day_of_year' ],
},
{
#-W-D -W-5
length => 4,
regex => qr/^ - W - (\d) $/x,
params => [ qw( day_of_year ) ],
postprocess => [
\&_add_year,
\&_add_week,
\&_normalize_week,
\&_do_resolution
],
constructor => [ 'DateTime', 'from_day_of_year' ],
},
{
#+[YY]YYYYWwwD +001985W155
#+[YY]YYYY-Www-D +001985-W15-5
length => [ qw( 11 13 ) ],
regex => qr/^ \+ (\d{6}) -?? W (\d\d) -?? (\d) $/x,
params => [ qw( year week day_of_year ) ],
postprocess => [ \&_normalize_week, \&_do_resolution ],
constructor => [ 'DateTime', 'from_day_of_year' ],
},
{
#+[YY]YYYYWww +001985W15
#+[YY]YYYY-Www +001985-W15
length => [ qw( 10 11 ) ],
regex => qr/^ \+ (\d{6}) -?? W (\d\d) $/x,
params => [ qw( year week ) ],
postprocess => [ \&_normalize_week, \&_do_resolution ],
constructor => [ 'DateTime', 'from_day_of_year' ],
},
{
#hhmmss 232050 - skipped
#hh:mm:ss 23:20:50
length => [ qw( 8 9 ) ],
regex => qr/^ T?? (\d\d) : (\d\d) : (\d\d) $/x,
params => [ qw( hour minute second) ],
postprocess => [
\&_add_year,
\&_add_month,
\&_add_day,
\&_do_resolution
],
},
#hhmm 2320 - skipped
#hh 23 -skipped
{
#hh:mm 23:20
length => [ qw( 4 5 6 ) ],
regex => qr/^ T?? (\d\d) :?? (\d\d) $/x,
params => [ qw( hour minute ) ],
postprocess => [
\&_add_year,
\&_add_month,
\&_add_day,
\&_do_resolution
],
},
{
#hhmmss,ss 232050,5
#hh:mm:ss,ss 23:20:50,5
regex => qr/^ T?? (\d\d) :?? (\d\d) :?? (\d\d) [\.,] (\d+) $/x,
params => [ qw( hour minute second nanosecond) ],
postprocess => [
\&_add_year,
\&_add_month,
\&_add_day,
\&_fractional_second,
\&_do_resolution
],
},
{
#hhmm,mm 2320,8
#hh:mm,mm 23:20,8
regex => qr/^ T?? (\d\d) :?? (\d\d) [\.,] (\d+) $/x,
params => [ qw( hour minute second ) ],
postprocess => [
\&_add_year,
\&_add_month,
\&_add_day,
\&_fractional_minute,
\&_do_resolution
],
},
{
#hh,hh 23,3
regex => qr/^ T?? (\d\d) [\.,] (\d+) $/x,
params => [ qw( hour minute ) ],
postprocess => [
\&_add_year,
\&_add_month,
\&_add_day,
\&_fractional_hour,
\&_do_resolution
],
},
{
#-mmss -2050 - skipped
#-mm:ss -20:50
length => 6,
regex => qr/^ - (\d\d) : (\d\d) $/x,
params => [ qw( minute second ) ],
postprocess => [
\&_add_year,
\&_add_month,
\&_add_day,
\&_add_hour,
\&_do_resolution
],
},
#-mm -20 - skipped
#--ss --50 - skipped
{
#-mmss,s -2050,5
#-mm:ss,s -20:50,5
regex => qr/^ - (\d\d) :?? (\d\d) [\.,] (\d+) $/x,
params => [ qw( minute second nanosecond ) ],
postprocess => [
\&_add_year,
\&_add_month,
\&_add_day,
\&_add_hour,
\&_fractional_second,
\&_do_resolution
],
},
{
#-mm,m -20,8
regex => qr/^ - (\d\d) [\.,] (\d+) $/x,
params => [ qw( minute second ) ],
postprocess => [
\&_add_year,
\&_add_month,
\&_add_day,
\&_add_hour,
\&_fractional_minute,
\&_do_resolution
],
},
{
#--ss,s --50,5
regex => qr/^ -- (\d\d) [\.,] (\d+) $/x,
params => [ qw( second nanosecond) ],
postprocess => [
\&_add_year,
\&_add_month,
\&_add_day,
\&_add_hour,
\&_add_minute,
\&_fractional_second,
\&_do_resolution
],
},
{
#hhmmssZ 232030Z
#hh:mm:ssZ 23:20:30Z
length => [ qw( 7 8 9 10 ) ],
regex => qr/^ T?? (\d\d) :?? (\d\d) :?? (\d\d) Z $/x,
params => [ qw( hour minute second ) ],
extra => { time_zone => 'UTC' },
postprocess => [
\&_add_year,
\&_add_month,
\&_add_day,
\&_do_resolution
],
},
{
#hhmmss.ssZ 232030.5Z
#hh:mm:ss.ssZ 23:20:30.5Z
regex => qr/^ T?? (\d\d) :?? (\d\d) :?? (\d\d) [\.,] (\d+) Z $/x,
params => [ qw( hour minute second nanosecond) ],
extra => { time_zone => 'UTC' },
postprocess => [
\&_add_year,
\&_add_month,
\&_add_day,
\&_fractional_second,
\&_do_resolution
],
},
{
#hhmmZ 2320Z
#hh:mmZ 23:20Z
length => [ qw( 5 6 7 ) ],
regex => qr/^ T?? (\d\d) :?? (\d\d) Z $/x,
params => [ qw( hour minute ) ],
extra => { time_zone => 'UTC' },
postprocess => [
\&_add_year,
\&_add_month,
\&_add_day,
\&_do_resolution
],
},
{
#hhZ 23Z
length => [ qw( 3 4 ) ],
regex => qr/^ T?? (\d\d) Z $/x,
params => [ qw( hour ) ],
extra => { time_zone => 'UTC' },
postprocess => [
\&_add_year,
\&_add_month,
\&_add_day,
\&_do_resolution
],
},
{
# TOBY - modified
#hhmmss[+-]hhmm 152746+0100 152746-0500
#hh:mm:ss[+-]hh:mm 15:27:46+01:00 15:27:46-05:00
length => [ qw( 11 12 14 15 ) ],
regex => qr/^ T?? (\d\d) :?? (\d\d) :?? (\d\d)
([+-] \d\d (?: :?? \d\d)?) $/x,
params => [ qw( hour minute second time_zone ) ],
postprocess => [
\&_add_year,
\&_add_month,
\&_add_day,
\&_normalize_offset,
\&_do_resolution
],
},
{
# TOBY - modified
#hhmmss.ss[+-]hhmm 152746.5+0100 152746.5-0500
#hh:mm:ss.ss[+-]hh:mm 15:27:46.5+01:00 15:27:46.5-05:00
regex => qr/^ T?? (\d\d) :?? (\d\d) :?? (\d\d) [\.,] (\d+)
([+-] \d\d (?: :?? \d\d)?) $/x,
params => [ qw( hour minute second nanosecond time_zone ) ],
postprocess => [
\&_add_year,
\&_add_month,
\&_add_day,
\&_fractional_second,
\&_normalize_offset,
\&_do_resolution
],
},
{
#hhmmss[+-]hh 152746+01 152746-05
#hh:mm:ss[+-]hh 15:27:46+01 15:27:46-05
length => [ qw( 9 10 11 12 ) ],
regex => qr/^ T?? (\d\d) :?? (\d\d) :?? (\d\d)
([+-] \d\d) $/x,
params => [ qw( hour minute second time_zone ) ],
postprocess => [
\&_add_year,
\&_add_month,
\&_add_day,
\&_normalize_offset,
\&_do_resolution
],
},
{
#YYYYMMDDThhmmss 19850412T101530
#YYYY-MM-DDThh:mm:ss 1985-04-12T10:15:30
# length => [ qw( 15 19 ) ],
regex => qr/^ ((?:\-|\+\d+)?\d{4}) -?? (\d\d) -?? (\d\d)
T (\d\d) :?? (\d\d) :?? (\d\d) $/x,
params => [ qw( year month day hour minute second ) ],
extra => { time_zone => 'floating' },
postprocess => \&_do_resolution
},
{
#YYYYMMDDThhmmss.ss 19850412T101530.123
#YYYY-MM-DDThh:mm:ss.ss 1985-04-12T10:15:30.123
regex => qr/^ ((?:\-|\+\d+)?\d{4}) -?? (\d\d) -?? (\d\d)
T (\d\d) :?? (\d\d) :?? (\d\d) [\.,] (\d+) $/x,
params => [ qw( year month day hour minute second nanosecond ) ],
extra => { time_zone => 'floating' },
postprocess => [
\&_fractional_second,
\&_do_resolution
],
},
{
#YYYYMMDDThhmmssZ 19850412T101530Z
#YYYY-MM-DDThh:mm:ssZ 1985-04-12T10:15:30Z
# length => [ qw( 16 20 ) ],
regex => qr/^ ((?:\-|\+\d+)?\d{4}) -?? (\d\d) -?? (\d\d)
T (\d\d) :?? (\d\d) :?? (\d\d) Z $/x,
params => [ qw( year month day hour minute second ) ],
extra => { time_zone => 'UTC' },
postprocess => \&_do_resolution
},
{
#YYYYMMDDThhmmss.ssZ 19850412T101530.5Z 20041020T101530.5Z
#YYYY-MM-DDThh:mm:ss.ssZ 1985-04-12T10:15:30.5Z 1985-04-12T10:15:30.5Z
regex => qr/^ ((?:\-|\+\d+)?\d{4}) -?? (\d\d) -?? (\d\d)
T?? (\d\d) :?? (\d\d) :?? (\d\d) [\.,] (\d+)
Z$/x,
params => [ qw( year month day hour minute second nanosecond ) ],
extra => { time_zone => 'UTC' },
postprocess => [
\&_fractional_second,
\&_do_resolution
],
},
{
# TOBY - added
#YYYYMMDDThh[+-]hhmm 19850412T10+0100 20041020T10-0500
#YYYY-MM-DDThh[+-]hh:mm 1985-04-12T10+01:00 1985-04-12T10-05:00
regex => qr/^ ((?:\-|\+\d+)?\d{4}) -?? (\d\d) -?? (\d\d)
T?? (\d\d)
([+-] \d\d (?: :?? \d\d)?) $/x,
params => [ qw( year month day hour time_zone ) ],
postprocess => [
\&_normalize_offset,
\&_do_resolution
],
},
{
# TOBY - added
#YYYYMMDDThhmm[+-]hhmm 19850412T1015+0100 20041020T1015-0500
#YYYY-MM-DDThh:mm[+-]hh:mm 1985-04-12T10:15+01:00 1985-04-12T10:15-05:00
regex => qr/^ ((?:\-|\+\d+)?\d{4}) -?? (\d\d) -?? (\d\d)
T?? (\d\d) :?? (\d\d)
([+-] \d\d (?: :?? \d\d)?) $/x,
params => [ qw( year month day hour minute time_zone ) ],
postprocess => [
\&_normalize_offset,
\&_do_resolution
],
},
{
# TOBY - modified
#YYYYMMDDThhmmss[+-]hhmm 19850412T101530+0400
#YYYY-MM-DDThh:mm:ss[+-]hh:mm 1985-04-12T10:15:30+04:00
# length => [ qw( 20 25 ) ],
regex => qr/^ ((?:\-|\+\d+)?\d{4}) -?? (\d\d) -?? (\d\d)
T (\d\d) :?? (\d\d) :?? (\d\d) ([+-] \d\d (?: :?? \d\d)?) $/x,
params => [ qw( year month day hour minute second time_zone ) ],
postprocess => [\&_normalize_offset,\&_do_resolution]
},
{
# TOBY - modified
#YYYYMMDDThhmmss.ss[+-]hhmm 19850412T101530.5+0100 20041020T101530.5-0500
#YYYY-MM-DDThh:mm:ss.ss[+-]hh:mm 1985-04-12T10:15:30.5+01:00 1985-04-12T10:15:30.5-05:00
regex => qr/^ ((?:\-|\+\d+)?\d{4}) -?? (\d\d) -?? (\d\d)
T?? (\d\d) :?? (\d\d) :?? (\d\d) [\.,] (\d+)
([+-] \d\d (?: :?? \d\d)?) $/x,
params => [ qw( year month day hour minute second nanosecond time_zone ) ],
postprocess => [
\&_fractional_second,
\&_normalize_offset,
\&_do_resolution
],
},
{
#YYYYMMDDThhmmss[+-]hh 19850412T101530+04
#YYYY-MM-DDThh:mm:ss[+-]hh 1985-04-12T10:15:30+04
# length => [ qw( 18 22 ) ],
regex => qr/^ ((?:\-|\+\d+)?\d{4}) -?? (\d\d) -?? (\d\d)
T (\d\d) :?? (\d\d) :?? (\d\d) ([+-] \d\d) $/x,
params => [ qw( year month day hour minute second time_zone ) ],
postprocess => [\&_normalize_offset, \&_do_resolution]
},
{
#YYYYMMDDThhmm 19850412T1015
#YYYY-MM-DDThh:mm 1985-04-12T10:15
# length => [ qw( 13 16 ) ],
regex => qr/^ ((?:\-|\+\d+)?\d{4}) -?? (\d\d) -?? (\d\d)
T (\d\d) :?? (\d\d) $/x,
params => [ qw( year month day hour minute ) ],
extra => { time_zone => 'floating' },
postprocess => [\&_normalize_offset, \&_do_resolution]
},
{
#YYYYDDDThhmmZ 1985102T1015Z
#YYYY-DDDThh:mmZ 1985-102T10:15Z
# length => [ qw( 13 15 ) ],
regex => qr/^ ((?:\-|\+\d+)?\d{4}) -?? (\d{3}) T
(\d\d) :?? (\d\d) Z $/x,
params => [ qw( year day_of_year hour minute ) ],
extra => { time_zone => 'UTC' },
constructor => [ 'DateTime', 'from_day_of_year' ],
postprocess => [\&_normalize_offset, \&_do_resolution]
},
{
# TOBY - modified
#YYYYWwwDThhmm[+-]hhmm 1985W155T1015+0400
#YYYY-Www-DThh:mm[+-]hh 1985-W15-5T10:15+04
# length => [ qw( 18 19 ) ],
regex => qr/^ ((?:\-|\+\d+)?\d{4}) -?? W (\d\d) -?? (\d)
T (\d\d) :?? (\d\d) ([+-] \d\d (?: :?? \d\d)?) $/x,
params => [ qw( year week day_of_year hour minute time_zone) ],
postprocess => [ \&_normalize_week, \&_normalize_offset, \&_do_resolution ],
constructor => [ 'DateTime', 'from_day_of_year' ],
},
],
parse_time => [
{
#hhmmss 232050
length => [ qw( 6 7 ) ],
regex => qr/^ T?? (\d\d) (\d\d) (\d\d) $/x,
params => [ qw( hour minute second ) ],
postprocess => [
\&_add_year,
\&_add_month,
\&_add_day,
\&_do_resolution
],
},
{
#hhmm 2320
length => [ qw( 4 5 ) ],
regex => qr/^ T?? (\d\d) (\d\d) $/x,
params => [ qw( hour minute ) ],
postprocess => [
\&_add_year,
\&_add_month,
\&_add_day,
\&_do_resolution
],
},
{
#hh 23
length => [ qw( 2 3 ) ],
regex => qr/^ T?? (\d\d) $/x,
params => [ qw( hour ) ],
postprocess => [
\&_add_year,
\&_add_month,
\&_add_day,
\&_do_resolution
],
},
{
#-mmss -2050
length => 5,
regex => qr/^ - (\d\d) (\d\d) $/x,
params => [ qw( minute second ) ],
postprocess => [
\&_add_year,
\&_add_month,
\&_add_day,
\&_add_hour,
\&_do_resolution
],
},
{
#-mm -20
length => 3,
regex => qr/^ - (\d\d) $/x,
params => [ qw( minute ) ],
postprocess => [
\&_add_year,
\&_add_month,
\&_add_day,
\&_add_hour,
\&_do_resolution
],
},
{
#--ss --50
length => 4,
regex => qr/^ -- (\d\d) $/x,
params => [ qw( second ) ],
postprocess => [
\&_add_year,
\&_add_month,
\&_add_day,
\&_add_hour,
\&_add_minute,
\&_do_resolution
],
},
],
}
);
sub _fix_1_digit_year {
my %p = @_;
no strict 'refs';
my $year = ( $p{ self }{ base_datetime } || DateTime->now )->year;
use strict;
$year =~ s/.$//;
$p{ parsed }{ year } = $year . $p{ parsed }{ year };
return 1;
}
sub _fix_2_digit_year {
my %p = @_;
# this is a mess because of the need to support parse_* being called
# as a class method
no strict 'refs';
if ( exists $p{ self }{ legacy_year } ) {
if ( $p{ self }{ legacy_year } ) {
my $cutoff = exists $p{ self }{ cut_off_year }
? $p{ self }{ cut_off_year } : $p{ self }->DefaultCutOffYear;
$p{ parsed }{ year } += $p{ parsed }{ year } > $cutoff ? 1900 : 2000;
} else {
my $century = ( $p{ self }{ base_datetime } || DateTime->now )->strftime( '%C' );
$p{ parsed }{ year } += $century * 100;
}
} else {
my $cutoff = exists $p{ self }{ cut_off_year }
? $p{ self }{ cut_off_year } : $p{ self }->DefaultCutOffYear;
$p{ parsed }{ year } += $p{ parsed }{ year } > $cutoff ? 1900 : 2000;
}
use strict;
return 1;
}
sub _add_minute {
my %p = @_;
no strict 'refs';
$p{ parsed }{ minute } = ( $p{ self }{ base_datetime } || DateTime->now )->minute;
$p{ self }{ missing_details }{ minute } = 1;
use strict;
return 1;
}
sub _add_hour {
my %p = @_;
no strict 'refs';
$p{ parsed }{ hour } = ( $p{ self }{ base_datetime } || DateTime->now )->hour;
$p{ self }{ missing_details }{ hour } = 1;
use strict;
return 1;
}
sub _add_day {
my %p = @_;
no strict 'refs';
$p{ parsed }{ day } = ( $p{ self }{ base_datetime } || DateTime->now )->day;
$p{ self }{ missing_details }{ day } = 1;
use strict;
return 1;
}
sub _add_week {
my %p = @_;
no strict 'refs';
$p{ parsed }{ week } = ( $p{ self }{ base_datetime } || DateTime->now )->week;
$p{ self }{ missing_details }{ week } = 1;
use strict;
return 1;
}
sub _add_month {
my %p = @_;
no strict 'refs';
$p{ parsed }{ month } = ( $p{ self }{ base_datetime } || DateTime->now )->month;
$p{ self }{ missing_details }{ month } = 1;
use strict;
return 1;
}
sub _add_year {
my %p = @_;
no strict 'refs';
$p{ parsed }{ year } = ( $p{ self }{ base_datetime } || DateTime->now )->year;
$p{ self }{ missing_details }{ year } = 1;
use strict;
return 1;
}
sub _fractional_second {
my %p = @_;
$p{ parsed }{ nanosecond } = ".$p{ parsed }{ nanosecond }" * 10**9;
return 1;
}
sub _fractional_minute {
my %p = @_;
$p{ parsed }{ second } = ".$p{ parsed }{ second }" * 60;
return 1;
}
sub _fractional_hour {
my %p = @_;
$p{ parsed }{ minute } = ".$p{ parsed }{ minute }" * 60;
return 1;
}
sub _normalize_offset {
my %p = @_;
return 1 unless (defined $p{ parsed }{ time_zone });
$p{ parsed }{ time_zone } =~ s/://;
if( length $p{ parsed }{ time_zone } == 3 ) {
$p{ parsed }{ time_zone } .= '00';
}
elsif( length $p{ parsed }{ time_zone } == 2 ) {
$p{ parsed }{ time_zone } .= '000';
}
return 1;
}
sub _normalize_week {
my %p = @_;
# from section 4.3.2.2
# "A calendar week is identified within a calendar year by the calendar
# week number. This is its ordinal position within the year, applying the
# rule that the first calendar week of a year is the one that includes the
# first Thursday of that year and that the last calendar week of a
# calendar year is the week immediately preceding the first calendar week
# of the next calendar year."
# this make it oh so fun to covert an ISO week number to a count of days
my $dt = DateTime->new(
year => $p{ parsed }{ year },
);
if ( $dt->week_number == 1 ) {
$p{ parsed }{ week } -= 1;
}
$p{ parsed }{ week } *= 7;
if( defined $p{ parsed }{ day_of_year } ) {
$p{ parsed }{ week } -= $dt->day_of_week -1;
}
$p{ parsed }{ day_of_year } += $p{ parsed }{ week };
delete $p{ parsed }{ week };
return 1;
}
sub _normalize_century {
my %p = @_;
$p{ parsed }{ year } .= '01';
return 1;
}
# TOBY - new preprocessing function, primarily to handle HTML5 date formats.
sub _do_whitespace {
my %args = @_;
my ($date, $p) = @args{qw( input parsed )};
# Normalise white space.
$date =~ s/(^\s+|\s+$)//g;
$date =~ s/\s+/ /g;
# HTML 5 split date with whitespace between Date and Time
$date =~ s/\-(\d\d?)\s(\d\d?)\:/sprintf("\-%02dT%02d\:", $1, $2)/ex;
# Also white space before the timezone
if ($date =~ / ([Z\+\-])([0-9\:]*)$/i)
{
# And the time zone may be weird and need reformatting
my $sign = $1;
my $nums = $2;
my $tz = '';
if (uc($sign) eq 'Z')
{ $tz = 'Z'; }
elsif ($nums =~ /^(\d{0,2})$/)
{ $tz = sprintf('%s%02d00', $sign, $1); }
elsif ($nums =~ /^(\d{1,2})(\d{2})?$/)
{ $tz = sprintf('%s%02d%02d', $sign, $1, $2); }
elsif ($nums =~ /^(\d{0,2})\:(\d{0,2})?$/)
{ $tz = sprintf('%s%02d%02d', $sign, $1, $2); }
$date =~ s/ ([Z\+\-])([0-9\:]*)$/$tz/;
}
return $date;
}
# TOBY - postprocessing function for *all* datetime formats, recording resolution
sub _do_resolution {
my %p = @_;
my $res;
if (defined $p{ parsed }{ nanosecond })
{ $res = 'nanosecond'; }
elsif (defined $p{ parsed }{ second })
{ $res = 'second'; }
elsif (defined $p{ parsed }{ minute })
{ $res = 'minute'; }
elsif (defined $p{ parsed }{ hour })
{ $res = 'hour'; }
elsif (defined $p{ parsed }{ day })
{ $res = 'day'; }
elsif (defined $p{ parsed }{ month })
{ $res = 'month'; }
elsif (defined $p{ parsed }{ year })
{ $res = 'year'; }
else
{ $res = 'second'; }
if (defined $p{ parsed }{ hour } && ($p{ parsed }{ hour }==24))
{
$res = 'end';
foreach my $x (qw(nanosecond second minute hour))
{
$p{ parsed }{ $x } = 0;
}
}
$p{ self }{ resolution } = $res;
$p{ self }{ time_zone }
= (defined $p{ parsed }{ time_zone })
? 'time_zone'
: undef;
return 1;
}
1;