DateTime-Format-Strptime-1.54/0000775000175000017500000000000012126724626016044 5ustar autarchautarchDateTime-Format-Strptime-1.54/MANIFEST0000644000175000017500000000063012126724626017172 0ustar autarchautarchChanges INSTALL LICENSE MANIFEST META.json META.yml Makefile.PL README dist.ini lib/DateTime/Format/Strptime.pm t/001_load.t t/002_dates.t t/003_every.t t/004_locale_defaults.t t/005_croak.t t/006_locales.t t/007_edge.t t/008_epoch.t t/009_regexp.t t/author-001_all_locales.t t/release-eol.t t/release-no-tabs.t t/release-pod-coverage.t t/release-pod-linkcheck.t t/release-pod-spell.t t/release-pod-syntax.t DateTime-Format-Strptime-1.54/t/0000775000175000017500000000000012126724626016307 5ustar autarchautarchDateTime-Format-Strptime-1.54/t/release-pod-spell.t0000644000175000017500000000140612126724626022010 0ustar autarchautarch BEGIN { unless ($ENV{RELEASE_TESTING}) { require Test::More; Test::More::plan(skip_all => 'these tests are for release candidate testing'); } } use strict; use warnings; use Test::More 0.88; eval "use Test::Spelling"; plan skip_all => "Test::Spelling required for testing POD coverage" if $@; my @stopwords; for () { chomp; push @stopwords, $_ unless /\A (?: \# | \s* \z)/msx; # skip comments, whitespace } add_stopwords(@stopwords); set_spell_cmd('aspell list -l en'); # This prevents a weird segfault from the aspell command - see # https://bugs.launchpad.net/ubuntu/+source/aspell/+bug/71322 local $ENV{LC_ALL} = 'C'; all_pod_files_spelling_ok(); __DATA__ Measham POSIX Rolsky STRPTIME errmsg formatter strf strp strptime DateTime-Format-Strptime-1.54/t/006_locales.t0000644000175000017500000000671112126724626020506 0ustar autarchautarch#!perl -w # t/002_basic.t - check module dates in various formats use Test::More 0.88; #use Test::More qw/no_plan/; use DateTime::Format::Strptime; use DateTime; my @locales = qw/en ga pt de/; #diag("\nChecking Day Names"); my $pattern = "%Y-%m-%d %A"; foreach my $locale (@locales) { foreach my $day ( 1 .. 7 ) { my $dt = DateTime->now( locale => $locale )->set( day => $day ); my $input = $dt->strftime($pattern); eval { $strptime = DateTime::Format::Strptime->new( pattern => $pattern, locale => $locale, on_error => 'croak', ); }; ok( $@ eq '', "Constructor with Day Name" ); my $parsed; eval { $parsed = $strptime->parse_datetime($input); } unless $@; diag("[$@]") if $@ ne ''; ok( $@ eq '', "Parsed with Day Name" ); is( $parsed->strftime($pattern), $input, "Matched with Day Name" ); } # diag( $locale ); } #diag("\nChecking Month Names"); $pattern = "%Y-%m-%d %B"; foreach my $locale (@locales) { foreach my $month ( 1 .. 12 ) { my $dt = DateTime->now( locale => $locale ) ->set( month => $month, day => 20 ); my $input = $dt->strftime($pattern); eval { $strptime = DateTime::Format::Strptime->new( pattern => $pattern, locale => $locale, on_error => 'croak', ); }; ok( $@ eq '', "Constructor with Month Name" ); my $parsed; eval { $parsed = $strptime->parse_datetime($input); } unless $@; diag("[$@]") if $@ ne ''; ok( $@ eq '', "Parsed with Month Name" ); is( $parsed->strftime($pattern), $input, "Matched with Month Name" ); } # diag( $locale ); } #diag("\nChecking AM/PM tokens"); $pattern = "%Y-%m-%d %H:%M %p"; foreach my $locale (@locales) { foreach my $hour ( 11, 12 ) { my $dt = DateTime->now( locale => $locale )->set( hour => $hour ); my $input = $dt->strftime($pattern); eval { $strptime = DateTime::Format::Strptime->new( pattern => $pattern, locale => $locale, on_error => 'croak', ); }; ok( $@ eq '', "Constructor with Meridian" ); my $parsed; eval { $parsed = $strptime->parse_datetime($input); } unless $@; diag("[$@]") if $@ ne ''; ok( $@ eq '', "Parsed with Meridian" ); is( $parsed->strftime($pattern), $input, "Matched with Meridian" ); } # diag( $locale ); } #diag("\nChecking format_datetime honors strptime's locale rather than the dt's"); { # Create a parser that has locale 'fr' my $dmy_format = new DateTime::Format::Strptime( pattern => '%d/%m/%Y', locale => 'fr' ); is( $dmy_format->locale, 'fr' ); # So, therefore, will a $dt created using it. my $dt = $dmy_format->parse_datetime('03/08/2004'); is( $dt->locale->id, 'fr' ); # Now we create a new strptime for formatting, but in a different locale my $pt_format = new DateTime::Format::Strptime( pattern => '%B/%Y', locale => 'pt' ); is( $pt_format->locale, 'pt' ); my $string = $pt_format->format_datetime($dt); # Make sure the format honored the locale in the strptime is( $string, "agosto/2004" ); # Make sure the datetime, however, retained its own locale is( $dt->locale->id, 'fr' ) } done_testing(); DateTime-Format-Strptime-1.54/t/001_load.t0000644000175000017500000000043612126724626017774 0ustar autarchautarch# -*- perl -*- # t/001_load.t - check module loading and create testing directory use Test::More 0.88; BEGIN { use_ok('DateTime::Format::Strptime'); } my $object = DateTime::Format::Strptime->new( pattern => '%T' ); isa_ok( $object, 'DateTime::Format::Strptime' ); done_testing(); DateTime-Format-Strptime-1.54/t/003_every.t0000644000175000017500000000574712126724626020223 0ustar autarchautarch# t/002_basic.t - check module dates in various formats use Test::More 0.88; use DateTime::Format::Strptime; { my $object = DateTime::Format::Strptime->new( pattern => '%D', time_zone => 'Australia/Melbourne', locale => 'en_AU', diagnostic => 0, ); my $epoch = DateTime->new( year => 2003, month => 11, day => 5, hour => 23, minute => 34, second => 45, time_zone => 'Australia/Melbourne' )->epoch; my @tests = ( # Compound Patterns [ '%T', '23:34:45', '24-hour Time' ], [ '%r', '11:34:45 PM', '12-hour Time' ], [ '%R', '23:34', 'Simple 24-hour Time' ], [ '%D', '11/30/03', 'American Style Date' ], [ '%F', '2003-11-30', 'ISO Style Date' ], [ '%a %b %B %C %d %e %h %H %I %j %k %l %m %M %n %N %O %p %P %S %U %u %w %W %y %Y %s %G %g %z %Z %%Y %%', "Wed Nov November 20 05 5 Nov 23 11 309 23 11 11 34 \n 123456789 Australia/Melbourne PM pm 45 44 3 3 44 03 2003 $epoch 2003 03 +1100 EST %Y %", "Every token at once" ], [ '%{year}', '2003', 'Extended strftime %{} matching' ], ); foreach (@tests) { my ( $pattern, $data, $name ) = @$_; $name ||= $pattern; #print "-- $pattern ($data) --\n"; $object->pattern($pattern); #print "\n" . $object->pattern . "\n" . $object->{parser}; #print $object->parse_datetime( $data )->strftime("%Y-%m-%d %H:%M:%S\n"); #print $object->parse_datetime( $data )->strftime("Got: $pattern\n"); is( $object->format_datetime( $object->parse_datetime($data) ), $data, $name ); } } { my $object = DateTime::Format::Strptime->new( pattern => '%D', time_zone => 'Australia/Melbourne', locale => 'en_AU', diagnostic => 0, ); my $epoch = DateTime->new( year => 2003, month => 11, day => 5, hour => 23, minute => 34, second => 45, time_zone => 'Australia/Melbourne' )->epoch; my @tests = ( # Compound Patterns [ '%T', '23:34:45', '24-hour Time' ], [ '%r', '11:34:45 PM', '12-hour Time' ], [ '%R', '23:34', 'Simple 24-hour Time' ], [ '%D', '11/30/03', 'American Style Date' ], [ '%F', '2003-11-30', 'ISO Style Date' ], [ '%a %b %B %C %d %e %h %H %I %j %k %l %m %M %n %N %p %P %S %U %u %w %W %y %Y %s %G %g %z %Z %%', "Wed Nov November 20 05 5 Nov 23 11 309 23 11 11 34 \n 123456789 PM pm 45 44 3 3 44 03 2003 $epoch 2003 03 +1100 EST %", "Every token at once" ], [ '%{year}', '2003', 'Extended strftime %{} matching' ], ); foreach (@tests) { my ( $pattern, $data, $name ) = @$_; $name ||= $pattern; $object->pattern($pattern); is( $object->format_datetime( $object->parse_datetime($data) ), $data, $name ); } } done_testing(); DateTime-Format-Strptime-1.54/t/release-no-tabs.t0000644000175000017500000000045012126724626021452 0ustar autarchautarch BEGIN { unless ($ENV{RELEASE_TESTING}) { require Test::More; Test::More::plan(skip_all => 'these tests are for release candidate testing'); } } use strict; use warnings; use Test::More; eval 'use Test::NoTabs'; plan skip_all => 'Test::NoTabs required' if $@; all_perl_files_ok(); DateTime-Format-Strptime-1.54/t/005_croak.t0000644000175000017500000001177212126724626020165 0ustar autarchautarch# t/004_croak.t - make sure we croak when we should use Test::More 0.88; use DateTime::Format::Strptime; # 1..2 my $return; eval { $return = DateTime::Format::Strptime->new( pattern => '%Y' ) }; isa_ok( $return, 'DateTime::Format::Strptime', 'Legal Pattern in constructor should return object and not croak' ); is( $@, '', "Croak message should be empty" ); # 3..4 eval { DateTime::Format::Strptime->new( pattern => '%Y %Q' ) }; isnt( $@, undef, "Illegal pattern in constructor should croak" ); is( substr( $@, 0, 42 ), "Unidentified token in pattern: %Q in %Y %Q", "Croak message should reflect illegal pattern" ); #-------------------------------------------------------------------------------- #diag("\nTurned Croak Off"); my $object = DateTime::Format::Strptime->new( pattern => '%Y %D', time_zone => 'Australia/Melbourne', locale => 'en_AU', on_error => 'undef', diagnostic => 0, ); # 5..6 is( $object->pattern('%Y %D'), '%Y %D', 'Legal Pattern in pattern() should return the pattern' ); is( $object->{errmsg}, undef, "Error message should be undef" ); # 7..8 is( $object->pattern("%Q"), undef, "Illegal Pattern should return undef" ); is( $object->{errmsg}, 'Unidentified token in pattern: %Q in %Q. Leaving old pattern intact.', "Error message should reflect illegal pattern" ); # 9..10 is( $object->pattern("%{gumtree}"), undef, "Non-existing DateTime call should return undef" ); is( $object->{errmsg}, 'Unidentified token in pattern: %{gumtree} in %{gumtree}. Leaving old pattern intact.', "Error message should reflect illegal pattern" ); # Make sure pattern goes back to being useful $object->pattern('%Y %D'); # 11..12 is( $object->parse_datetime("Not a datetime"), undef, "Non-matching date time string should return undef" ); is( $object->{errmsg}, 'Your datetime does not match your pattern.', "Error message should reflect non-matching datetime" ); # 13..14 is( $object->parse_datetime("2002 11/30/03"), undef, "Ambiguous date time string should return undef" ); is( $object->{errmsg}, 'Your two year values (03 and 2002) do not match.', "Error message should reflect Ambiguous date time string" ); #-------------------------------------------------------------------------------- #diag("\nTurned Croak On"); $object = DateTime::Format::Strptime->new( pattern => '%Y %D', time_zone => 'Australia/Melbourne', locale => 'en_AU', on_error => 'croak', diagnostic => 0, ); { # Make warn die so $@ is set. There's probably a better way. local $SIG{__WARN__} = sub { die "WARN: $_[0]" }; eval { $object->pattern("%Q") }; } # 15..16 isnt( $@, '', "Illegal Pattern should carp" ); is( substr( $@, 0, 74 ), 'WARN: Unidentified token in pattern: %Q in %Q. Leaving old pattern intact.', "Croak message should reflect illegal pattern" ); # 17..18 eval { $object->parse_datetime("Not a datetime") }; isnt( $@, '', "Non-matching date time string should croak" ); is( substr( $@, 0, 42 ), "Your datetime does not match your pattern.", "Croak message should reflect non-matching datetime" ); # 19..20 eval { $object->parse_datetime("2002 11/30/03") }; isnt( $@, '', "Ambiguous date time string should croak" ); is( substr( $@, 0, 48 ), "Your two year values (03 and 2002) do not match.", "Croak message should reflect Ambiguous date time string" ); #-------------------------------------------------------------------------------- #diag("\nTurned Croak to Sub"); $object = DateTime::Format::Strptime->new( pattern => '%Y %D', time_zone => 'Australia/Melbourne', locale => 'en_AU', on_error => sub { $_[0]->{errmsg} = 'Oops! Teehee! ' . $_[1]; 1 }, diagnostic => 0, ); # 21..22 is( $object->pattern('%Y %D'), '%Y %D', 'Legal Pattern in pattern() should return the pattern' ); is( $object->{errmsg}, undef, "Error message should be undef" ); # 23..24 is( $object->pattern("%Q"), undef, "Illegal Pattern should return undef" ); is( $object->{errmsg}, 'Oops! Teehee! Unidentified token in pattern: %Q in %Q. Leaving old pattern intact.', "Error message should reflect illegal pattern" ); # 25..26 is( $object->pattern("%{gumtree}"), undef, "Non-existing DateTime call should return undef" ); is( $object->{errmsg}, 'Oops! Teehee! Unidentified token in pattern: %{gumtree} in %{gumtree}. Leaving old pattern intact.', "Error message should reflect illegal pattern" ); # Make sure pattern goes back to being useful $object->pattern('%Y %D'); # 27..28 is( $object->parse_datetime("Not a datetime"), undef, "Non-matching date time string should return undef" ); is( $object->{errmsg}, 'Oops! Teehee! Your datetime does not match your pattern.', "Error message should reflect non-matching datetime" ); # 29..30 is( $object->parse_datetime("2002 11/30/03"), undef, "Ambiguous date time string should return undef" ); is( $object->{errmsg}, 'Oops! Teehee! Your two year values (03 and 2002) do not match.', "Error message should reflect Ambiguous date time string" ); done_testing(); DateTime-Format-Strptime-1.54/t/002_dates.t0000644000175000017500000000524612126724626020162 0ustar autarchautarch#!perl -w # t/002_basic.t - check module dates in various formats use Test::More 0.88; use DateTime::Format::Strptime; use DateTime; use DateTime::TimeZone; my $object = DateTime::Format::Strptime->new( pattern => '%D', # time_zone => 'Australia/Melbourne', diagnostic => 1, on_error => 'croak', ); my @tests = ( # Simple dates [ '%Y-%m-%d', '1998-12-31' ], [ '%y-%m-%d', '98-12-31' ], [ '%Y years, %j days', '1998 years, 312 days' ], [ '%b %d, %Y', 'Jan 24, 2003' ], [ '%B %d, %Y', 'January 24, 2003' ], # Simple times [ '%H:%M:%S', '23:45:56' ], [ '%l:%M:%S %p', '11:34:56 PM' ], # With Nanoseconds [ '%H:%M:%S.%N', '23:45:56.123456789' ], [ '%H:%M:%S.%6N', '23:45:56.123456' ], [ '%H:%M:%S.%3N', '23:45:56.123' ], # Complex dates [ '%Y;%j = %Y-%m-%d', '2003;056 = 2003-02-25' ], [ q|%d %b '%y = %Y-%m-%d|, q|25 Feb '03 = 2003-02-25| ], # Leading spaces [ '%e-%b-%Y %T %z', '13-Jun-2010 09:20:47 -0400' ], [ '%e-%b-%Y %T %z', ' 3-Jun-2010 09:20:47 -0400' ], ); foreach (@tests) { my ( $pattern, $data, $expect ) = @$_; $expect ||= $data; $object->pattern($pattern); is( $object->format_datetime( $object->parse_datetime($data) ), $expect, $pattern ); } SKIP: { skip "You don't have the latest DateTime. Older version have a bug whereby 12am and 12pm are shown as 0am and 0pm. You should upgrade.", 1 unless $DateTime::VERSION >= 0.11; $object->pattern('%l:%M:%S %p'); is( $object->format_datetime( $object->parse_datetime('12:34:56 AM') ), '12:34:56 AM', '%l:%M:%S %p' ); } # Timezones SKIP: { skip "You don't have the latest DateTime::TimeZone. Older versions don't display all time zone information. You should upgrade.", 3 unless $DateTime::TimeZone::VERSION >= 0.13; $object->pattern('%H:%M:%S %z'); is( $object->format_datetime( $object->parse_datetime('23:45:56 +1000') ), '23:45:56 +1000', '%H:%M:%S %z' ); $object->pattern('%H:%M:%S %Z'); is( $object->format_datetime( $object->parse_datetime('23:45:56 AEST') ), '23:45:56 +1000', '%H:%M:%S %Z' ); $object->pattern('%H:%M:%S %z %Z'); is( $object->format_datetime( $object->parse_datetime('23:45:56 +1000 AEST') ), '23:45:56 +1000 +1000', '%H:%M:%S %z %Z' ); } $object->time_zone('Australia/Perth'); $object->pattern('%Y %H:%M:%S %Z'); is( $object->format_datetime( $object->parse_datetime('2003 23:45:56 MDT') ), '2003 13:45:56 WST', $object->pattern ); done_testing(); DateTime-Format-Strptime-1.54/t/release-pod-linkcheck.t0000644000175000017500000000077512126724626022634 0ustar autarchautarch#!perl BEGIN { unless ($ENV{RELEASE_TESTING}) { require Test::More; Test::More::plan(skip_all => 'these tests are for release candidate testing'); } } use strict; use warnings; use Test::More; foreach my $env_skip ( qw( SKIP_POD_LINKCHECK ) ){ plan skip_all => "\$ENV{$env_skip} is set, skipping" if $ENV{$env_skip}; } eval "use Test::Pod::LinkCheck"; if ( $@ ) { plan skip_all => 'Test::Pod::LinkCheck required for testing POD'; } else { Test::Pod::LinkCheck->new->all_pod_ok; } DateTime-Format-Strptime-1.54/t/release-eol.t0000644000175000017500000000047612126724626020676 0ustar autarchautarch BEGIN { unless ($ENV{RELEASE_TESTING}) { require Test::More; Test::More::plan(skip_all => 'these tests are for release candidate testing'); } } use strict; use warnings; use Test::More; eval 'use Test::EOL'; plan skip_all => 'Test::EOL required' if $@; all_perl_files_ok({ trailing_whitespace => 1 }); DateTime-Format-Strptime-1.54/t/004_locale_defaults.t0000644000175000017500000000373512126724626022213 0ustar autarchautarch#!perl -w # t/004_locale_defaults.t - check module dates in various formats use Test::More 0.88; use DateTime::Format::Strptime; use DateTime; use DateTime::TimeZone; use DateTime::Locale; my $object = DateTime::Format::Strptime->new( pattern => '%c', diagnostic => 0, on_error => sub { warn @_ }, ); my @tests = ( # Australian English [ 'en_AU', '%x', '31/12/98' ], [ 'en_AU', '%X', '13:34:56' ], [ 'en_AU', '%c', 'Thu 31 Dec 1998 13:34:56 AEDT' ], # US English [ 'en_US', '%x', '12/31/1998' ], [ 'en_US', '%X', '01:34:56 PM' ], [ 'en_US', '%c', 'Thu 31 Dec 1998 01:34:56 PM MST' ], # UK English [ 'en_GB', '%x', '31/12/98' ], [ 'en_GB', '%X', '13:34:56' ], [ 'en_GB', '%c', 'Thu 31 Dec 1998 13:34:56 GMT' ], # French French [ 'fr_FR', '%x', '31/12/1998' ], [ 'fr_FR', '%X', '13:34:56' ], [ 'fr_FR', '%c', 'jeu. 31 Déc 1998 13:34:56 CEST' ], # French Generic - inherits from root locale for glibc formats [ 'fr', '%x', '12/31/98' ], [ 'fr', '%X', '13:34:56' ], [ 'fr', '%c', 'jeu. Déc 31 13:34:56 1998' ], ); foreach (@tests) { my ( $locale, $pattern, $data ) = @$_; $object->locale($locale); $object->pattern($pattern); my $datetime = $object->parse_datetime($data); unless ($datetime) { fail("Could not parse $data with $pattern for $locale") for 1..3; next; } if ( $pattern eq '%x' or $pattern eq '%c' ) { is( $datetime->year, 1998, $locale . ' : ' . $pattern . ' : year' ); is( $datetime->month, 12, $locale . ' : ' . $pattern . ' : month' ); is( $datetime->day, 31, $locale . ' : ' . $pattern . ' : day' ); } if ( $pattern eq '%X' or $pattern eq '%c' ) { is( $datetime->hour, 13, $locale . ' : ' . $pattern . ' : hour' ); is( $datetime->minute, 34, $locale . ' : ' . $pattern . ' : minute' ); is( $datetime->second, 56, $locale . ' : ' . $pattern . ' : second' ); } } done_testing(); DateTime-Format-Strptime-1.54/t/009_regexp.t0000644000175000017500000000315412126724626020357 0ustar autarchautarch#!perl -w # t/009_regexp.t - Patterns as regular expressions use Test::More 0.88; use DateTime; use DateTime::Format::Strptime; test( pattern => qr/%Y-%m-%d/, input => '2009-07-13', output => { year => 2009, month => 7, day => 13 } ); test( pattern => qr/%Y-%m-%d Static Text/, input => '2009-07-13 Static Text', output => { year => 2009, month => 7, day => 13 } ); test( pattern => qr/%Y-%m-%d \w+\s\w+/, input => '2009-07-13 Static Text', output => { year => 2009, month => 7, day => 13 } ); test( pattern => qr/^%Y-%m-%d \w+\s\w+$/, input => '2009-07-13 Static Text', output => { year => 2009, month => 7, day => 13 } ); eval { my $strptime = DateTime::Format::Strptime->new( pattern => qr/^%Y-%m-%d \s+$/, on_error => 'croak', ); my $parsed = $strptime->parse_datetime('2009-07-13 Static Text'); }; is( substr( $@, 0, 42 ), "Your datetime does not match your pattern.", "The strp pattern is OK, but the regex doesn't match the input." ); sub test { my %arg = @_; my $strptime = DateTime::Format::Strptime->new( pattern => $arg{pattern} || '%F %T', locale => $arg{locale} || 'en', time_zone => $arg{time_zone} || 'UTC', diagnostic => $arg{diagnostic} || 0, on_error => $arg{on_error} || 'undef', ); isa_ok( $strptime, 'DateTime::Format::Strptime' ); my $parsed = $strptime->parse_datetime( $arg{input} ); isa_ok( $parsed, 'DateTime' ); foreach my $k ( keys %{ $arg{output} } ) { is( $parsed->$k, $arg{output}{$k} ); } } done_testing(); DateTime-Format-Strptime-1.54/t/release-pod-syntax.t0000644000175000017500000000045012126724626022215 0ustar autarchautarch#!perl BEGIN { unless ($ENV{RELEASE_TESTING}) { require Test::More; Test::More::plan(skip_all => 'these tests are for release candidate testing'); } } use Test::More; eval "use Test::Pod 1.41"; plan skip_all => "Test::Pod 1.41 required for testing POD" if $@; all_pod_files_ok(); DateTime-Format-Strptime-1.54/t/author-001_all_locales.t0000644000175000017500000000532612126724626022632 0ustar autarchautarch BEGIN { unless ($ENV{AUTHOR_TESTING}) { require Test::More; Test::More::plan(skip_all => 'these tests are for testing by the author'); } } use strict; use warnings; use Test::More 0.88; use DateTime::Format::Strptime; use DateTime::Locale; use DateTime; my @locales = DateTime::Locale->ids; @locales = sort(@locales); diag("Checking Day Names"); my $pattern = "%Y-%m-%d %A"; foreach my $locale (@locales) { foreach my $day ( 1 .. 7 ) { my $dt = DateTime->now( locale => $locale )->set( day => $day ); my $input = $dt->strftime($pattern); my $strptime; eval { $strptime = DateTime::Format::Strptime->new( pattern => $pattern, locale => $locale, on_error => 'croak', ); }; ok( $@ eq '', "Constructor with Day Name" ); my $parsed; eval { $parsed = $strptime->parse_datetime($input); } unless $@; diag("[$@]") if $@ ne ''; ok( $@ eq '', "Parsed with Day Name" ); is( $parsed->strftime($pattern), $input, "Matched with Day Name" ); } } diag("Checking Month Names"); $pattern = "%Y-%m-%d %B"; foreach my $locale (@locales) { foreach my $month ( 1 .. 12 ) { my $dt = DateTime->now( locale => $locale )->truncate( to => 'month' ) ->set( month => $month ); my $input = $dt->strftime($pattern); my $strptime; eval { $strptime = DateTime::Format::Strptime->new( pattern => $pattern, locale => $locale, on_error => 'croak', ); }; ok( $@ eq '', "Constructor with Month Name" ); my $parsed; eval { $parsed = $strptime->parse_datetime($input); } unless $@; diag("[$@]") if $@ ne ''; ok( $@ eq '', "Parsed with Month Name" ); is( $parsed->strftime($pattern), $input, "Matched with Month Name" ); } } diag("Checking AM/PM tokens"); $pattern = "%Y-%m-%d %H:%M %p"; foreach my $locale (@locales) { foreach my $hour ( 11, 12 ) { my $dt = DateTime->now( locale => $locale )->set( hour => $hour ); my $input = $dt->strftime($pattern); my $strptime; eval { $strptime = DateTime::Format::Strptime->new( pattern => $pattern, locale => $locale, on_error => 'croak', ); }; ok( $@ eq '', "Constructor with Meridian" ); my $parsed; eval { $parsed = $strptime->parse_datetime($input); } unless $@; diag("[$@]") if $@ ne ''; ok( $@ eq '', "Parsed with Meridian" ); is( $parsed->strftime($pattern), $input, "Matched with Meridian" ); } } done_testing(); DateTime-Format-Strptime-1.54/t/release-pod-coverage.t0000644000175000017500000000072312126724626022465 0ustar autarchautarch BEGIN { unless ($ENV{RELEASE_TESTING}) { require Test::More; Test::More::plan(skip_all => 'these tests are for release candidate testing'); } } use strict; use warnings; use Test::More 0.88; eval "use Test::Pod::Coverage 1.04"; plan skip_all => "Test::Pod::Coverage 1.04 required for testing POD coverage" if $@; all_pod_coverage_ok( { trustme => [qr/^(?:format_duration|parse_duration|local_carp|local_croak)$/] } ); DateTime-Format-Strptime-1.54/t/008_epoch.t0000644000175000017500000000473712126724626020172 0ustar autarchautarch#!perl -w # t/008_epoch.t - Epoch (%s) tests use Test::More 0.88; use DateTime; use DateTime::Format::Strptime; my $time = time; # Epoch in, epoch out, now. test( pattern => "%s", time_zone => 'Asia/Manila', locale => 'en_PH', input => $time, epoch => $time, ); # is UTC recognized? test( pattern => "%a %d %b %Y %H:%M:%S %p %Z", time_zone => 'UTC', locale => 'en_US', input => "Thu 08 Jul 2010 09:49:02 AM UTC", epoch => 1278582542, ); # diag("Epoch with a no given time_zone assumes 'floating'. (Though when given an epoch, really should assume UTC ..)"); { my $parser = DateTime::Format::Strptime->new( pattern => '%s', locale => 'en', on_error => 'undef', ); isa_ok( $parser, 'DateTime::Format::Strptime' ); my $parsed = $parser->parse_datetime('1235282552'); isa_ok( $parsed, 'DateTime' ); is( $parsed->year, 2009 ); is( $parsed->month, 2 ); is( $parsed->day, 22 ); is( $parsed->hour, 6 ); is( $parsed->minute, 2 ); is( $parsed->second, 32 ); is( $parsed->nanosecond * 1, 0 ); is( $parsed->time_zone->name, 'floating' ); } # diag("Epoch with a time_zone should return the correct time for that TZ when the epoch occurs in UTC"); { my $parser = DateTime::Format::Strptime->new( pattern => '%s', locale => 'en', on_error => 'undef', time_zone => 'Asia/Manila', ); isa_ok( $parser, 'DateTime::Format::Strptime' ); my $parsed = $parser->parse_datetime('1235282552'); isa_ok( $parsed, 'DateTime' ); is( $parsed->year, 2009 ); is( $parsed->month, 2 ); is( $parsed->day, 22 ); is( $parsed->hour, 14 ); is( $parsed->minute, 2 ); is( $parsed->second, 32 ); is( $parsed->nanosecond * 1, 0 ); is( $parsed->time_zone->name, 'Asia/Manila' ); } sub test { my %arg = @_; my $strptime = DateTime::Format::Strptime->new( pattern => $arg{pattern} || '%F %T', locale => $arg{locale} || 'en', time_zone => $arg{time_zone} || 'UTC', diagnostic => $arg{diagnostic} || 0, on_error => 'undef', ); isa_ok( $strptime, 'DateTime::Format::Strptime' ); my $parsed = $strptime->parse_datetime( $arg{input} ); isa_ok( $parsed, 'DateTime' ); is( $parsed->epoch, $arg{epoch} ); } done_testing(); DateTime-Format-Strptime-1.54/t/007_edge.t0000644000175000017500000000631412126724626017770 0ustar autarchautarch#!perl -w # t/007_edge.t - these tests are for edge case bug report errors use Test::More 0.88; use DateTime; use DateTime::Format::Strptime; #diag("1.0600 - Midnight assumption"); test( pattern => "%a %b %e %T %Y", time_zone => 'Asia/Manila', locale => 'en_PH', input => 'Wed Mar 22 01:00:00 1978', epoch => '259344000', ); #diag("1.0601 - Timezone defaults to UTC .. shoudld be floating") { my $parser = DateTime::Format::Strptime->new( pattern => '%F %T', locale => 'en', on_error => 'undef', ); isa_ok( $parser, 'DateTime::Format::Strptime' ); my $parsed = $parser->parse_datetime('2005-11-05 09:33:00'); isa_ok( $parsed, 'DateTime' ); is( $parsed->time_zone->name, 'floating' ); } #diag("1.0601 - Olson Time Zones - %O"); { my $parser = DateTime::Format::Strptime->new( pattern => '%F %T %O', on_error => 'undef', ); isa_ok( $parser, 'DateTime::Format::Strptime' ); my $parsed = $parser->parse_datetime('2005-11-05 09:33:00 Australia/Melbourne'); isa_ok( $parsed, 'DateTime' ); is( $parsed->time_zone->name, 'Australia/Melbourne', 'Time zone determined from string' ); is( $parsed->epoch, '1131143580', 'Time zone applied to string' ); } #diag("1.08 - Good pattern, illegal datetime"); my $bad_input_test = DateTime::Format::Strptime->new( pattern => '%Y-%m-%d', time_zone => 'Australia/Melbourne', locale => 'en_AU', on_error => 'croak', diagnostic => 0, ); eval { $bad_input_test->parse_datetime('0000-00-00') }; isnt( $@, '', "Illegal input should carp" ); is( substr( $@, 0, 39 ), 'Datetime 0000-00-00 is not a valid date', "Croak message should reflect illegal pattern" ); #diag("1.09 - Time zones with an underscore"); { my $parser = new DateTime::Format::Strptime( pattern => '%O' ); is( $parser->parse_datetime('America/New_York')->time_zone->name, 'America/New_York' ); } #diag("1.09 - TZs in the wrong case should work (unless they have a cap in the middle of a word)"); { my $parser = new DateTime::Format::Strptime( pattern => '%O', diagnostic => 1 ); is( $parser->parse_datetime('AMERICA/NEW_YORK')->time_zone->name, 'America/New_York' ); } #diag("1.09 - Bogus TZs shouldn't barf, they should follow the on_error setting"); { my $parser = new DateTime::Format::Strptime( pattern => '%O', on_error => 'undef' ); is( $parser->parse_datetime('Oz/Munchkinville'), undef ); } #diag("1.09 - Month name matching was being too greedy"); { my $parser = DateTime::Format::Strptime->new( pattern => "%d%b%y" ); my $dt = $parser->parse_datetime('15AUG07'); is( $dt->ymd, '2007-08-15' ); } sub test { my %arg = @_; my $strptime = DateTime::Format::Strptime->new( pattern => $arg{pattern} || '%F %T', locale => $arg{locale} || 'en', time_zone => $arg{time_zone} || 'UTC', diagnostic => $arg{diagnostic} || 0, on_error => 'undef', ); isa_ok( $strptime, 'DateTime::Format::Strptime' ); my $parsed = $strptime->parse_datetime( $arg{input} ); isa_ok( $parsed, 'DateTime' ); is( $parsed->epoch, $arg{epoch} ); } done_testing(); DateTime-Format-Strptime-1.54/lib/0000775000175000017500000000000012126724626016612 5ustar autarchautarchDateTime-Format-Strptime-1.54/lib/DateTime/0000775000175000017500000000000012126724626020306 5ustar autarchautarchDateTime-Format-Strptime-1.54/lib/DateTime/Format/0000775000175000017500000000000012126724626021536 5ustar autarchautarchDateTime-Format-Strptime-1.54/lib/DateTime/Format/Strptime.pm0000644000175000017500000013560512126724626023713 0ustar autarchautarchpackage DateTime::Format::Strptime; { $DateTime::Format::Strptime::VERSION = '1.54'; } use strict; use DateTime 1.00; use DateTime::Locale 0.45; use DateTime::TimeZone 0.79; use Params::Validate 0.64 qw( validate SCALAR SCALARREF BOOLEAN OBJECT CODEREF ); use Carp; use Exporter; use vars qw( @ISA @EXPORT @EXPORT_OK %ZONEMAP %FORMATS $CROAK $errmsg); @ISA = 'Exporter'; @EXPORT_OK = qw( &strftime &strptime ); @EXPORT = (); %ZONEMAP = ( 'A' => '+0100', 'ACDT' => '+1030', 'ACST' => '+0930', 'ADT' => 'Ambiguous', 'AEDT' => '+1100', 'AES' => '+1000', 'AEST' => '+1000', 'AFT' => '+0430', 'AHDT' => '-0900', 'AHST' => '-1000', 'AKDT' => '-0800', 'AKST' => '-0900', 'AMST' => '+0400', 'AMT' => '+0400', 'ANAST' => '+1300', 'ANAT' => '+1200', 'ART' => '-0300', 'AST' => 'Ambiguous', 'AT' => '-0100', 'AWST' => '+0800', 'AZOST' => '+0000', 'AZOT' => '-0100', 'AZST' => '+0500', 'AZT' => '+0400', 'B' => '+0200', 'BADT' => '+0400', 'BAT' => '+0600', 'BDST' => '+0200', 'BDT' => '+0600', 'BET' => '-1100', 'BNT' => '+0800', 'BORT' => '+0800', 'BOT' => '-0400', 'BRA' => '-0300', 'BST' => 'Ambiguous', 'BT' => 'Ambiguous', 'BTT' => '+0600', 'C' => '+0300', 'CAST' => '+0930', 'CAT' => 'Ambiguous', 'CCT' => 'Ambiguous', 'CDT' => 'Ambiguous', 'CEST' => '+0200', 'CET' => '+0100', 'CETDST' => '+0200', 'CHADT' => '+1345', 'CHAST' => '+1245', 'CKT' => '-1000', 'CLST' => '-0300', 'CLT' => '-0400', 'COT' => '-0500', 'CST' => 'Ambiguous', 'CSuT' => '+1030', 'CUT' => '+0000', 'CVT' => '-0100', 'CXT' => '+0700', 'ChST' => '+1000', 'D' => '+0400', 'DAVT' => '+0700', 'DDUT' => '+1000', 'DNT' => '+0100', 'DST' => '+0200', 'E' => '+0500', 'EASST' => '-0500', 'EAST' => 'Ambiguous', 'EAT' => '+0300', 'ECT' => 'Ambiguous', 'EDT' => 'Ambiguous', 'EEST' => '+0300', 'EET' => '+0200', 'EETDST' => '+0300', 'EGST' => '+0000', 'EGT' => '-0100', 'EMT' => '+0100', 'EST' => 'Ambiguous', 'ESuT' => '+1100', 'F' => '+0600', 'FDT' => 'Ambiguous', 'FJST' => '+1300', 'FJT' => '+1200', 'FKST' => '-0300', 'FKT' => '-0400', 'FST' => 'Ambiguous', 'FWT' => '+0100', 'G' => '+0700', 'GALT' => '-0600', 'GAMT' => '-0900', 'GEST' => '+0500', 'GET' => '+0400', 'GFT' => '-0300', 'GILT' => '+1200', 'GMT' => '+0000', 'GST' => 'Ambiguous', 'GT' => '+0000', 'GYT' => '-0400', 'GZ' => '+0000', 'H' => '+0800', 'HAA' => '-0300', 'HAC' => '-0500', 'HAE' => '-0400', 'HAP' => '-0700', 'HAR' => '-0600', 'HAT' => '-0230', 'HAY' => '-0800', 'HDT' => '-0930', 'HFE' => '+0200', 'HFH' => '+0100', 'HG' => '+0000', 'HKT' => '+0800', 'HL' => 'local', 'HNA' => '-0400', 'HNC' => '-0600', 'HNE' => '-0500', 'HNP' => '-0800', 'HNR' => '-0700', 'HNT' => '-0330', 'HNY' => '-0900', 'HOE' => '+0100', 'HST' => '-1000', 'I' => '+0900', 'ICT' => '+0700', 'IDLE' => '+1200', 'IDLW' => '-1200', 'IDT' => 'Ambiguous', 'IOT' => '+0500', 'IRDT' => '+0430', 'IRKST' => '+0900', 'IRKT' => '+0800', 'IRST' => '+0430', 'IRT' => '+0330', 'IST' => 'Ambiguous', 'IT' => '+0330', 'ITA' => '+0100', 'JAVT' => '+0700', 'JAYT' => '+0900', 'JST' => '+0900', 'JT' => '+0700', 'K' => '+1000', 'KDT' => '+1000', 'KGST' => '+0600', 'KGT' => '+0500', 'KOST' => '+1200', 'KRAST' => '+0800', 'KRAT' => '+0700', 'KST' => '+0900', 'L' => '+1100', 'LHDT' => '+1100', 'LHST' => '+1030', 'LIGT' => '+1000', 'LINT' => '+1400', 'LKT' => '+0600', 'LST' => 'local', 'LT' => 'local', 'M' => '+1200', 'MAGST' => '+1200', 'MAGT' => '+1100', 'MAL' => '+0800', 'MART' => '-0930', 'MAT' => '+0300', 'MAWT' => '+0600', 'MDT' => '-0600', 'MED' => '+0200', 'MEDST' => '+0200', 'MEST' => '+0200', 'MESZ' => '+0200', 'MET' => 'Ambiguous', 'MEWT' => '+0100', 'MEX' => '-0600', 'MEZ' => '+0100', 'MHT' => '+1200', 'MMT' => '+0630', 'MPT' => '+1000', 'MSD' => '+0400', 'MSK' => '+0300', 'MSKS' => '+0400', 'MST' => '-0700', 'MT' => '+0830', 'MUT' => '+0400', 'MVT' => '+0500', 'MYT' => '+0800', 'N' => '-0100', 'NCT' => '+1100', 'NDT' => '-0230', 'NFT' => 'Ambiguous', 'NOR' => '+0100', 'NOVST' => '+0700', 'NOVT' => '+0600', 'NPT' => '+0545', 'NRT' => '+1200', 'NST' => 'Ambiguous', 'NSUT' => '+0630', 'NT' => '-1100', 'NUT' => '-1100', 'NZDT' => '+1300', 'NZST' => '+1200', 'NZT' => '+1200', 'O' => '-0200', 'OESZ' => '+0300', 'OEZ' => '+0200', 'OMSST' => '+0700', 'OMST' => '+0600', 'OZ' => 'local', 'P' => '-0300', 'PDT' => '-0700', 'PET' => '-0500', 'PETST' => '+1300', 'PETT' => '+1200', 'PGT' => '+1000', 'PHOT' => '+1300', 'PHT' => '+0800', 'PKT' => '+0500', 'PMDT' => '-0200', 'PMT' => '-0300', 'PNT' => '-0830', 'PONT' => '+1100', 'PST' => 'Ambiguous', 'PWT' => '+0900', 'PYST' => '-0300', 'PYT' => '-0400', 'Q' => '-0400', 'R' => '-0500', 'R1T' => '+0200', 'R2T' => '+0300', 'RET' => '+0400', 'ROK' => '+0900', 'S' => '-0600', 'SADT' => '+1030', 'SAST' => 'Ambiguous', 'SBT' => '+1100', 'SCT' => '+0400', 'SET' => '+0100', 'SGT' => '+0800', 'SRT' => '-0300', 'SST' => 'Ambiguous', 'SWT' => '+0100', 'T' => '-0700', 'TFT' => '+0500', 'THA' => '+0700', 'THAT' => '-1000', 'TJT' => '+0500', 'TKT' => '-1000', 'TMT' => '+0500', 'TOT' => '+1300', 'TRUT' => '+1000', 'TST' => '+0300', 'TUC ' => '+0000', 'TVT' => '+1200', 'U' => '-0800', 'ULAST' => '+0900', 'ULAT' => '+0800', 'USZ1' => '+0200', 'USZ1S' => '+0300', 'USZ3' => '+0400', 'USZ3S' => '+0500', 'USZ4' => '+0500', 'USZ4S' => '+0600', 'USZ5' => '+0600', 'USZ5S' => '+0700', 'USZ6' => '+0700', 'USZ6S' => '+0800', 'USZ7' => '+0800', 'USZ7S' => '+0900', 'USZ8' => '+0900', 'USZ8S' => '+1000', 'USZ9' => '+1000', 'USZ9S' => '+1100', 'UTZ' => '-0300', 'UYT' => '-0300', 'UZ10' => '+1100', 'UZ10S' => '+1200', 'UZ11' => '+1200', 'UZ11S' => '+1300', 'UZ12' => '+1200', 'UZ12S' => '+1300', 'UZT' => '+0500', 'V' => '-0900', 'VET' => '-0400', 'VLAST' => '+1100', 'VLAT' => '+1000', 'VTZ' => '-0200', 'VUT' => '+1100', 'W' => '-1000', 'WAKT' => '+1200', 'WAST' => 'Ambiguous', 'WAT' => '+0100', 'WEST' => '+0100', 'WESZ' => '+0100', 'WET' => '+0000', 'WETDST' => '+0100', 'WEZ' => '+0000', 'WFT' => '+1200', 'WGST' => '-0200', 'WGT' => '-0300', 'WIB' => '+0700', 'WIT' => '+0900', 'WITA' => '+0800', 'WST' => 'Ambiguous', 'WTZ' => '-0100', 'WUT' => '+0100', 'X' => '-1100', 'Y' => '-1200', 'YAKST' => '+1000', 'YAKT' => '+0900', 'YAPT' => '+1000', 'YDT' => '-0800', 'YEKST' => '+0600', 'YEKT' => '+0500', 'YST' => '-0900', 'Z' => '+0000', 'UTC' => '+0000', ); sub new { my $class = shift; my %args = validate( @_, { pattern => { type => SCALAR | SCALARREF }, time_zone => { type => SCALAR | OBJECT, optional => 1 }, locale => { type => SCALAR | OBJECT, default => 'English' }, on_error => { type => SCALAR | CODEREF, default => 'undef' }, diagnostic => { type => SCALAR, default => 0 }, } ); croak( "The value supplied to on_error must be either 'croak', 'undef' or a code reference." ) unless ref( $args{on_error} ) eq 'CODE' or $args{on_error} eq 'croak' or $args{on_error} eq 'undef'; # Deal with locale unless ( ref( $args{locale} ) ) { my $locale = DateTime::Locale->load( $args{locale} ); croak("Could not create locale from $args{locale}") unless $locale; $args{_locale} = $locale; } else { $args{_locale} = $args{locale}; ( $args{locale} ) = ref( $args{_locale} ) =~ /::(\w+)[^:]+$/; } if ( $args{time_zone} ) { unless ( ref( $args{time_zone} ) ) { $args{time_zone} = DateTime::TimeZone->new( name => $args{time_zone} ); croak("Could not create time zone from $args{time_zone}") unless $args{time_zone}; } $args{set_time_zone} = $args{time_zone}; } else { $args{time_zone} = DateTime::TimeZone->new( name => 'floating' ); $args{set_time_zone} = ''; } my $self = bless \%args, $class; # Deal with the parser $self->{parser} = $self->_build_parser( $args{pattern} ); if ( $self->{parser} =~ /(%\{\w+\}|%\w)/ and $args{pattern} !~ /\%$1/ ) { croak("Unidentified token in pattern: $1 in $self->{pattern}"); } return $self; } sub pattern { my $self = shift; my $pattern = shift; if ($pattern) { my $possible_parser = $self->_build_parser($pattern); if ( $possible_parser =~ /(%\{\w+\}|%\w)/ and $pattern !~ /\%$1/ ) { $self->local_carp( "Unidentified token in pattern: $1 in $pattern. Leaving old pattern intact." ) and return undef; } else { $self->{parser} = $possible_parser; $self->{pattern} = $pattern; } } return $self->{pattern}; } sub locale { my $self = shift; my $locale = shift; if ($locale) { my $possible_locale = DateTime::Locale->load($locale); unless ($possible_locale) { $self->local_carp( "Could not create locale from $locale. Leaving old locale intact." ) and return undef; } else { $self->{locale} = $locale; $self->{_locale} = $possible_locale; # When the locale changes we need to rebuild the parser $self->{parser} = $self->_build_parser( $self->{pattern} ); } } return $self->{locale}; } sub time_zone { my $self = shift; my $time_zone = shift; if ($time_zone) { my $possible_time_zone = DateTime::TimeZone->new( name => $time_zone ); unless ($possible_time_zone) { $self->local_carp( "Could not create time zone from $time_zone. Leaving old time zone intact." ) and return undef; } else { $self->{time_zone} = $possible_time_zone; $self->{set_time_zone} = $self->{time_zone}; } } return $self->{time_zone}->name; } sub parse_datetime { my ( $self, $time_string ) = @_; local $^W = undef; # Variables from the parser my ( $dow_name, $month_name, $century, $day, $hour_24, $hour_12, $doy, $month, $minute, $ampm, $second, $week_sun_0, $dow_sun_0, $dow_mon_1, $week_mon_1, $year_100, $year, $iso_week_year_100, $iso_week_year, $epoch, $tz_offset, $timezone, $tz_olson, $nanosecond, $ce_year, $doy_dt, $epoch_dt, $use_timezone, $set_time_zone, ); # Variables for DateTime my ( $Year, $Month, $Day, $Hour, $Minute, $Second, $Nanosecond, $Am, $Pm ) = (); # Run the parser my $parser = $self->{parser}; eval($parser); die $@ if $@; if ( $self->{diagnostic} ) { print qq| Entered = $time_string Parser = $parser dow_name = $dow_name month_name = $month_name century = $century day = $day hour_24 = $hour_24 hour_12 = $hour_12 doy = $doy month = $month minute = $minute ampm = $ampm second = $second nanosecond = $nanosecond week_sun_0 = $week_sun_0 dow_sun_0 = $dow_sun_0 dow_mon_1 = $dow_mon_1 week_mon_1 = $week_mon_1 year_100 = $year_100 year = $year ce_year = $ce_year tz_offset = $tz_offset tz_olson = $tz_olson timezone = $timezone epoch = $epoch iso_week_year = $iso_week_year iso_week_year_100 = $iso_week_year_100 |; } $self->local_croak("Your datetime does not match your pattern.") and return undef if ( ( $self->{parser} =~ /\$dow_name\b/ and $dow_name eq '' ) or ( $self->{parser} =~ /\$month_name\b/ and $month_name eq '' ) or ( $self->{parser} =~ /\$century\b/ and $century eq '' ) or ( $self->{parser} =~ /\$day\b/ and $day eq '' ) or ( $self->{parser} =~ /\$hour_24\b/ and $hour_24 eq '' ) or ( $self->{parser} =~ /\$hour_12\b/ and $hour_12 eq '' ) or ( $self->{parser} =~ /\$doy\b/ and $doy eq '' ) or ( $self->{parser} =~ /\$month\b/ and $month eq '' ) or ( $self->{parser} =~ /\$minute\b/ and $minute eq '' ) or ( $self->{parser} =~ /\$ampm\b/ and $ampm eq '' ) or ( $self->{parser} =~ /\$second\b/ and $second eq '' ) or ( $self->{parser} =~ /\$nanosecond\b/ and $nanosecond eq '' ) or ( $self->{parser} =~ /\$week_sun_0\b/ and $week_sun_0 eq '' ) or ( $self->{parser} =~ /\$dow_sun_0\b/ and $dow_sun_0 eq '' ) or ( $self->{parser} =~ /\$dow_mon_1\b/ and $dow_mon_1 eq '' ) or ( $self->{parser} =~ /\$week_mon_1\b/ and $week_mon_1 eq '' ) or ( $self->{parser} =~ /\$year_100\b/ and $year_100 eq '' ) or ( $self->{parser} =~ /\$year\b/ and $year eq '' ) or ( $self->{parser} =~ /\$ce_year\b/ and $ce_year eq '' ) or ( $self->{parser} =~ /\$tz_offset\b/ and $tz_offset eq '' ) or ( $self->{parser} =~ /\$tz_olson\b/ and $tz_olson eq '' ) or ( $self->{parser} =~ /\$timezone\b/ and $timezone eq '' ) or ( $self->{parser} =~ /\$epoch\b/ and $epoch eq '' ) ); # Create a timezone to work with if ($tz_offset) { $use_timezone = $tz_offset; } if ($timezone) { $self->local_croak("I don't recognise the timezone $timezone.") and return undef unless $ZONEMAP{$timezone}; $self->local_croak("The timezone '$timezone' is ambiguous.") and return undef if $ZONEMAP{$timezone} eq 'Ambiguous' and not( $tz_offset or $tz_olson ); $self->local_croak( "Your timezones ('$tz_offset' and '$timezone') do not match.") and return undef if $tz_offset and $ZONEMAP{$timezone} ne 'Ambiguous' and $ZONEMAP{$timezone} != $tz_offset; $use_timezone = $ZONEMAP{$timezone} if $ZONEMAP{$timezone} ne 'Ambiguous'; } if ($tz_olson) { my $tz = eval { DateTime::TimeZone->new( name => $tz_olson ) }; if ( not $tz ) { print "Provided olson TZ didn't work ($tz_olson). Attempting to normalize it.\n" if $self->{diagnostic}; $tz_olson = ucfirst lc $tz_olson; $tz_olson =~ s|([/_])(\w)|$1\U$2|g; print " Trying $tz_olson.\n" if $self->{diagnostic}; $tz = eval { DateTime::TimeZone->new( name => $tz_olson ) }; } $self->local_croak("I don't recognise the time zone '$tz_olson'.") and return undef unless $tz; $use_timezone = $set_time_zone = $tz; } $use_timezone = $self->{time_zone} unless ($use_timezone); print "Using timezone $use_timezone.\n" if $self->{diagnostic}; # If there's an epoch, we're done. Just need to check all the others if ($epoch) { $epoch_dt = DateTime->from_epoch( epoch => $epoch, time_zone => $use_timezone ); $Year = $epoch_dt->year; $Month = $epoch_dt->month; $Day = $epoch_dt->day; $Hour = $epoch_dt->hour; $Minute = $epoch_dt->minute; $Second = $epoch_dt->second; $Nanosecond = $epoch_dt->nanosecond; print $epoch_dt->strftime("Epoch: %D %T.%N\n") if $self->{diagnostic}; } # Work out the year we're working with: if ($year_100) { if ($century) { $Year = ( ( $century * 100 ) - 0 ) + $year_100; } else { print "No century, guessing for $year_100" if $self->{diagnostic}; if ( $year_100 >= 69 and $year_100 <= 99 ) { print "Guessed 1900s" if $self->{diagnostic}; $Year = 1900 + $year_100; } else { print "Guessed 2000s" if $self->{diagnostic}; $Year = 2000 + $year_100; } } } if ($year) { $self->local_croak( "Your two year values ($year_100 and $year) do not match.") and return undef if ( $Year && ( $year != $Year ) ); $Year = $year; } if ($ce_year) { $self->local_croak( "Your two year values ($ce_year and $year) do not match.") and return undef if ( $Year && ( $ce_year != $Year ) ); $Year = $ce_year; } $self->local_croak("Your year value does not match your epoch.") and return undef if $epoch_dt and $Year and $Year != $epoch_dt->year; # Work out which month we want # Month names if ($month_name) { $self->local_croak( "There is no use providing a month name ($month_name) without providing a year." ) and return undef unless $Year; my $month_count = 0; my $month_number = 0; foreach my $month ( @{ $self->{_locale}->month_format_wide } ) { $month_count++; if ( lc $month eq lc $month_name ) { $month_number = $month_count; last; } } unless ($month_number) { my $month_count = 0; foreach my $month ( @{ $self->{_locale}->month_format_abbreviated } ) { $month_count++; # When abbreviating, sometimes there's a period, sometimes not. $month =~ s/\.$//; $month_name =~ s/\.$//; if ( lc $month eq lc $month_name ) { $month_number = $month_count; last; } } } unless ($month_number) { $self->local_croak( "$month_name is not a recognised month in this locale.") and return undef; } $Month = $month_number; } if ($month) { $self->local_croak( "There is no use providing a month without providing a year.") and return undef unless $Year; $self->local_croak("$month is too large to be a month of the year.") and return undef unless $month <= 12; $self->local_croak( "Your two month values ($month_name and $month) do not match.") and return undef if $Month and $month != $Month; $Month = $month; } $self->local_croak("Your month value does not match your epoch.") and return undef if $epoch_dt and $Month and $Month != $epoch_dt->month; if ($doy) { $self->local_croak( "There is no use providing a day of the year without providing a year." ) and return undef unless $Year; $doy_dt = eval { DateTime->from_day_of_year( year => $Year, day_of_year => $doy, time_zone => $use_timezone ); }; $self->local_croak("Day of year $Year-$doy is not valid") and return undef if $@; my $month = $doy_dt->month; $self->local_croak( "Your day of the year ($doy - in " . $doy_dt->month_name . ") is not in your month ($Month)" ) and return undef if $Month and $month != $Month; $Month = $month; } $self->local_croak("Your day of the year does not match your epoch.") and return undef if $epoch_dt and $doy_dt and $doy_dt->doy != $epoch_dt->doy; # Day of the month $self->local_croak("$day is too large to be a day of the month.") and return undef unless $day <= 31; $self->local_croak( "Your day of the month ($day) does not match your day of the year.") and return undef if $doy_dt and $day and $day != $doy_dt->day; $Day ||= ($day) ? $day : ($doy_dt) ? $doy_dt->day : ''; if ($Day) { $self->local_croak( "There is no use providing a day without providing a month and year." ) and return undef unless $Year and $Month; my $dt = eval { DateTime->new( year => $Year + 0, month => $Month + 0, day => $Day + 0, hour => 12, time_zone => $use_timezone ); }; $self->local_croak("Datetime $Year-$Month-$Day is not a valid date") and return undef if $@; $self->local_croak("There is no day $Day in $dt->month_name, $Year") and return undef unless $dt->month == $Month; } $self->local_croak("Your day of the month does not match your epoch.") and return undef if $epoch_dt and $Day and $Day != $epoch_dt->day; # Hour of the day $self->local_croak("$hour_24 is too large to be an hour of the day.") and return undef unless $hour_24 <= 23; #OK so leap seconds will break! $self->local_croak("$hour_12 is too large to be an hour of the day.") and return undef unless $hour_12 <= 12; $self->local_croak( "You must specify am or pm for 12 hour clocks ($hour_12|$ampm).") and return undef if ( $hour_12 && ( !$ampm ) ); ( $Am, $Pm ) = @{ $self->{_locale}->am_pm_abbreviated }; if ( lc $ampm eq lc $Pm ) { if ($hour_12) { $hour_12 += 12 if $hour_12 and $hour_12 != 12; } $self->local_croak( "Your am/pm value ($ampm) does not match your hour ($hour_24)") and return undef if $hour_24 and $hour_24 < 12; } elsif ( lc $ampm eq lc $Am ) { if ($hour_12) { $hour_12 = 0 if $hour_12 == 12; } $self->local_croak( "Your am/pm value ($ampm) does not match your hour ($hour_24)") and return undef if $hour_24 >= 12; } if ( $hour_12 and $hour_24 ) { $self->local_croak( "You have specified mis-matching 12 and 24 hour clock information" ) and return undef unless $hour_12 == $hour_24; $Hour = $hour_24; } elsif ($hour_12) { $Hour = $hour_12; } elsif ($hour_24) { $Hour = $hour_24; } $self->local_croak("Your hour does not match your epoch.") and return undef if $epoch_dt and $Hour and $Hour != $epoch_dt->hour; print "Set hour to $Hour.\n" if $self->{diagnostic}; # Minutes $self->local_croak("$minute is too large to be a minute.") and return undef unless $minute <= 59; $Minute ||= $minute; $self->local_croak("Your minute does not match your epoch.") and return undef if $epoch_dt and $Minute and $Minute != $epoch_dt->minute; print "Set minute to $Minute.\n" if $self->{diagnostic}; # Seconds $self->local_croak("$second is too large to be a second.") and return undef unless $second <= 59; #OK so leap seconds will break! $Second ||= $second; $self->local_croak("Your second does not match your epoch.") and return undef if $epoch_dt and $Second and $Second != $epoch_dt->second; print "Set second to $Second.\n" if $self->{diagnostic}; # Nanoeconds $self->local_croak("$nanosecond is too large to be a nanosecond.") and return undef unless length($nanosecond) <= 9; $Nanosecond ||= $nanosecond; $Nanosecond .= '0' while length($Nanosecond) < 9; # Epoch doesn't return nanoseconds # croak "Your nanosecond does not match your epoch." if $epoch_dt and $Nanosecond and $Nanosecond != $epoch_dt->nanosecond; print "Set nanosecond to $Nanosecond.\n" if $self->{diagnostic}; my $potential_return = eval { DateTime->new( year => ( $Year || 1 ) + 0, month => ( $Month || 1 ) + 0, day => ( $Day || 1 ) + 0, hour => ( $Hour || 0 ) + 0, minute => ( $Minute || 0 ) + 0, second => ( $Second || 0 ) + 0, nanosecond => ( $Nanosecond || 0 ) + 0, locale => $self->{_locale}, time_zone => $use_timezone, ); }; $self->local_croak("Datetime is not a valid date") and return undef if $@; $self->local_croak( "Your day of the week ($dow_mon_1) does not match the date supplied: " . $potential_return->ymd ) and return undef if $dow_mon_1 and $potential_return->dow != $dow_mon_1; $self->local_croak( "Your day of the week ($dow_sun_0) does not match the date supplied: " . $potential_return->ymd ) and return undef if $dow_sun_0 and ( $potential_return->dow % 7 ) != $dow_sun_0; if ($dow_name) { my $dow_count = 0; my $dow_number = 0; foreach my $dow ( @{ $self->{_locale}->day_format_wide } ) { $dow_count++; if ( lc $dow eq lc $dow_name ) { $dow_number = $dow_count; last; } } unless ($dow_number) { my $dow_count = 0; foreach my $dow ( @{ $self->{_locale}->day_format_abbreviated } ) { $dow_count++; if ( lc $dow eq lc $dow_name ) { $dow_number = $dow_count; last; } } } unless ($dow_number) { $self->local_croak( "$dow_name is not a recognised day in this locale.") and return undef; } $self->local_croak( "Your day of the week ($dow_name) does not match the date supplied: " . $potential_return->ymd ) and return undef if $dow_number and $potential_return->dow != $dow_number; } $self->local_croak( "Your week number ($week_sun_0) does not match the date supplied: " . $potential_return->ymd ) and return undef if $week_sun_0 and $potential_return->strftime('%U') != $week_sun_0; $self->local_croak( "Your week number ($week_mon_1) does not match the date supplied: " . $potential_return->ymd ) and return undef if $week_mon_1 and $potential_return->strftime('%W') != $week_mon_1; $self->local_croak( "Your ISO week year ($iso_week_year) does not match the date supplied: " . $potential_return->ymd ) and return undef if $iso_week_year and $potential_return->strftime('%G') != $iso_week_year; $self->local_croak( "Your ISO week year ($iso_week_year_100) does not match the date supplied: " . $potential_return->ymd ) and return undef if $iso_week_year_100 and $potential_return->strftime('%g') != $iso_week_year_100; # Move into the timezone in the object - if there is one print "Potential Datetime: " . $potential_return->strftime("%F %T %z %Z") . "\n" if $self->{diagnostic}; print "Setting timezone: " . $self->{set_time_zone} . "\n" if $self->{diagnostic}; if ( $self->{set_time_zone} ) { $potential_return->set_time_zone( $self->{set_time_zone} ); } elsif ($set_time_zone) { $potential_return->set_time_zone($set_time_zone); } print "Actual Datetime: " . $potential_return->strftime("%F %T %z %Z") . "\n" if $self->{diagnostic}; return $potential_return; } sub parse_duration { croak "DateTime::Format::Strptime doesn't do durations."; } sub format_datetime { my ( $self, $dt ) = @_; my $pattern = $self->pattern; $pattern =~ s/%O/$dt->time_zone->name/eg; return $dt->clone->set_locale( $self->locale )->strftime($pattern); } sub format_duration { croak "DateTime::Format::Strptime doesn't do durations."; } sub _build_parser { my $self = shift; my $regex = my $field_list = shift; if ( ref $regex eq 'Regexp' ) { $field_list =~ s/^\(\?-xism:(.+)\)$/$1/; } my @fields = $field_list =~ m/(%\{\w+\}|%\d*.)/g; $field_list = join( '', @fields ); # Locale-ize the parser my $ampm_list = join( '|', @{ $self->{_locale}->am_pm_abbreviated } ); $ampm_list .= '|' . lc $ampm_list; my $default_date_format = $self->{_locale}->glibc_date_format; my @locale_format = $default_date_format =~ m/(%\{\w+\}|%\d*.)/g; $default_date_format = join( '', @locale_format ); my $default_time_format = $self->{_locale}->glibc_time_format; @locale_format = $default_time_format =~ m/(%\{\w+\}|%\d*.)/g; $default_time_format = join( '', @locale_format ); my $default_datetime_format = $self->{_locale}->glibc_datetime_format; @locale_format = $default_datetime_format =~ m/(%\{\w+\}|%\d*.)/g; $default_datetime_format = join( '', @locale_format ); print "Date format: $default_date_format\nTime format: $default_time_format\nDatetime format: $default_datetime_format\n" if $self->{diagnostic}; $regex =~ s/%%/__ESCAPED_PERCENT_SIGN_MARKER__/g; $field_list =~ s/%%/__ESCAPED_PERCENT_SIGN_MARKER__/g; $regex =~ s/%c/$self->{_locale}->glibc_datetime_format/eg; $field_list =~ s/%c/$default_datetime_format/eg; # %c is the locale's default datetime format. $regex =~ s/%x/$self->{_locale}->glibc_date_format/eg; $field_list =~ s/%x/$default_date_format/eg; # %x is the locale's default date format. $regex =~ s/%X/$self->{_locale}->glibc_time_format/eg; $field_list =~ s/%X/$default_time_format/eg; # %x is the locale's default time format. if ( ref $regex ne 'Regexp' ) { $regex = quotemeta($regex); $regex =~ s/(? length $a } grep( /\W/, @{ $self->{_locale}->day_format_wide }, @{ $self->{_locale}->day_format_abbreviated } ) ); $day_re .= '|' if $day_re; $regex =~ s/%a/($day_re\\w+)/gi; $field_list =~ s/%a/#dow_name#/gi; # %a is the day of the week, using the locale's weekday names; either the abbreviated or full name may be specified. # %A is the same as %a. my $month_re = join( '|', map { quotemeta $_ } sort { length $b <=> length $a } grep( /\s|\d/, @{ $self->{_locale}->month_format_wide }, @{ $self->{_locale}->month_format_abbreviated } ) ); $month_re .= '|' if $month_re; $month_re .= '[^\\s\\d]+'; $regex =~ s/%[bBh]/($month_re)/g; $field_list =~ s/%[bBh]/#month_name#/g; #is the month, using the locale's month names; either the abbreviated or full name may be specified. # %B is the same as %b. # %h is the same as %b. #s/%c//g; #is replaced by the locale's appropriate date and time representation. $regex =~ s/%C/([\\d ]?\\d)/g; $field_list =~ s/%C/#century#/g; #is the century number [0,99]; leading zeros are permitted by not required. $regex =~ s/%[de]/([\\d ]?\\d)/g; $field_list =~ s/%[de]/#day#/g; #is the day of the month [1,31]; leading zeros are permitted but not required. #%e is the same as %d. $regex =~ s/%[Hk]/([\\d ]?\\d)/g; $field_list =~ s/%[Hk]/#hour_24#/g; #is the hour (24-hour clock) [0,23]; leading zeros are permitted but not required. # %k is the same as %H $regex =~ s/%g/([\\d ]?\\d)/g; $field_list =~ s/%g/#iso_week_year_100#/g; # The year corresponding to the ISO week number, but without the century (0-99). $regex =~ s/%G/(\\d{4})/g; $field_list =~ s/%G/#iso_week_year#/g; # The year corresponding to the ISO week number. $regex =~ s/%[Il]/([\\d ]?\\d)/g; $field_list =~ s/%[Il]/#hour_12#/g; #is the hour (12-hour clock) [1-12]; leading zeros are permitted but not required. # %l is the same as %I. $regex =~ s/%j/(\\d{1,3})/g; $field_list =~ s/%j/#doy#/g; #is the day of the year [1,366]; leading zeros are permitted but not required. $regex =~ s/%m/([\\d ]?\\d)/g; $field_list =~ s/%m/#month#/g; #is the month number [1-12]; leading zeros are permitted but not required. $regex =~ s/%M/([\\d ]?\\d)/g; $field_list =~ s/%M/#minute#/g; #is the minute [0-59]; leading zeros are permitted but not required. $regex =~ s/%[nt]/\\s+/g; $field_list =~ s/%[nt]//g; # %n is any white space. # %t is any white space. $regex =~ s/%p/($ampm_list)/gi; $field_list =~ s/%p/#ampm#/gi; # %p is the locale's equivalent of either A.M./P.M. indicator for 12-hour clock. $regex =~ s/%s/(\\d+)/g; $field_list =~ s/%s/#epoch#/g; # %s is the seconds since the epoch $regex =~ s/%S/([\\d ]?\\d)/g; $field_list =~ s/%S/#second#/g; # %S is the seconds [0-61]; leading zeros are permitted but not required. $regex =~ s/%(\d*)N/($1) ? "(\\d{$1})" : "(\\d+)"/eg; $field_list =~ s/%\d*N/#nanosecond#/g; # %N is the nanoseconds (or sub seconds really) $regex =~ s/%U/([\\d ]?\\d)/g; $field_list =~ s/%U/#week_sun_0#/g; # %U is the week number of the year (Sunday as the first day of the week) as a decimal number [0-53]; leading zeros are permitted but not required. $regex =~ s/%w/([0-6])/g; $field_list =~ s/%w/#dow_sun_0#/g; # is the weekday as a decimal number [0-6], with 0 representing Sunday. $regex =~ s/%u/([1-7])/g; $field_list =~ s/%u/#dow_mon_1#/g; # is the weekday as a decimal number [1-7], with 1 representing Monday - a la DateTime. $regex =~ s/%W/([\\d ]?\\d)/g; $field_list =~ s/%W/#week_mon_1#/g; #is the week number of the year (Monday as the first day of the week) as a decimal number [0,53]; leading zeros are permitted but not required. $regex =~ s/%y/([\\d ]?\\d)/g; $field_list =~ s/%y/#year_100#/g; # is the year within the century. When a century is not otherwise specified, values in the range 69-99 refer to years in the twentieth century (1969 to 1999 inclusive); values in the range 0-68 refer to years in the twenty-first century (2000-2068 inclusive). Leading zeros are permitted but not required. $regex =~ s/%Y/(\\d{4})/g; $field_list =~ s/%Y/#year#/g; # is the year including the century (for example, 1998). $regex =~ s|%z|([+-]\\d{4})|g; $field_list =~ s/%z/#tz_offset#/g; # Timezone Offset. $regex =~ s|%Z|(\\w+)|g; $field_list =~ s/%Z/#timezone#/g; # The short timezone name. $regex =~ s|%O|(\\w+\\/\\w+)|g; $field_list =~ s/%O/#tz_olson#/g; # The Olson timezone name. $regex =~ s|%\{(\w+)\}|(DateTime->can($1)) ? "(.+)" : ".+"|eg; $field_list =~ s|(%\{(\w+)\})|(DateTime->can($2)) ? "#$2#" : $1 |eg; # Any function in DateTime. $regex =~ s/__ESCAPED_PERCENT_SIGN_MARKER__/\\%/g; $field_list =~ s/__ESCAPED_PERCENT_SIGN_MARKER__//g; # is replaced by %. #print $regex; $field_list =~ s/#([a-z0-9_]+)#/\$$1, /gi; $field_list =~ s/,\s*$//; return qq|($field_list) = \$time_string =~ /$regex/|; } # Utility functions sub local_croak { my $self = $_[0]; return &{ $self->{on_error} }(@_) if ref( $self->{on_error} ); croak( $_[1] ) if $self->{on_error} eq 'croak'; $self->{errmsg} = $_[1]; return ( $self->{on_error} eq 'undef' ); } sub local_carp { my $self = $_[0]; return &{ $self->{on_error} }(@_) if ref( $self->{on_error} ); carp( $_[1] ) if $self->{on_error} eq 'croak'; $self->{errmsg} = $_[1]; return ( $self->{on_error} eq 'undef' ); } sub errmsg { $_[0]->{errmsg}; } # Exportable functions: sub strftime { my ( $pattern, $dt ) = @_; return $dt->strftime($pattern); } sub strptime { my ( $pattern, $time_string ) = @_; return DateTime::Format::Strptime->new( pattern => $pattern, on_error => 'croak' )->parse_datetime($time_string); } 1; # ABSTRACT: Parse and format strp and strf time patterns __END__ =pod =head1 NAME DateTime::Format::Strptime - Parse and format strp and strf time patterns =head1 VERSION version 1.54 =head1 SYNOPSIS use DateTime::Format::Strptime; my $strp = DateTime::Format::Strptime->new( pattern => '%T', locale => 'en_AU', time_zone => 'Australia/Melbourne', ); my $dt = $strp->parse_datetime('23:16:42'); $strp->format_datetime($dt); # 23:16:42 # Croak when things go wrong: my $strp = DateTime::Format::Strptime->new( pattern => '%T', locale => 'en_AU', time_zone => 'Australia/Melbourne', on_error => 'croak', ); $newpattern = $strp->pattern('%Q'); # Unidentified token in pattern: %Q in %Q at line 34 of script.pl # Do something else when things go wrong: my $strp = DateTime::Format::Strptime->new( pattern => '%T', locale => 'en_AU', time_zone => 'Australia/Melbourne', on_error => \&phone_police, ); =head1 DESCRIPTION This module implements most of C, the POSIX function that is the reverse of C, for C. While C takes a C and a pattern and returns a string, C takes a string and a pattern and returns the C object associated. =head1 CONSTRUCTOR =over 4 =item * new( pattern => $strptime_pattern ) Creates the format object. You must specify a pattern, you can also specify a C and a C. If you specify a time zone then any resulting C object will be in that time zone. If you do not specify a C parameter, but there is a time zone in the string you pass to C, then the resulting C will use that time zone. You can optionally use an on_error parameter. This parameter has three valid options: =over 4 =item * 'undef' (not undef, 'undef', it's a string not an undefined value) This is the default behavior. The module will return undef whenever it gets upset. The error can be accessed using the C<< $object->errmsg >> method. This is the ideal behaviour for interactive use where a user might provide an illegal pattern or a date that doesn't match the pattern. =item * 'croak' (not croak, 'croak', it's a string, not a function) This used to be the default behaviour. The module will croak with an error message whenever it gets upset. =item * sub{...} or \&subname When given a code ref, the module will call that sub when it gets upset. The sub receives two parameters: the object and the error message. Using these two it is possible to emulate the 'undef' behavior. (Returning a true value causes the method to return undef. Returning a false value causes the method to bravely continue): sub { $_[0]->{errmsg} = $_[1]; 1 }, =back =back =head1 METHODS This class offers the following methods. =over 4 =item * parse_datetime($string) Given a string in the pattern specified in the constructor, this method will return a new C object. If given a string that doesn't match the pattern, the formatter will croak or return undef, depending on the setting of on_error in the constructor. =item * format_datetime($datetime) Given a C object, this methods returns a string formatted in the object's format. This method is synonymous with C's strftime method. =item * locale($locale) When given a locale or C object, this method sets its locale appropriately. If the locale is not understood, the method will croak or return undef (depending on the setting of on_error in the constructor) If successful this method returns the current locale. (After processing as above). =item * pattern($strptime_pattern) When given a pattern, this method sets the object's pattern. If the pattern is invalid, the method will croak or return undef (depending on the value of the C parameter) If successful this method returns the current pattern. (After processing as above) =item * time_zone($time_zone) When given a name, offset or C object, this method sets the object's time zone. This effects the C object returned by parse_datetime If the time zone is invalid, the method will croak or return undef (depending on the value of the C parameter) If successful this method returns the current time zone. (After processing as above) =item * errmsg If the on_error behavior of the object is 'undef', error messages with this method so you can work out why things went wrong. This code emulates a C<$DateTime::Format::Strptime> with the C parameter equal to C<'croak'>: C<< $strp->pattern($pattern) or die $DateTime::Format::Strptime::errmsg >> =back =head1 EXPORTS There are no methods exported by default, however the following are available: =over 4 =item * strptime( $strptime_pattern, $string ) Given a pattern and a string this function will return a new C object. =item * strftime( $strftime_pattern, $datetime ) Given a pattern and a C object this function will return a formatted string. =back =head1 STRPTIME PATTERN TOKENS The following tokens are allowed in the pattern string for strptime (parse_datetime): =over 4 =item * %% The % character. =item * %a or %A The weekday name according to the current locale, in abbreviated form or the full name. =item * %b or %B or %h The month name according to the current locale, in abbreviated form or the full name. =item * %C The century number (0-99). =item * %d or %e The day of month (01-31). This will parse single digit numbers as well. =item * %D Equivalent to %m/%d/%y. (This is the American style date, very confusing to non-Americans, especially since %d/%m/%y is widely used in Europe. The ISO 8601 standard pattern is %F.) =item * %F Equivalent to %Y-%m-%d. (This is the ISO style date) =item * %g The year corresponding to the ISO week number, but without the century (0-99). =item * %G The year corresponding to the ISO week number. =item * %H The hour (00-23). This will parse single digit numbers as well. =item * %I The hour on a 12-hour clock (1-12). =item * %j The day number in the year (1-366). =item * %m The month number (01-12). This will parse single digit numbers as well. =item * %M The minute (00-59). This will parse single digit numbers as well. =item * %n Arbitrary whitespace. =item * %N Nanoseconds. For other sub-second values use C<%[number]N>. =item * %p The equivalent of AM or PM according to the locale in use. (See L) =item * %r Equivalent to %I:%M:%S %p. =item * %R Equivalent to %H:%M. =item * %s Number of seconds since the Epoch. =item * %S The second (0-60; 60 may occur for leap seconds. See L). =item * %t Arbitrary whitespace. =item * %T Equivalent to %H:%M:%S. =item * %U The week number with Sunday the first day of the week (0-53). The first Sunday of January is the first day of week 1. =item * %u The weekday number (1-7) with Monday = 1. This is the C standard. =item * %w The weekday number (0-6) with Sunday = 0. =item * %W The week number with Monday the first day of the week (0-53). The first Monday of January is the first day of week 1. =item * %y The year within century (0-99). When a century is not otherwise specified (with a value for %C), values in the range 69-99 refer to years in the twentieth century (1969-1999); values in the range 00-68 refer to years in the twenty-first century (2000-2068). =item * %Y The year, including century (for example, 1991). =item * %z An RFC-822/ISO 8601 standard time zone specification. (For example +1100) [See note below] =item * %Z The timezone name. (For example EST -- which is ambiguous) [See note below] =item * %O This extended token allows the use of Olson Time Zone names to appear in parsed strings. B: This pattern cannot be passed to C's C method, but can be passed to C. =back =head1 AUTHOR EMERITUS This module was created by Rick Measham. =head1 BUGS Please report any bugs or feature requests to C, or through the web interface at L. I will be notified, and then you'll automatically be notified of progress on your bug as I make changes. =head1 SEE ALSO C mailing list. http://datetime.perl.org/ L, L, L, L =head1 AUTHORS =over 4 =item * Dave Rolsky =item * Rick Measham =back =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2013 by Dave Rolsky. This is free software, licensed under: The Artistic License 2.0 (GPL Compatible) =cut DateTime-Format-Strptime-1.54/README0000644000175000017500000000041512126724626016722 0ustar autarchautarch This archive contains the distribution DateTime-Format-Strptime, version 1.54: Parse and format strp and strf time patterns This software is Copyright (c) 2013 by Dave Rolsky. This is free software, licensed under: The Artistic License 2.0 (GPL Compatible) DateTime-Format-Strptime-1.54/LICENSE0000644000175000017500000002152012126724626017047 0ustar autarchautarchThis software is Copyright (c) 2013 by Dave Rolsky. This is free software, licensed under: The Artistic License 2.0 (GPL Compatible) The Artistic License 2.0 Copyright (c) 2000-2006, The Perl Foundation. Everyone is permitted to copy and distribute verbatim copies of this license document, but changing it is not allowed. Preamble This license establishes the terms under which a given free software Package may be copied, modified, distributed, and/or redistributed. The intent is that the Copyright Holder maintains some artistic control over the development of that Package while still keeping the Package available as open source and free software. You are always permitted to make arrangements wholly outside of this license directly with the Copyright Holder of a given Package. If the terms of this license do not permit the full use that you propose to make of the Package, you should contact the Copyright Holder and seek a different licensing arrangement. Definitions "Copyright Holder" means the individual(s) or organization(s) named in the copyright notice for the entire Package. "Contributor" means any party that has contributed code or other material to the Package, in accordance with the Copyright Holder's procedures. "You" and "your" means any person who would like to copy, distribute, or modify the Package. "Package" means the collection of files distributed by the Copyright Holder, and derivatives of that collection and/or of those files. A given Package may consist of either the Standard Version, or a Modified Version. "Distribute" means providing a copy of the Package or making it accessible to anyone else, or in the case of a company or organization, to others outside of your company or organization. "Distributor Fee" means any fee that you charge for Distributing this Package or providing support for this Package to another party. It does not mean licensing fees. "Standard Version" refers to the Package if it has not been modified, or has been modified only in ways explicitly requested by the Copyright Holder. "Modified Version" means the Package, if it has been changed, and such changes were not explicitly requested by the Copyright Holder. "Original License" means this Artistic License as Distributed with the Standard Version of the Package, in its current version or as it may be modified by The Perl Foundation in the future. "Source" form means the source code, documentation source, and configuration files for the Package. "Compiled" form means the compiled bytecode, object code, binary, or any other form resulting from mechanical transformation or translation of the Source form. Permission for Use and Modification Without Distribution (1) You are permitted to use the Standard Version and create and use Modified Versions for any purpose without restriction, provided that you do not Distribute the Modified Version. Permissions for Redistribution of the Standard Version (2) You may Distribute verbatim copies of the Source form of the Standard Version of this Package in any medium without restriction, either gratis or for a Distributor Fee, provided that you duplicate all of the original copyright notices and associated disclaimers. At your discretion, such verbatim copies may or may not include a Compiled form of the Package. (3) You may apply any bug fixes, portability changes, and other modifications made available from the Copyright Holder. The resulting Package will still be considered the Standard Version, and as such will be subject to the Original License. Distribution of Modified Versions of the Package as Source (4) You may Distribute your Modified Version as Source (either gratis or for a Distributor Fee, and with or without a Compiled form of the Modified Version) provided that you clearly document how it differs from the Standard Version, including, but not limited to, documenting any non-standard features, executables, or modules, and provided that you do at least ONE of the following: (a) make the Modified Version available to the Copyright Holder of the Standard Version, under the Original License, so that the Copyright Holder may include your modifications in the Standard Version. (b) ensure that installation of your Modified Version does not prevent the user installing or running the Standard Version. In addition, the Modified Version must bear a name that is different from the name of the Standard Version. (c) allow anyone who receives a copy of the Modified Version to make the Source form of the Modified Version available to others under (i) the Original License or (ii) a license that permits the licensee to freely copy, modify and redistribute the Modified Version using the same licensing terms that apply to the copy that the licensee received, and requires that the Source form of the Modified Version, and of any works derived from it, be made freely available in that license fees are prohibited but Distributor Fees are allowed. Distribution of Compiled Forms of the Standard Version or Modified Versions without the Source (5) You may Distribute Compiled forms of the Standard Version without the Source, provided that you include complete instructions on how to get the Source of the Standard Version. Such instructions must be valid at the time of your distribution. If these instructions, at any time while you are carrying out such distribution, become invalid, you must provide new instructions on demand or cease further distribution. If you provide valid instructions or cease distribution within thirty days after you become aware that the instructions are invalid, then you do not forfeit any of your rights under this license. (6) You may Distribute a Modified Version in Compiled form without the Source, provided that you comply with Section 4 with respect to the Source of the Modified Version. Aggregating or Linking the Package (7) You may aggregate the Package (either the Standard Version or Modified Version) with other packages and Distribute the resulting aggregation provided that you do not charge a licensing fee for the Package. Distributor Fees are permitted, and licensing fees for other components in the aggregation are permitted. The terms of this license apply to the use and Distribution of the Standard or Modified Versions as included in the aggregation. (8) You are permitted to link Modified and Standard Versions with other works, to embed the Package in a larger work of your own, or to build stand-alone binary or bytecode versions of applications that include the Package, and Distribute the result without restriction, provided the result does not expose a direct interface to the Package. Items That are Not Considered Part of a Modified Version (9) Works (including, but not limited to, modules and scripts) that merely extend or make use of the Package, do not, by themselves, cause the Package to be a Modified Version. In addition, such works are not considered parts of the Package itself, and are not subject to the terms of this license. General Provisions (10) Any use, modification, and distribution of the Standard or Modified Versions is governed by this Artistic License. By using, modifying or distributing the Package, you accept this license. Do not use, modify, or distribute the Package, if you do not accept this license. (11) If your Modified Version has been derived from a Modified Version made by someone other than you, you are nevertheless required to ensure that your Modified Version complies with the requirements of this license. (12) This license does not grant you the right to use any trademark, service mark, tradename, or logo of the Copyright Holder. (13) This license includes the non-exclusive, worldwide, free-of-charge patent license to make, have made, use, offer to sell, sell, import and otherwise transfer the Package with respect to any patent claims licensable by the Copyright Holder that are necessarily infringed by the Package. If you institute patent litigation (including a cross-claim or counterclaim) against any party alleging that the Package constitutes direct or contributory patent infringement, then this Artistic License to you shall terminate on the date that such litigation is filed. (14) Disclaimer of Warranty: THE PACKAGE IS PROVIDED BY THE COPYRIGHT HOLDER AND CONTRIBUTORS "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES. THE IMPLIED WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE, OR NON-INFRINGEMENT ARE DISCLAIMED TO THE EXTENT PERMITTED BY YOUR LOCAL LAW. UNLESS REQUIRED BY LAW, NO COPYRIGHT HOLDER OR CONTRIBUTOR WILL BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING IN ANY WAY OUT OF THE USE OF THE PACKAGE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. DateTime-Format-Strptime-1.54/META.yml0000644000175000017500000000142112126724626017311 0ustar autarchautarch--- abstract: 'Parse and format strp and strf time patterns' author: - 'Dave Rolsky ' - 'Rick Measham ' build_requires: Test::More: 0.88 configure_requires: ExtUtils::MakeMaker: 6.30 dynamic_config: 0 generated_by: 'Dist::Zilla version 4.300032, CPAN::Meta::Converter version 2.120921' license: artistic_2 meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: 1.4 name: DateTime-Format-Strptime requires: Carp: 0 DateTime: 1.00 DateTime::Locale: 0.45 DateTime::TimeZone: 0.79 Exporter: 0 Params::Validate: 0.64 strict: 0 vars: 0 resources: bugtracker: http://rt.cpan.org/NoAuth/Bugs.html?Dist=DateTime-Format-Strptime repository: git://git.urth.org/DateTime-Format-Strptime.git version: 1.54 DateTime-Format-Strptime-1.54/Makefile.PL0000644000175000017500000000315212126724626020015 0ustar autarchautarch use strict; use warnings; use ExtUtils::MakeMaker 6.30; my %WriteMakefileArgs = ( "ABSTRACT" => "Parse and format strp and strf time patterns", "AUTHOR" => "Dave Rolsky , Rick Measham ", "BUILD_REQUIRES" => {}, "CONFIGURE_REQUIRES" => { "ExtUtils::MakeMaker" => "6.30" }, "DISTNAME" => "DateTime-Format-Strptime", "EXE_FILES" => [], "LICENSE" => "artistic_2", "NAME" => "DateTime::Format::Strptime", "PREREQ_PM" => { "Carp" => 0, "DateTime" => "1.00", "DateTime::Locale" => "0.45", "DateTime::TimeZone" => "0.79", "Exporter" => 0, "Params::Validate" => "0.64", "strict" => 0, "vars" => 0 }, "TEST_REQUIRES" => { "Test::More" => "0.88" }, "VERSION" => "1.54", "test" => { "TESTS" => "t/*.t" } ); unless ( eval { ExtUtils::MakeMaker->VERSION(6.63_03) } ) { my $tr = delete $WriteMakefileArgs{TEST_REQUIRES}; my $br = $WriteMakefileArgs{BUILD_REQUIRES}; for my $mod ( keys %$tr ) { if ( exists $br->{$mod} ) { $br->{$mod} = $tr->{$mod} if $tr->{$mod} > $br->{$mod}; } else { $br->{$mod} = $tr->{$mod}; } } } unless ( eval { ExtUtils::MakeMaker->VERSION(6.56) } ) { my $br = delete $WriteMakefileArgs{BUILD_REQUIRES}; my $pp = $WriteMakefileArgs{PREREQ_PM}; for my $mod ( keys %$br ) { if ( exists $pp->{$mod} ) { $pp->{$mod} = $br->{$mod} if $br->{$mod} > $pp->{$mod}; } else { $pp->{$mod} = $br->{$mod}; } } } delete $WriteMakefileArgs{CONFIGURE_REQUIRES} unless eval { ExtUtils::MakeMaker->VERSION(6.52) }; WriteMakefile(%WriteMakefileArgs); DateTime-Format-Strptime-1.54/Changes0000644000175000017500000002035712126724626017344 0ustar autarchautarch1.54 2013-04-02 - Require DateTime.pm 1.00 because without it tests will break. 1.53 2013-04-02 - A fix in DateTime.pm 1.00 broke a test in this distro. Reported by Anthony J Lucas. RT #84371. 1.52 2012-07-01 - Shut up "unescaped braces in regex" warning from 5.17.0. RT #77514. Patch by Zefram. 1.51 2012-05-27 - Packaging cleanup, including listing Test::More as a test prereq, not a runtime prereq. RT #76128. 1.5000 2010-10-16 - This module did not recognize UTC as a valid time zone. Patch by Danijel Tašov. RT #59209. 1.4000 2010-06-28 - Actually update $VERSION in module file. Reported by David Wheeler. 1.3000 2010-06-26 - Specifiers which allowed for leading space before a number (like %e) would cause DateTime.pm to throw an error if the date being parsed actually contained leading space. Patch by Alex Vandiver. RT #58459. - License is now Artistic 2.0 1.2000 2010-03-19 - Updated to use non-deprecated DateTime::Locale API 1.1000 2009-07-13 -- Regex Pattern - If the pattern you pass in is a regular expression, that will be honored. - Changed the locale tests to use require the latest version of Locale until the target stops moving. 1.0901 2009-05-16 -- Official release of 1.0900_01 1.0900_01 2009-04-18 - Makefile.PL changes for Windows users as per issue #16 1.0900 2009-02-22 - It seems that I also wasn't seeing notifications from RT (please don't use it, use the Gooogle project) so all the following are fixed: - 36672 Started failing mid May - 23313 Bug handling time zones like America/New_York - 25555 Module dies even when on_error is 'undef' - 23768 Olson timezone handling incorrect - 22450 locale test failing with bleadperl - 20487 nmake test_more fail (with patch); incorrect META.yml - 12071 format_datetime uses datetime locale rather than format locale - 11863 bug in DateTime::Format::Strptime 1.0601 when using %s - And a couple from Google: - #8 Add DateTime::Locale to documentation - #10 Parsing bug -- can't detect word boundry after month abbr 1.0800 2008-08-07 - It seems that I wasn't getting notifications from Google when people had reported bugs, so there's a pile of fixes in this release. Hopefully that fixes everyone's issues. 1.0702 2007-09-19 - Updated the META.yml file to have the correct 'resources' and match the latest spec - Updated the docus with a 'resources' section that has the same information in it for readers of POD. - This version ONLY changes the documentation and so it not a required update. 1.0701 2007-09-18 - Many people pointed out that while this module hadn't broken the tests for the French locale had. This is due to a new source for the data in DateTime::Locale. - This version ONLY changes the tests and so it not a required update. 1.0700 Sat, 5 Nov 2005 09:44:10 +1100 - Mike Schilli pointed out that strings without time zones or constructors without a time zone should be returning a DateTime in the floating time zone rather than UTC. - Jason Bodnar requested greater allowance for time zones in strings .. so I've now added the ability to use an Olson time zone identifier with %O. Note that this is a token specifically added to Strptime and it WILL NOT WORK with DateTime's strftime method. 1.0601 Wed, 1 Sep 2004 07:52:44 +1000 - Dave Faraldo and Jonathan Lefter pointed out that one of the new Locale tests in t/006... will fail on the 30th and 31st of the month as not all months have those days. Patch supplied by Jonathan has been applied. - This is just a test fix and doesn't alter the way the module runs in any way. If you already got 1.06 to run then you don't need this. 1.0600 Sat, 28 Aug 2004 15:02:47 +1000 - Fixed bug from RT (#7502) from dfaraldo@redhat.com that made validation fall over by assuming midnight always exists. The patch now assumes Midday exists (both he and I assume that DST will never start at midday anywhere anytime!) - This is a major change and you should install this release if you ever use any time_zone other than floating or UTC. And if you don't use them today, you may tomorrow - so upgrade OK? 1.0500 Wed, 18 Aug 2004 17:24:32 +1000 - Adapted and applied patches from Jean Forget to allow day names and month names to have \W characters and to allow am/pm values from other locales - Jean's patch also included some doc patches - Patched the synopsis a Jean suggestion to demonstrate how to use the non-default error behaviors - Added tests for these bugs - Added t/more/* and the make test_more target so I can test every locale if I want to. - It's over a year since I deprecated the language parameter so I've now removed it. You've had a year of warnings! - This is a major change and you should install this release if you use any locale other than en. 1.0400 Sun, 10 Aug 2003 00:22:00 +1000 - Applied patches from Joshua Hoblitt to move the the brand new DateTime::Locale rather than the old ::Language modules - Implemented %x, %X and %c for locale formats - Fixed a bug on the two digit year determinator - Added a test for locales known as 004locale.t - This is a major change and you should install this release if you are using DateTime >= 0.14 (the first release with Locale) 1.0302 Sat, 28 Jun 2003 09:15:21 +1000 - Test 004 was failing on Windows due to the path delimiter being a backslash rather than a slash. This release should also fix Strptime for Mac users, although I've had no complaints from such users. (Myself being one of the only ones currently using Strptime AFAIK!) Thanks Ron Hill for the bug report. 1.0301 Wed, 25 Jun 2003 22:40:12 +1000 - Updated to handle the post 0.12 DateTime that now validates dates. Still handles old DateTime. 1.0300 Sat, 07 Jun 2003 10:40:23 +1000 - The calls to die() have changed by request of Dave Rolsky and Iain Truskett (Thanks!). We now allow each object to have its own behavior. - The default behavior has been changed to returning undef. This was requested by someone (tell me if it was you!) and made a lot of sense to me. - Never released to CPAN 1.0200 Wed, 28 May 2003 21:02:03 +1000 - The docs for Time::Local talk about the 'proclivity to croak' which basically means the module croaks easily. So did this one until now. Until now, if you allowed a user to specify a pattern and they entered one that was non parsable, this module would croak causing your script to croak. This is a Bad Thing (tm). The behaviour now remains the same, however if you set $DateTime::Format::StrpTime::CROAK to false, methods will return undef rather than croaking. $DateTime::Format::StrpTime::errmsg will tell you what went wrong. The default is to continue to croak. This means you have to delibrately turn it off. Hopefully you'll change you script to do this at the same time you change it to check the return values of the methods :) 1.0103 Wed, 28 May 2003 20:10:57 +1000 - Applied doc patches from Iain Truskett (Thanks!) - Clarified parameter discrepancy between synopsis and docs (Thanks Chris Winters) 1.0102 Fri, 16 May 2003 07:28:18 +1000 - Fixed the same test as above. Think I actually succeeded this time! 1.0101 Tue, 13 May 2003 07:58:23 +1000 - Fixed a test that was broken if DateTime::TimeZone was not version 0.13 or above. 1.0100 Sun, 11 May 2003 13:54:36 +1000 - If we have the latest DateTime we run the test mentioned above - Fixed my version format as advised by Iain Truskett if it still doesn't work it's because of me, not him - Added the ability to handle nanoseconds as requested by Michael Goltze. - Got Time Zones working, including mapping non-ambiguous TLAs offsets and Olsen names (the latter uses the %q token) 1.00.02 Tue, 29 Apr 2003 07:03:19 +1000 - Fixed a test that only worked in DateTime was from CVS - Fixed two issues noted by Iain Truskett: - Removed a diag() in test 1 that was just there for testing the test - Added a linebreak to the end of the MANIFEST 1.00.01 Mon, 28 Apr 2003 07:12:01 +1000 - removed alien life-forms (characters that didn't ASCIIfy) * No API change, just made it so it will install now! 1.00.00 Sun, 27 Apr 2003 17:56:27 +1000 - first CPAN release - added tests - should be 100% compatible with DateTime's strftime function DateTime-Format-Strptime-1.54/META.json0000644000175000017500000000306212126724626017464 0ustar autarchautarch{ "abstract" : "Parse and format strp and strf time patterns", "author" : [ "Dave Rolsky ", "Rick Measham " ], "dynamic_config" : 0, "generated_by" : "Dist::Zilla version 4.300032, CPAN::Meta::Converter version 2.120921", "license" : [ "artistic_2" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : "2" }, "name" : "DateTime-Format-Strptime", "prereqs" : { "configure" : { "requires" : { "ExtUtils::MakeMaker" : "6.30" } }, "develop" : { "requires" : { "Test::Pod" : "1.41" } }, "runtime" : { "requires" : { "Carp" : "0", "DateTime" : "1.00", "DateTime::Locale" : "0.45", "DateTime::TimeZone" : "0.79", "Exporter" : "0", "Params::Validate" : "0.64", "strict" : "0", "vars" : "0" } }, "test" : { "requires" : { "Test::More" : "0.88" } } }, "release_status" : "stable", "resources" : { "bugtracker" : { "mailto" : "bug-datetime-format-strptime@rt.cpan.org", "web" : "http://rt.cpan.org/NoAuth/Bugs.html?Dist=DateTime-Format-Strptime" }, "repository" : { "type" : "git", "url" : "git://git.urth.org/DateTime-Format-Strptime.git", "web" : "http://git.urth.org/DateTime-Format-Strptime.git" } }, "version" : "1.54" } DateTime-Format-Strptime-1.54/INSTALL0000644000175000017500000000202212126724626017067 0ustar autarchautarch This is the Perl distribution DateTime-Format-Strptime. Installing DateTime-Format-Strptime is straightforward. ## Installation with cpanm If you have cpanm, you only need one line: % cpanm DateTime::Format::Strptime If you are installing into a system-wide directory, you may need to pass the "-S" flag to cpanm, which uses sudo to install the module: % cpanm -S DateTime::Format::Strptime ## Installing with the CPAN shell Alternatively, if your CPAN shell is set up, you should just be able to do: % cpan DateTime::Format::Strptime ## Manual installation As a last resort, you can manually install it. Download the tarball, untar it, then build it: % perl Makefile.PL % make && make test Then install it: % make install If you are installing into a system-wide directory, you may need to run: % sudo make install ## Documentation DateTime-Format-Strptime documentation is available as POD. You can run perldoc from a shell to read the documentation: % perldoc DateTime::Format::Strptime DateTime-Format-Strptime-1.54/dist.ini0000644000175000017500000000141412126724626017506 0ustar autarchautarchname = DateTime-Format-Strptime author = Dave Rolsky author = Rick Measham copyright_holder = Dave Rolsky version = 1.54 [NextRelease] format = %-8v %{yyyy-MM-dd}d [@Basic] [InstallGuide] [MetaJSON] [MetaResources] bugtracker.web = http://rt.cpan.org/NoAuth/Bugs.html?Dist=DateTime-Format-Strptime bugtracker.mailto = bug-datetime-format-strptime@rt.cpan.org repository.url = git://git.urth.org/DateTime-Format-Strptime.git repository.web = http://git.urth.org/DateTime-Format-Strptime.git repository.type = git [SurgicalPodWeaver] [PkgVersion] [ContributorsFromGit] [EOLTests] [NoTabsTests] [PodSyntaxTests] ;[Test::CPAN::Changes] [Test::Pod::LinkCheck] ;[Test::Pod::No404s] [AutoPrereqs] [CheckPrereqsIndexed] [@Git]