Regexp-Common-time-0.05000755001750001750 012243100275 14415 5ustar00gaborgabor000000000000Regexp-Common-time-0.05/Changes000444001750001750 66312243100275 16032 0ustar00gaborgabor000000000000Revision history for Perl extension Regexp::Common::time. 0.01 2005 December 4 - First version 0.02 23 May 2008 - Add mail, MAIL, and american formats. - Fix many broken test cases. 0.03 25 May 2008 - Bug fix: Makefile.PL had a syntax error. 0.04 29 May 2008 - Possible fix for Taiwanese locale test failures. Thanks to CPAN tester "imacat". 0.05 20 Nov 2013 - Fix test RT #87476 Regexp-Common-time-0.05/Build.PL000444001750001750 121212243100275 16042 0ustar00gaborgabor000000000000use strict; use warnings; eval {require Module::Build}; if ($@) { warn "Module::Build is required for Build.PL\n"; exit 0; } my $builder = Module::Build->new( module_name => 'Regexp::Common::time', license => 'unrestricted', dist_author => 'Eric J. Roode ', dist_version_from => 'lib/Regexp/Common/time.pm', build_requires => { 'Test::More' => '0.40', }, requires => { 'Regexp::Common' => 0, 'POSIX' => 0, }, sign => 0, add_to_cleanup => [ 'Regexp-Common-time-*' ], ); $builder->create_build_script(); Regexp-Common-time-0.05/README000444001750001750 344712243100275 15442 0ustar00gaborgabor000000000000Regexp::Common::time v0.04 ========================== This is a Regexp::Common plugin that provides regular expressions for parsing dates and times. It can handle most date formats, such as: y/m/d m/d/y d/m/y 2005/04/02 4/2/2005 2/4/05 05.04.02 04.02.05 02.04.2005 2005 April 2 April 2, 2005 2 APR 05 05APRIL02 APR022005 02 April 2005 20050402 040205 02042005 ISO 8601 RFC 2822 2008-05-24T21:46:01 25 May 2008 21:46:01 +0500 It can also handle time formats like: 9:03:27pm 21:03:27 9:03 p.m. 21:03 9:03a Furthermore, you can easily piece together time and date component patterns (in the style of Time::Format or POSIX's strftime) to build arbitrarily complex custom regexes that can parse just about any time or date pattern imaginable. INSTALLATION To install this module type the following: perl Build.PL perl Build perl Build test perl Build install If you do not have Module::Build, you can use the older steps: perl Makefile.PL make make test make install On Windows, you will need to use nmake instead of make. DEPENDENCIES This module requires this other modules and libraries: Regexp::Common POSIX I18N::Langinfo (optional, but needed for internationalization) Also, Time::Normalize is likely to be useful to you. COPYRIGHT AND LICENSE Eric J. Roode, roode @ cpan . org Copyright (c) 2005-2008 by Eric J. Roode. All Rights Reserved. This module is free software; See the copyright notice in the module source code for full details. To avoid my spam filter, please include "Perl", "module", or this module's name in the message's subject line, and/or GPG-sign your message. Regexp-Common-time-0.05/MANIFEST000444001750001750 36312243100275 15665 0ustar00gaborgabor000000000000Build.PL Changes lib/Regexp/Common/time.pm Makefile.PL MANIFEST This list of files MANIFEST.SKIP META.json META.yml README t/1-load.t t/american.t t/dmy.t t/doc.t t/hms.t t/mail-strict.t t/mail.t t/mdy.t t/strftime.t t/tf.t t/ymd.t t/zone.t Regexp-Common-time-0.05/Makefile.PL000444001750001750 121612243100275 16524 0ustar00gaborgabor000000000000use ExtUtils::MakeMaker; # See lib/ExtUtils/MakeMaker.pm for details of how to influence # the contents of the Makefile that is written. WriteMakefile( NAME => 'Regexp::Common::time', VERSION_FROM => 'lib/Regexp/Common/time.pm', # finds $VERSION PREREQ_PM => { 'Test::More' => '0.40', 'Regexp::Common' => 0, 'POSIX' => 0, }, PL_FILES => {}, ($] >= 5.005 ? ## Add these new keywords supported since 5.005 (ABSTRACT_FROM => 'lib/Regexp/Common/time.pm', # retrieve abstract from module AUTHOR => 'eroode ') : ()), ); Regexp-Common-time-0.05/MANIFEST.SKIP000444001750001750 32312243100275 16426 0ustar00gaborgabor000000000000\.tar\.gz$ \bCVS\b ^Build$ ^Build.bat$ ^Regexp-Common-time-[\d.]+/ ^Makefile$ ^Makefile.old$ ^\.cvsignore$ ^_build/ ^blib/ ^blibdirs ^cover_db/ ^pm_to_blib ^pod.*tmp$ ~$ ^MYMETA\.yml$ ^MYMETA\.json$ \.git .bak$ Regexp-Common-time-0.05/META.json000444001750001750 167712243100275 16206 0ustar00gaborgabor000000000000{ "abstract" : "Date and time regexps.", "author" : [ "Eric J. Roode " ], "dynamic_config" : 1, "generated_by" : "Module::Build version 0.4007, CPAN::Meta::Converter version 2.120921", "license" : [ "unrestricted" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : "2" }, "name" : "Regexp-Common-time", "prereqs" : { "build" : { "requires" : { "Test::More" : "0.40" } }, "configure" : { "requires" : { "Module::Build" : "0.40" } }, "runtime" : { "requires" : { "POSIX" : "0", "Regexp::Common" : "0" } } }, "provides" : { "Regexp::Common::time" : { "file" : "lib/Regexp/Common/time.pm", "version" : "0.05" } }, "release_status" : "stable", "version" : "0.05" } Regexp-Common-time-0.05/META.yml000444001750001750 104312243100275 16021 0ustar00gaborgabor000000000000--- abstract: 'Date and time regexps.' author: - 'Eric J. Roode ' build_requires: Test::More: 0.40 configure_requires: Module::Build: 0.40 dynamic_config: 1 generated_by: 'Module::Build version 0.4007, CPAN::Meta::Converter version 2.120921' license: unrestricted meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: 1.4 name: Regexp-Common-time provides: Regexp::Common::time: file: lib/Regexp/Common/time.pm version: 0.05 requires: POSIX: 0 Regexp::Common: 0 version: 0.05 Regexp-Common-time-0.05/lib000755001750001750 012243100275 15163 5ustar00gaborgabor000000000000Regexp-Common-time-0.05/lib/Regexp000755001750001750 012243100275 16415 5ustar00gaborgabor000000000000Regexp-Common-time-0.05/lib/Regexp/Common000755001750001750 012243100275 17645 5ustar00gaborgabor000000000000Regexp-Common-time-0.05/lib/Regexp/Common/time.pm000444001750001750 12716512243100275 21352 0ustar00gaborgabor000000000000=head1 NAME Regexp::Common::time - Date and time regexps. =head1 VERSION This is version 0.05 of Regexp::Common::time, Nov 20, 2013. =cut use strict; package Regexp::Common::time; $Regexp::Common::time::VERSION = '0.05'; use Regexp::Common qw(pattern); use POSIX; sub _croak { require Carp; goto &Carp::croak} my $can_locale; my $can_posix; BEGIN { eval { $can_posix = 0; require POSIX; $can_posix = 1; }; eval { $can_locale = 0; require I18N::Langinfo; I18N::Langinfo->import(qw(langinfo)); $can_locale = 1; }; } # Master list of patterns our %master = ( c2 => q/\d{2}/, # Century, 2 digits yr2 => q/\d{2}/, # Year, 2 digits yr4 => q/\d{4}/, # Year, 4 digits yr24 => q/(?:\d{2}(?:\d{2})?)/, # Year, 2 or 4 digits mo2 => q/(?:(?=[01])(?:0[1-9]|1[012]))/, # Month, 2 digits mo12 => q/(?:0[1-9]|1[012]|(? q/(?:(?=[ 1])(?: [1-9]|1[012]))/, # Month, 2 places, leading space dy2 => q/(?:(?=[0123])(?:0[1-9]|[12]\d|3[01]))/, # Day, 2 digits dy12 => q/(?:0[1-9]|[12]\d|3[01]|(? q/(?:(?=[ 123])(?: [1-9]|[12]\d|3[01]))/, # Day, 2 places, leading space doy3 => q/(?:(?=[0-3])(?:00[1-9]|0[1-9]\d|[12]\d\d|3(?:[0-5]\d|6[0-6])))/, # Day of year, 3 digits hr2 => q/(?:(?=[012])(?:[01]\d|2[0123]))/, # Hour, 00-23, 2 digits hr12 => q/(?:(?=\d)(?:[01]\d|2[0123]|(? q/(?:(?=[ 12])(?:[ 1]\d|2[0123]))/, # Hour, 0-23, 2 places, ld sp hx2 => q/(?:(?=[01])(?:0[1-9]|1[012]))/, # Hour, 01-12, 2 digits hx12 => q/(?:(?=\d)(?:0[1-9]|1[012]|(? q/(?:(?=[ 1])(?: [1-9]|1[012]))/, # Hour, 1-12, 2 places, ld sp mi2 => q/(?:[0-5]\d)/, # Minute, 2 digits mi12 => q/(?:[0-5]\d|(? q/(?:[ 1-5]\d)/, # Minute, 2 places, leading sp sc2 => q/(?:(?=[0-6])(?:[0-5]\d|6[01]))/, # Second, 2 digits, 00-61 sc12 => q/(?:(?=[0-6])(?:[0-5]\d|6[01]|(? q/(?:(?=[ 1-6])(?:[ 1-5]\d|6[01]))/, # Second, 2 places, 0-61, ld sp wn2 => q/(?:(?=[0-5])(?:0[1-9]|[1-4]\d|5[0-3]))/, # Week number, 2 digits, 01-53 wnx2 => q/(?:(?=[0-5])(?:[0-4]\d|5[0-3]))/, # Week number, 2 digits, 00-53 wd1 => q/[0-6]/, # Weekday number, 1 digit, 0-6 wdx1 => q/[1-7]/, # Weekday number, 1 digit, 1-7 msec => q/\d{3}/, # millisecond usec => q/\d{6}/, # microsecond ampm => q/(?:(?=[AaPp])(?:[ap](?:m|\.m\.)?|[AP](?:M|\.M\.)?))/, # am/pm indicator th => q/(?:(?=[SNRTsnrt])(?:st|ST|nd|ND|rd|RD|th|TH))/, # ordinal suffix tz => q/(?:[-+](?:[01]\d|2[0-4])(?::?[0-5]\d)?|Z|GMT|UTC?|[ECMP][DS]T)/, # Time zone ema => _get_abbr_month_pattern(1), # English month abbreviation # The following are locale-specific, and will be populated later mname => q/TBD/, # Full month name mabbr => q/TBD/, # Month abbreviation dname => q/TBD/, # Full weekday name dabbr => q/TBD/, # Weekday abbreviation axpx => q/TBD/, # locale-specific AM/PM indicator ); my $npd = q/(?/$master{dy12}/|-$master{dy12}-| $master{dy12},? |\\.$master{dy12}\\.|(?!$dsep)$master{dy12}(?!$dsep)))$dsep?(?k:$master{dy12}),?$dsep?}; my $d2middle = _nospace qq{(?=(?>/$master{dy2}/|-$master{dy2}-| $master{dy2},? |\\.$master{dy2}\\.|(?!$dsep)$master{dy2}(?!$dsep)))$dsep?(?k:$master{dy2}),?$dsep?}; # "Middle" month. Must be surrounded by matching separators my $mFULLmiddle; # Full month pattern, in middle (ymd and dmy). Set in _setup_locale(). my $m2middle = _nospace qq{(?=(?>/$master{mo2}/|-$master{mo2}-| $master{mo2} |\\.$master{mo2}\\.|$master{mo2}(?!$dsep)))$dsep?(?k:$master{mo2})$dsep?}; # "Middle" minute. Must be surrounded by matching separators my $tsep = _nospace q/[:. ]/; my $min2middle = _nospace qq{(?=(?>:$master{mi2}:|\\.$master{mi2}\\.| $master{mi2} |$master{mi2}(?!$tsep)))$tsep?(?k:$master{mi2})$tsep?}; # YMD builder sub ymd { my ($self, $flags_hr, $keys_ar) = @_; my $pattern = $keys_ar->[1]; _setup_locale(); # The second separator character is REQUIRED to be the same as the # first for YMD patterns. Otherwise, "2005/10/21" is ambiguous: # it matches "(20)(05)/(10)" and "(2005)/(10)/(21)". # 'ymd' is the most flexible: year: 2/4 digits; month 1/2 digits or name; day 1/2 digits. if ($pattern eq 'ymd') { return qq/(?k:$npd(?k:$master{yr24})$mFULLmiddle$dcap$nfd)/; } # 'y4md': 4-digit year; 1 or 2 digit month and day. Or named month. elsif ($pattern eq 'y4md') { return qq/(?k:(?k:$master{yr4})$mFULLmiddle$dcap$nfd)/; } # 'y2md': 2-digit year; 1 or 2 digit month and day. elsif ($pattern eq 'y2md') { return qq/(?k:(?k:$master{yr2})$mFULLmiddle$dcap$nfd)/; } elsif ($pattern eq 'y4m2d2' || $pattern eq 'YMD') { return qq/(?k:(?k:$master{yr4})$m2middle(?k:$master{dy2}))/; } elsif ($pattern eq 'y2m2d2') { return qq/(?k:(?k:$master{yr2})$m2middle(?k:$master{dy2}))/; } # Probably the only way to get here is if I goof up and specify this subroutine # for a YMD pattern that is not handled above. die "Programming error: Unknown y-m-d pattern '$pattern'. Contact Regexp::Common::time author."; } # MDY builder sub mdy { my ($self, $flags_hr, $keys_ar) = @_; my $pattern = $keys_ar->[1]; _setup_locale(); # The second separator character is REQUIRED to be the same as the # first for YMD patterns, for the STRICT versions of these patterns # (the ones containing "m2d2"). # 'mdy' is the most flexible: year: 2/4 digits; month 1/2 digits or named; day 1/2 digits. if ($pattern eq 'mdy') { return qq/(?k:$npd(?k:$anymon)$dmiddle(?k:$master{yr24})$nfd)/; } # 'mdy4': 4-digit year; 1 or 2 digit month and day. elsif ($pattern eq 'mdy4') { return qq/(?k:$npd(?k:$anymon)$dmiddle(?k:$master{yr4}))/; } # 'mdy2': 2-digit year; 1 or 2 digit month and day. elsif ($pattern eq 'mdy2') { return qq/(?k:$npd(?k:$anymon)$dmiddle(?k:$master{yr2}))/; } elsif ($pattern eq 'm2d2y4' || $pattern eq 'MDY') { return qq/(?k:(?k:$master{mo2})$d2middle(?k:$master{yr4}))/; } elsif ($pattern eq 'm2d2y2') { return qq/(?k:(?k:$master{mo2})$d2middle(?k:$master{yr2}))/; } # Probably the only way to get here is if I goof up and specify this subroutine # for a YMD pattern that is not handled above. die "Programming error: Unknown m-d-y pattern '$pattern'. Contact Regexp::Common::time author."; } # DMY builder sub dmy { my ($self, $flags_hr, $keys_ar) = @_; my $pattern = $keys_ar->[1]; _setup_locale(); # The second separator character is REQUIRED to be the same as the # first for YMD patterns, for the STRICT versions of these patterns # (the ones containing "d2m2"). # 'dmy' is the most flexible: year: 2/4 digits; month 1/2 digits; day 1/2 digits. if ($pattern eq 'dmy') { return qq/(?k:$npd$dcap$mFULLmiddle(?k:$master{yr24})$nfd)/; } # 'mdy4': 4-digit year; 1 or 2 digit month and day. elsif ($pattern eq 'dmy4') { return qq/(?k:$npd$dcap$mFULLmiddle(?k:$master{yr4}))/; } # 'y2md': 2-digit year; 1 or 2 digit month and day. elsif ($pattern eq 'dmy2') { return qq/(?k:$npd$dcap$mFULLmiddle(?k:$master{yr2}))/; } elsif ($pattern eq 'd2m2y4' || $pattern eq 'DMY') { return qq/(?k:(?k:$master{dy2})$m2middle(?k:$master{yr4}))/; } elsif ($pattern eq 'd2m2y2') { return qq/(?k:(?k:$master{dy2})$m2middle(?k:$master{yr2}))/; } # Probably the only way to get here is if I goof up and specify this subroutine # for a YMD pattern that is not handled above. die "Programming error: Unknown d-m-y pattern '$pattern'. Contact Regexp::Common::time author."; } # HMS builder sub hms { my $hr = $npd . q/[01]\d|2[0-4]|\d/; my $sec = q/\d\d/; # Can't limit it to 00-59! Because it's optional, and out-of-range = no match. # my ($self, $flags_hr, $keys_ar) = @_; return qq/(?k:$npd(?k:$master{hr12})$tsep/ # hour . qq/(?k:$master{mi2})/ # minute . qq/(?:$tsep(?k:$sec))?/ # second . qq/(?:\\s?(?k:$master{ampm}))?)/; # am/pm } # Time::Format-like builder my %tf = ( yyyy => $master{yr4}, yy => $master{yr2}, 'm{on}' => $master{mo12}, 'mm{on}'=> $master{mo2}, '?m{on}'=> $master{mo_2}, d => $master{dy12}, dd => $master{dy2}, '?d' => $master{dy_2}, h => $master{hr12}, hh => $master{hr2}, '?h' => $master{hr_2}, H => $master{hx12}, HH => $master{hx2}, '?H' => $master{hx_2}, 'm{in}' => $master{mi12}, 'mm{in}'=> $master{mi2}, '?m{in}'=> $master{mi_2}, s => $master{sc12}, ss => $master{sc2}, '?s' => $master{sc_2}, mmm => $master{msec}, uuuuuu => $master{usec}, am => $master{ampm}, AM => $master{ampm}, 'a.m.' => $master{ampm}, 'A.M.' => $master{ampm}, pm => $master{ampm}, PM => $master{ampm}, 'p.m.' => $master{ampm}, 'P.M.' => $master{ampm}, th => $master{th}, TH => $master{th}, tz => $master{tz}, ); my %disam; # Disambiguator for 'm' format. $disam{$_} = "{on}" foreach qw/yy d dd ?d/; # If year or day is nearby, it's 'month' $disam{$_} = "{in}" foreach qw/h hh ?h H HH ?H s ss ?s/; # If hour or second is nearby, it's 'minute' my $disambiguate_pat_1 = qr/ (?{-pat}; my $pattern = $flags_hr->{-pat}; # Localize _setup_locale(); # Copying from Time::Format... # "Guess" how to interpret ambiguous 'm' $pattern =~ s/$disambiguate_pat_1/$1$3$disam{$2}/gx; $pattern =~ s/$disambiguate_pat_2/$1$disam{$3}$2/gx; # If the pattern contains any parentheses, then the caller is # responsible for doing all the captures. if ($pattern =~ /(? $master{c2}, # two-digit century D =>"$master{mo2}/$master{dy2}/$master{yr2}", d => $master{dy2}, # two-digit day e => $master{dy_2}, # 1 or 2-digit day, leading space H => $master{hr2}, # hour, 00-23 I => $master{hx2}, # hour, 01-12 j => $master{doy3}, # day-of-year, 001-366 m => $master{mo2}, # month, 01-12 M => $master{mi2}, # minute, 00-59 n => "\n", R =>"$master{hr2}:$master{mi2}", S => $master{sc2}, # Second, 00-61 T =>"$master{hr2}:$master{mi2}:$master{sc2}", t => "\t", u => $master{wdx1}, # Weekday number, 1-7 U => $master{wnx2}, # Week number, 00-53 V => $master{wn2}, # Week number, 01-53 w => $master{wd1}, # Weekday number, 0-6 W => $master{wnx2}, # Week number, 00-53 y => $master{yr2}, # two-digit year Y => $master{yr4}, # four-digit year Z => $master{tz}, # time zone '%' => '%', # additional useful patterns not specified by strftime _d => $master{dy12}, # 1- or 2-digit day number _H => $master{hr12}, # 1- or 2-digit 24-hour hour _I => $master{hx12}, # 1- or 2-digit 12-hour hour _m => $master{mo12}, # 1- or 2-digit month number _M => $master{mi12}, # 1- or 2-digit minute ); sub strftime_builder { my ($self, $flags_hr, $keys_ar) = @_; # User must specify *something* as the pattern _croak q{Mandatory "-pat" flag missing in strftime pattern} if !exists $flags_hr->{-pat}; my $pattern = $flags_hr->{-pat}; # Localize _setup_locale(); # If the pattern contains any parentheses, then the caller is # responsible for doing all the captures. if ($pattern =~ /(?(?i)$master{mo2}|$sdig|$master{mname}|$master{mabbr})/; $mFULLmiddle = _nospace qq{(?=(?>/$anymon/|-$anymon-| $anymon |\\.$anymon\\.|(?!$dsep)$anymon(?!$dsep)))$dsep?(?k:$anymon)$dsep?}; # Pattern variables for Time::Format $tf{Weekday} = $tf{WEEKDAY} = $tf{weekday} = $master{dname}; $tf{Day} = $tf{DAY} = $tf{day} = $master{dabbr}; $tf{Month} = $tf{MONTH} = $tf{month} = $master{mname}; $tf{Mon} = $tf{MON} = $tf{mon} = $master{mabbr}; # Pattern variables for strftime $strftime{A} = $master{dname}; $strftime{a} = $master{dabbr}; $strftime{B} = $master{mname}; $strftime{b} = $master{mabbr}; $strftime{h} = $strftime{b}; # defined synonym $strftime{r} ="$master{hx2}:$master{mi2}:$master{sc2} (?:$am_str|$pm_str)", # Set up locale-dependent strftime patterns $strftime{p} = $master{axpx}; foreach ($dt_fmt, $d_fmt, $t_fmt, $t_ap_fmt) { # the "|| q{}" below is to avoid "uninitialized" warnings. s/%(.)/$strftime{$1} || q{}/eg; } $strftime{c} = _nospace $dt_fmt; $strftime{r} = _nospace $t_ap_fmt; $strftime{x} = _nospace $d_fmt; $strftime{X} = _nospace $t_fmt; } sub _first_chars { my %uniq = map {substr ($_,0,1) => 1} @_; return join q{}, map quotemeta, keys %uniq; } sub _get_full_month_pattern { my @Mon_Name; if ($can_locale) { eval { @Mon_Name = map langinfo($_), ( I18N::Langinfo::MON_1(), I18N::Langinfo::MON_2(), I18N::Langinfo::MON_3(), I18N::Langinfo::MON_4(), I18N::Langinfo::MON_5(), I18N::Langinfo::MON_6(), I18N::Langinfo::MON_7(), I18N::Langinfo::MON_8(), I18N::Langinfo::MON_9(), I18N::Langinfo::MON_10(), I18N::Langinfo::MON_11(), I18N::Langinfo::MON_12(), ); }; } if (!$can_locale || $@) { @Mon_Name = qw(January February March April May June July August September October November December); } my $prematch = _first_chars(@Mon_Name); my $alternat = join '|', map quotemeta, @Mon_Name; return qq/(?=[$prematch])(?>$alternat)/; } sub _get_abbr_month_pattern { my $english_only = shift; my @Mon_Abbr; if (!$english_only && $can_locale) { eval { @Mon_Abbr = map langinfo($_), ( I18N::Langinfo::ABMON_1(), I18N::Langinfo::ABMON_2(), I18N::Langinfo::ABMON_3(), I18N::Langinfo::ABMON_4(), I18N::Langinfo::ABMON_5(), I18N::Langinfo::ABMON_6(), I18N::Langinfo::ABMON_7(), I18N::Langinfo::ABMON_8(), I18N::Langinfo::ABMON_9(), I18N::Langinfo::ABMON_10(), I18N::Langinfo::ABMON_11(), I18N::Langinfo::ABMON_12(), ); }; } if ($english_only || !$can_locale || $@) { @Mon_Abbr = qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec); } my $prematch = _first_chars(@Mon_Abbr); my $alternat = join '|', map quotemeta, @Mon_Abbr; return qq/(?=[$prematch])(?>$alternat)/; } sub _get_full_weekday_pattern { my @Day_Name; if ($can_locale) { eval { @Day_Name = map langinfo($_), ( I18N::Langinfo::DAY_1(), I18N::Langinfo::DAY_2(), I18N::Langinfo::DAY_3(), I18N::Langinfo::DAY_4(), I18N::Langinfo::DAY_5(), I18N::Langinfo::DAY_6(), I18N::Langinfo::DAY_7(), ); }; } if (!$can_locale || $@) { @Day_Name = qw(Sunday Monday Tuesday Wednesday Thursday Friday Saturday); } my $prematch = _first_chars(@Day_Name); my $alternat = join '|', map quotemeta, @Day_Name; return qq/(?=[$prematch])(?>$alternat)/; } sub _get_abbr_weekday_pattern { my $english_only = shift; my @Day_Abbr; if (!$english_only && $can_locale) { eval { @Day_Abbr = map langinfo($_), ( I18N::Langinfo::ABDAY_1(), I18N::Langinfo::ABDAY_2(), I18N::Langinfo::ABDAY_3(), I18N::Langinfo::ABDAY_4(), I18N::Langinfo::ABDAY_5(), I18N::Langinfo::ABDAY_6(), I18N::Langinfo::ABDAY_7(), ); }; } if ($english_only || !$can_locale || $@) { @Day_Abbr = qw(Sun Mon Tue Wed Thu Fri Sat); } my $prematch = _first_chars(@Day_Abbr); my $alternat = join '|', map quotemeta, @Day_Abbr; return qq/(?=[$prematch])(?>$alternat)/; } # Set up all the patterns for (qw(ymd y4md y2md y4m2d2 y2m2d2 YMD)) { pattern name => ['time', $_], create => \&ymd, } for (qw(mdy mdy4 mdy2 m2d2y4 m2d2y2 MDY)) { pattern name => ['time', $_], create => \&mdy, } for (qw(dmy dmy4 dmy2 d2m2y4 d2m2y2 DMY)) { pattern name => ['time', $_], create => \&dmy, } for (qw(hms)) { pattern name => ['time', $_], create => \&hms, } for (qw(strftime)) { pattern name => ['time', $_], create => \&strftime_builder, } for (qw(tf)) { pattern name => ['time', $_], create => \&tf_builder, } for (qw(american)) { pattern name => ['time', $_], create => \&american, } my $dt_sep = q/(?:(?<=\\d)[T_ ](?=\\d))?/; pattern name => ['time', 'iso'], create => join '', qq/(?k:/, qq/(?=\\d)/, # Expect a digit qq/(?:/, # Begin optional date portion qq/(?k:$master{yr4})/, $m2middle, qq/(?k:$master{dy2})/, qq/)?/, # End optional date portion $dt_sep, qq/(?:/, # Begin optional time portion qq/(?k:$master{hr2})/, $min2middle, qq/(?k:$master{sc2})/, qq/)?)/; # End optional time portion pattern name => ['time', 'mail'], create => join '', qq/(?k:$npd/, # No preceeding digit qq/(?=\\d)/, # Expect a digit qq/(?k:$master{dy12})\\s*/, # Day qq/(?k:$master{ema})\\s*/, # Month (english name abbreviation) qq/(?k:$master{yr24})\\s+/, # Year qq/(?k:$master{hr2}):/, # Hour qq/(?k:$master{mi2}):/, # Minute qq/(?k:$master{sc2})\\s*/, # Second qq/(?k:$master{tz})/, # Time zone qq/$nfd)/; # No trailing digit pattern name => ['time', 'MAIL'], create => join '', qq/(?k:$npd/, # No preceeding digit qq/(?=\\d)/, # Expect a digit qq/(?k:$master{dy12})\\s*/, # Day qq/(?k:$master{ema})\\s*/, # Month (english name abbreviation) qq/(?k:$master{yr4})\\s+/, # Year qq/(?k:$master{hr2}):/, # Hour qq/(?k:$master{mi2}):/, # Minute qq/(?k:$master{sc2})\\s*/, # Second qq/(?k:[-+]\\d{4})/, # Time zone qq/$nfd)/; # No trailing digit 1; __END__ =head1 SYNOPSIS use Regexp::Common qw(time); # Piecemeal, Time::Format-like patterns $RE{time}{tf}{-pat => 'pattern'} # Piecemeal, strftime-like patterns $RE{time}{strftime}{-pat => 'pattern'} # Match ISO8601-style date/time strings $RE{time}{iso} # Match RFC2822-style date/time strings $RE{time}{mail} $RE{time}{MAIL} # more-strict matching # Match informal American date strings $RE{time}{american} # Fuzzy date patterns # YEAR/MONTH/DAY $RE{time}{ymd} # Most flexible $RE{time}{YMD} # Strictest (equivalent to y4m2d2) # Other available patterns: y2md, y4md, y2m2d2, y4m2d2 # MONTH/DAY/YEAR (American style) $RE{time}{mdy} # Most flexible $RE{time}{MDY} # Strictest (equivalent to m2d2y4) # Other available patterns: mdy2, mdy4, m2d2y2, m2d2y4 # DAY/MONTH/YEAR (European style) $RE{time}{mdy} # Most flexible $RE{time}{MDY} # Strictest (equivalent to d2m2y4) # Other available patterns: dmy2, dmy4, d2m2y2, d2m2y4 # Fuzzy time pattern # HOUR/MINUTE/SECOND $RE{time}{hms} # H: matches 1 or 2 digits; 12 or 24 hours # M: matches 2 digits. # S: matches 2 digits; may be omitted # May be followed by "a", "am", "p.m.", etc. =head1 DESCRIPTION This module creates regular expressions that can be used for parsing dates and times. See L for a general description of how to use this interface. Parsing dates is a dirty business. Dates are generally specified in one of three possible orders: year/month/day, month/day/year, or day/month/year. Years can be specified with four digits or with two digits (with assumptions made about the century). Months can be specified as one digit, two digits, as a spelled-out name, or as a three-letter abbreviation. Day numbers can be one digit or two digits, with limits depending on the month (and, in the case of February, even the year). Also, different people use different punctuation for separating the various elements. A human can easily recognize that "October 21, 2005" and "21.10.05" refer to the same date, but it's tricky to get a program to come to the same conclusion. This module attempts to make it possible to do so, with a minimum of difficulty. =over 4 =item * If you know the exact format of the data to be matched, use one of the specific, piecemeal pattern builders: C or C. =item * If you are parsing RFC-2822 mail headers, use the C pattern. =item * If you are parsing informal American dates, use the C pattern. =item * If there is some variability in your input data, use one of the fuzzy-matching patterns in the C, C, or C families. =item * If the data are wildly variable, such as raw user input, you should probably give up and use L or L. =back Time values are generally much simpler to parse than date values. Only one fuzzy pattern is provided, and it should suffice for most needs. =head1 Time::Format PATTERNS The L module uses simple, intuitive strings for specifying date and time formats. You can use these patterns here as well. See L for details about its format specifiers. I $str = 'Thu November 2, 2005'; $str =~ $RE{time}{tf}{-pat => 'Day Month d, yyyy'}; The patterns can contain more complex regexp expressions as well: $str =~ $RE{time}{tf}{-pat => '(Weekday|Day) (Month|Mon) d, yyyy'}; Time zone matching (the C format code) attempts to adhere to RFC2822 and ISO8601 as much as possible. The following time zones are matched: Z UT UTC +hh:mm -hh:mm +hhmm -hhmm +hh -hh GMT EST EDT CST CDT MST MDT PST PDT =head1 strftime PATTERNS The POSIX C function is a long-recognized standard for formatting dates and times. This module supports most of C's codes for matching; specifically, the C codes. The C<%Z> format matches time zones in the same manner as described above under L. Also, this module provides the following nonstandard codes: C< %_d -> 1- or 2-digit day number (1-31) C< %_H -> 1- or 2-digit hour (0-23) C< %_I -> 1- or 2-digit hour (1-12) C< %_m -> 1- or 2-digit month number (1-12) C< %_M -> 1- or 2-digit minute (0-59) I $str = 'Thu November 2, 2005'; $str =~ $RE{time}{strftime}{-pat => '%a %B %_d, %Y'}; The patterns can contain more complex regexp expressions as well: $str =~ $RE{time}{strftime}{-pat => '(%A|%a)? (%B|%b) ?%_d, %Y'}; =head1 ISO-8601 DATE/TIME MATCHING The C<$RE{time}{iso}> pattern will match most (all?) strings formatted as recommended by ISO-8601. The canonical ISO-8601 form is: YYYY-MM-DDTHH:MM:SS (where "C" is a literal T character). The C<$RE{time}{iso}> pattern will match this form, and some variants: =over 4 =item * The date separator character may be a hyphen, slash (C), period, or empty string (omitted). The two date separators must match. =item * The time separator character may be a colon, a period, a space, or empty string (omitted). The two time separators must match. =item * The date-time separator may be a C, an underscore, a space, or empty string (omitted). =item * Either the date or the time may be omitted. But at least one must be there. =item * If the date is not omitted, all three of its components must be present. =item * If the time is not omitted, all three of its components must be present. =back =head1 RFC 2822 MATCHING RFC 2822 specifies the format of date/time values in e-mail message headers. In a nutshell, the format is: dd Mon yyyy hh:mm:ss +zzzz where C
is the day of the month; C is the abbreviated month name (apparently always in English); C is the year; C is the time; and C<+zzzz> is the time zone, generally specified as an offset from GMT. RFC 2822 requires that the weekday also be specified, but this module ignores the weekday, as it is redundant and only supplied for human readability. RFC 2822 requires that older, obsolete date forms be allowed as well; for example, alphanumeric time zone codes (e.g. EDT). This module's C allows for these obsolete date forms. If you want to match only the proper date forms recommended by RFC 2822, you can use the C pattern instead. In either case, C or C, the pattern generated is very flexible about whitespace. The main differences are: with C, two-digit years are not permitted, and the time zone must be four digits preceded by a + or - sign. =head1 INFORMAL AMERICAN MATCHING People in North America, particularly in the United States, are fond of specifying dates as "Month dd, yyyy", or sometimes with a two-digit year and apostrophe: "Month dd, 'yy". The C pattern matches this style of date. It allows either a month name or abbreviation, and is flexible with respect to commas and whitespace. =head1 FUZZY PATTERN OVERVIEW Fuzzy date patterns have the following properties in common: =over =item * The pattern names consist of the letters C, C, and C, each optionally followed by a digit (C<2> for C and C; C<2> or C<4> for C). =item * If a C is followed by a 2 or a 4, it must match that many digits. =item * If a C has no trailing digit, it can match I 2 or 4 digits, trying 4 first. =item * If an C is followed by a 2, then only two-digit matches for the month are considered, and month names are not matched. =item * If an C is not followed by a 2, then the month may be 1 or 2 digits, or a spelled-out name. =item * Just like for months, if a C is followed by a 2, then only two-digit matches for the day are considered. =item * Just like for months, if a C has no trailing digit, then the day may be 1 or 2 digits, and a 1-digit match may not have any adjacent digits. =item * The uppercase C, C, and C patterns are synonyms for the strict C, C, and C patterns, respectively. =item * If a one-digit match is considered for the month, then no adjacent digits are allowed. (e.g.: "1/23/45" in M/D/Y format has a valid one-digit month match, but "12345" does not. Nor does "91/23/45"). =item * If a pattern begins with an digitless C, C, or C, then, in the string to be matched, any leading digits will cause the pattern to fail. For example: C<"012/23/45"> will I match C<$RE{time}{mdy}>. However, it I match C<$RE{time}{m2d2y2}>. If you specify an exact pattern by using C instead of C, this module assumes you know what you're doing. =item * Likewise, a pattern ending with a digitless C or C will not match if there are trailing digits in the string. =back =head1 FUZZY PATTERN DETAILS =head2 Year-Month-Day order =over =item $RE{time}{ymd} "05/4/2" =~ $RE{time}{ymd}; "2005-APR-02" =~ $RE{time}{ymd}; This is the most flexible of the numeric-only year/month/day formats. It matches a date of the form "year/month/day", where the year may be 2 or 4 digits; the month may be 1 or 2 digits or a spelled-out name or name abbreviation, and the day may be 1 or 2 digits. The year/month/day elements may be directly adjacent to each other, or may be separated by a space, period, slash (C), or hyphen. =item $RE{time}{y4md} "2005/4/2" =~ $RE{time}{y4md}; "2005 APR 02" =~ $RE{time}{y4md}; This works as L<$RE{time}{ymd}>, except that the year is restricted to be exactly 4 digits. =item $RE{time}{y4m2d2} "2005/04/02" =~ $RE{time}{y4m2d2}; This works as L<$RE{time}{ymd}>, except that the year is restricted to be exactly 4 digits, and the month and day must be exactly 2 digits each. =item $RE{time}{y2md} "05/4/2" =~ $RE{time}{y2md}; "05.APR.02" =~ $RE{time}{y2md}; This works as L<$RE{time}{ymd}>, except that the year is restricted to be exactly 2 digits. =item $RE{time}{y2m2d2} "05/04/02" =~ $RE{time}{y2m2d2}; This works as L<$RE{time}{ymd}>, except that the year is restricted to be exactly 2 digits, and the month and day must be exactly 2 digits each. =item $RE{time}{YMD} "2005/04/02" =~ $RE{time}{YMD}; This is a shorthand for the "canonical" year/month/day format, C. =back =head2 Month-Day-Year (American) order =over =item $RE{time}{mdy} =item $RE{time}{mdy4} =item $RE{time}{m2d2y4} =item $RE{time}{mdy2} =item $RE{time}{m2d2y2} =item $RE{time}{MDY} These patterns function as the equivalent year/month/day patterns, above; the only difference is the order of the elements. C is a synonym for C. =back =head2 Day-Month-Year (European) order =over =item $RE{time}{dmy} =item $RE{time}{dmy4} =item $RE{time}{d2m2y4} =item $RE{time}{dmy2} =item $RE{time}{d2m2y2} =item $RE{time}{DMY} These patterns function as the equivalent year/month/day patterns, above; the only difference is the order of the elements. C is a synonym for C. =back =head1 Time pattern (Hour-minute-second) =over =item $RE{time}{hms} "10:06:12a" =~ /$RE{time}{hms}/; "9:00 p.m." =~ /$RE{time}{hms}/; Matches a time value in a string. The hour must be in the range 0 to 24. The minute and second values must be in the range 0 to 59, and must be two digits (i.e., they must have leading zeroes if less than 10). The hour, minute, and second components may be separated by colons (C<:>), periods, or spaces. The "seconds" value may be omitted. The time may be followed by an "am/pm" indicator; that is, one of the following values: a am a.m. p pm p.m. A AM A.M. P PM P.M. There may be a space between the time and the am/pm indicator. =back =head1 CAPTURES (-keep) Under C<-keep>, the C and C patterns capture the entire match as C<$1>, plus one capture variable for each format specifier. However, if your pattern contains any parentheses, C and C will I capture anything additional beyond what you specify, C<-keep> or not. In other words: if you use parentheses, you are responsible for all capturing. The C pattern captures: C< $1 -> the entire match C< $2 -> the year C< $3 -> the month C< $4 -> the day C< $5 -> the hour C< $6 -> the minute C< $7 -> the second The year, month, and day (C<$2>, C<$3>, and C<$4>) will be C if the matched string contains only a time value (e.g., "12:34:56"). The hour, minute, and second (C<$5>, C<$6>, and C<$7>) will be C if the matched string contains only a date value (e.g., "2005-01-23"). The C and C patterns capture: C< $1 -> the entire match C< $2 -> the day C< $3 -> the month C< $4 -> the year C< $5 -> the hour C< $6 -> the minute C< $7 -> the second C< $8 -> the time zone The C pattern captures: C< $1 -> the entire match C< $2 -> the month C< $3 -> the day C< $4 -> the year The fuzzy y/m/d patterns capture C< $1 -> the entire match C< $2 -> the year C< $3 -> the month C< $4 -> the day The fuzzy m/d/y patterns capture C< $1 -> the entire match C< $2 -> the month C< $3 -> the day C< $4 -> the year The fuzzy d/m/y patterns capture C< $1 -> the entire match C< $2 -> the day C< $3 -> the month C< $4 -> the year The fuzzy h/m/s pattern captures C< $1 -> the entire match C< $2 -> the hour C< $3 -> the minute C< $4 -> the second (C if omitted) C< $5 -> the am/pm indicator (C if omitted) =head1 EXAMPLES # Typical usage: parsing a data record. # $rec = "blah blah 2005/10/21 blah blarrrrrgh"; @date = $rec =~ m{^blah blah $RE{time}{YMD}{-keep}}; # or @date = $rec =~ m{^blah blah $RE{time}{tf}{-pat=>'yyyy/mm/dd'}{-keep}}; # or @date = $rec =~ m{^blah blah $RE{time}{strftime}{-pat=>'%Y/%m/%d'}{-keep}}; # Typical usage: parsing variable-format data. # use Time::Normalize; $record = "10-SEP-2005"; # This block tries M-D-Y first, then D-M-Y, then Y-M-D my $matched; foreach my $pattern (qw(mdy dmy ymd)) { @values = $record =~ /^$RE{time}{$pattern}{-keep}/ or next; $matched = $pattern; } if ($matched) { eval{ ($year, $month, $day) = normalize_rct($matched, @values) }; if ($@) { .... # handle erroneous data } } else { .... # no match } # # $day is now 10; $month is now 09; $year is now 2005. # Time examples $time = '9:10pm'; @time_data = $time =~ /$RE{time}{hms}{-keep}/; # captures '9:10pm', '9', '10', undef, 'pm' @time_data = $time =~ /$RE{time}{tf}{-pat => '(h):(mm)(:ss)?(am)?'}{-keep}/; # captures '9', '10', undef, 'pm' =head1 EXPORTS This module exports no symbols to the caller's namespace. =head1 SEE ALSO It's not enough that the date regexps can match various formats. You then have to parse those matched data values and translate them into useful values. The L module is highly recommended for performing this repetitive, error-prone task. =head1 REQUIREMENTS Requires L, of course. If L and L are available, this module will use them; otherwise, it will use hardcoded English values for month and weekday names. L is required for the test suite. =head1 AUTHOR / COPYRIGHT Copyright (c) 2005-2008 by Eric J. Roode, ROODE I<-at-> cpan I<-dot-> org All rights reserved. To avoid my spam filter, please include "Perl", "module", or this module's name in the message's subject line, and/or GPG-sign your message. This module is copyrighted only to ensure proper attribution of authorship and to ensure that it remains available to all. This module is free, open-source software. This module may be freely used for any purpose, commercial, public, or private, provided that proper credit is given, and that no more-restrictive license is applied to derivative (not dependent) works. Substantial efforts have been made to ensure that this software meets high quality standards; however, no guarantee can be made that there are no undiscovered bugs, and no warranty is made as to suitability to any given use, including merchantability. Should this module cause your house to burn down, your dog to collapse, your heart-lung machine to fail, your spouse to desert you, or George Bush to be re-elected, I can offer only my sincere sympathy and apologies, and promise to endeavor to improve the software. =cut Regexp-Common-time-0.05/t000755001750001750 012243100275 14660 5ustar00gaborgabor000000000000Regexp-Common-time-0.05/t/american.t000444001750001750 2062612243100275 17007 0ustar00gaborgabor000000000000use vars qw(@match $num_tests); # Get day/month names in current locale my ($Jan, $Feb, $Mar, $Apr, $May, $Jun, $Jul, $Aug, $Sep, $Oct, $Nov, $Dec); my ($January, $February, $March, $April, $MayFull, $June, $July, $August, $September, $October, $November, $December); BEGIN { eval { require I18N::Langinfo; I18N::Langinfo->import(qw(langinfo MON_1 ABMON_1 MON_2 ABMON_2 MON_3 ABMON_3 MON_4 ABMON_4 MON_5 ABMON_5 MON_6 ABMON_6 MON_7 ABMON_7 MON_8 ABMON_8 MON_9 ABMON_9 MON_10 ABMON_10 MON_11 ABMON_11 MON_12 ABMON_12)); ($Jan, $Feb, $Mar, $Apr, $May, $Jun, $Jul, $Aug, $Sep, $Oct, $Nov, $Dec) = map langinfo($_), (ABMON_1(), ABMON_2(), ABMON_3(), ABMON_4(), ABMON_5(), ABMON_6(), ABMON_7(), ABMON_8(), ABMON_9(), ABMON_10(), ABMON_11(), ABMON_12()); ($January, $February, $March, $April, $MayFull, $June, $July, $August, $September, $October, $November, $December) = map langinfo($_), (MON_1(), MON_2(), MON_3(), MON_4(), MON_5(), MON_6(), MON_7(), MON_8(), MON_9(), MON_10(), MON_11(), MON_12()); }; if ($@) { ($Jan, $Feb, $Mar, $Apr, $May, $Jun, $Jul, $Aug, $Sep, $Oct, $Nov, $Dec) = qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec); ($January, $February, $March, $April, $MayFull, $June, $July, $August, $September, $October, $November, $December) = qw(January February March April May June July August September October November December); } @match = ( # Base case ["$March 23, 2008", 'american', [], 1, [qq($March 23, 2008), $March, qw(23 2008)]], # Short month name ["$Mar 23, 2008", 'american', [], 1, [qq($Mar 23, 2008), $Mar, qw(23 2008)]], # Bad month name. I hope that "Blorxzt" isn't a real month name in any locale. ["Blorxzt 23, 2008", 'american', [], 0, ], # Year variations ["$Jan 12, 1900", 'american', [], 1, [qq($Jan 12, 1900), $Jan, qw(12 1900)]], ["$Jan 12, '00", 'american', [], 1, [qq($Jan 12, '00), $Jan, qw(12 '00)]], ["$January 12, 00", 'american', [], 1, [qq($January 12, 00), $January, qw(12 00)]], # All 12 months: ["$January 1, 2099", 'american', [], 1, [qq($January 1, 2099), $January, qw(1 2099)]], ["$February 2, 2098", 'american', [], 1, [qq($February 2, 2098), $February, qw(2 2098)]], ["$March 3, 2097", 'american', [], 1, [qq($March 3, 2097), $March, qw(3 2097)]], ["$April 4, 2096", 'american', [], 1, [qq($April 4, 2096), $April, qw(4 2096)]], ["$MayFull 5, 2095", 'american', [], 1, [qq($MayFull 5, 2095), $MayFull, qw(5 2095)]], ["$June 6, 2094", 'american', [], 1, [qq($June 6, 2094), $June, qw(6 2094)]], ["$July 7, 2093", 'american', [], 1, [qq($July 7, 2093), $July, qw(7 2093)]], ["$August 8, 2092", 'american', [], 1, [qq($August 8, 2092), $August, qw(8 2092)]], ["$September 9, 2091", 'american', [], 1, [qq($September 9, 2091), $September, qw(9 2091)]], ["$October 10, 2090", 'american', [], 1, [qq($October 10, 2090), $October, qw(10 2090)]], ["$November 11, '89", 'american', [], 1, [qq($November 11, '89), $November, qw(11 '89)]], ["$December 12, 87", 'american', [], 1, [qq($December 12, 87), $December, qw(12 87)]], # All 12 month abbreviations: ["$Jan 1, 2099", 'american', [], 1, [qq($Jan 1, 2099), $Jan, qw(1 2099)]], ["$Feb 2, 2098", 'american', [], 1, [qq($Feb 2, 2098), $Feb, qw(2 2098)]], ["$Mar 3, 2097", 'american', [], 1, [qq($Mar 3, 2097), $Mar, qw(3 2097)]], ["$Apr 4, 2096", 'american', [], 1, [qq($Apr 4, 2096), $Apr, qw(4 2096)]], ["$May 5, 2095", 'american', [], 1, [qq($May 5, 2095), $May, qw(5 2095)]], ["$Jun 6, 2094", 'american', [], 1, [qq($Jun 6, 2094), $Jun, qw(6 2094)]], ["$Jul 7, 2093", 'american', [], 1, [qq($Jul 7, 2093), $Jul, qw(7 2093)]], ["$Aug 8, 2092", 'american', [], 1, [qq($Aug 8, 2092), $Aug, qw(8 2092)]], ["$Sep 9, 2091", 'american', [], 1, [qq($Sep 9, 2091), $Sep, qw(9 2091)]], ["$Oct 10, 2090", 'american', [], 1, [qq($Oct 10, 2090), $Oct, qw(10 2090)]], ["$Nov 11, '89", 'american', [], 1, [qq($Nov 11, '89), $Nov, qw(11 '89)]], ["$Dec 12, 87", 'american', [], 1, [qq($Dec 12, 87), $Dec, qw(12 87)]], # Comma variations ["$MayFull 5, 2001", 'american', [], 1, [qq($MayFull 5, 2001), $MayFull, qw(5 2001)]], ["$MayFull 5 2001", 'american', [], 1, [qq($MayFull 5 2001), $MayFull, qw(5 2001)]], ["$MayFull 5 2001", 'american', [], 0, ], ["$MayFull 5,2001", 'american', [], 1, [qq($MayFull 5,2001), $MayFull, qw(5 2001)]], ["$MayFull 5 ,2001", 'american', [], 0, ], # Whitespace variations ["$Sep 9, 1945", 'american', [], 1, [qq($Sep 9, 1945), $Sep, qw(9 1945)]], ["${Sep}9, 1945", 'american', [], 0, ], ["$Sep 9, 1945", 'american', [], 1, [qq($Sep 9, 1945), $Sep, qw(9 1945)]], ["$Sep 19, 1945", 'american', [], 1, [qq($Sep 19, 1945), $Sep, qw(19 1945)]], ["$Sep 9, 1945", 'american', [], 0, ], ["$Sep 9, 1945", 'american', [], 0, ], # Extraneous stuff before & after ["abcd$March 13, 2008", 'american', [], 0, ], ["0123$March 13, 2008", 'american', [], 0, ], ["$March 13, 200", 'american', [], 0, ], ["$March 13, 2008abcd", 'american', [], 1, [qq($March 13, 2008), $March, qw(13 2008)]], ["$March 13, 20080", 'american', [], 0, ], ); # How many matches will succeed? my $to_succeed = scalar grep $_->[3], @match; # Run two tests per match, plus two additional per expected success $num_tests = 2 * scalar(@match) + 2 * $to_succeed; # Plus one for the 'use_ok' call $num_tests += 1; } use Test::More tests => $num_tests; use_ok('Regexp::Common', 'time'); foreach my $match (@match) { my ($text, $name, $flags, $should_succeed, $matchvars) = @$match; my $testname = qq{"$text" =~ "$name"}; my $did_succeed; my @captures; # Regexp captures # FIRST: check whether it succeeded or failed as expected. # 'keep' option is OFF; should be no captures. if (@$flags) { my $flags = join $; => @$flags; @captures = $text =~ /$RE{time}{$name}{$flags}/; } else { @captures = $text =~ /$RE{time}{$name}/; } $did_succeed = @captures > 0; my $ought = $should_succeed? 'match' : 'fail'; my $actual = $did_succeed == $should_succeed? "${ought}ed" : "did not $ought"; # TEST 1: simple matching ok ( ($should_succeed && $did_succeed) || (!$should_succeed && !$did_succeed), "$testname - $actual as expected (nokeep)."); # TEST 2: Shouldn't capture anything if ($should_succeed) { SKIP: { skip "$testname - can't check captures since match unsuccessful", 1 if !$did_succeed; is_deeply(\@captures, [1], "$testname - didn't unduly capture"); } } # SECOND: use 'keep' option to check captures. if (@$flags) { my $flags = join $; => @$flags; @captures = $text =~ /$RE{time}{$name}{$flags}{-keep}/; } else { @captures = $text =~ /$RE{time}{$name}{-keep}/; } $did_succeed = @captures > 0; # TEST 3: matching with 'keep' ok ( ($should_succeed && $did_succeed) || (!$should_succeed && !$did_succeed), "$testname - $actual as expected (keep)."); # TEST 4: capture variables should be set. if ($should_succeed) { SKIP: { skip "$testname - can't check captures since match unsuccessful", 1 if !$did_succeed; is_deeply(\@captures, $matchvars, "$testname - correct capture variables"); } } } Regexp-Common-time-0.05/t/hms.t000444001750001750 1344312243100275 16016 0ustar00gaborgabor000000000000use vars qw(@match $num_tests); BEGIN { @match = ( # hms tests. # Base case ['10:23:45am', 'hms', [], 1, [qw(10:23:45am 10 23 45 am)]], # am/pm variations ['10:23:45a', 'hms', [], 1, [q(10:23:45a), qw(10 23 45 a)]], ['10:23:45am', 'hms', [], 1, [q(10:23:45am), qw(10 23 45 am)]], ['10:23:45a.m.', 'hms', [], 1, [q(10:23:45a.m.), qw(10 23 45 a.m.)]], ['10:23:45 a', 'hms', [], 1, [q(10:23:45 a), qw(10 23 45 a)]], ['10:23:45 am', 'hms', [], 1, [q(10:23:45 am), qw(10 23 45 am)]], ['10:23:45 a.m.', 'hms', [], 1, [q(10:23:45 a.m.), qw(10 23 45 a.m.)]], ['10:23:45p', 'hms', [], 1, [q(10:23:45p), qw(10 23 45 p)]], ['10:23:45pm', 'hms', [], 1, [q(10:23:45pm), qw(10 23 45 pm)]], ['10:23:45p.m.', 'hms', [], 1, [q(10:23:45p.m.), qw(10 23 45 p.m.)]], ['10:23:45 p', 'hms', [], 1, [q(10:23:45 p), qw(10 23 45 p)]], ['10:23:45 pm', 'hms', [], 1, [q(10:23:45 pm), qw(10 23 45 pm)]], ['10:23:45 p.m.', 'hms', [], 1, [q(10:23:45 p.m.), qw(10 23 45 p.m.)]], ['10:23:45A', 'hms', [], 1, [q(10:23:45A), qw(10 23 45 A)]], ['10:23:45AM', 'hms', [], 1, [q(10:23:45AM), qw(10 23 45 AM)]], ['10:23:45A.M.', 'hms', [], 1, [q(10:23:45A.M.), qw(10 23 45 A.M.)]], ['10:23:45 A', 'hms', [], 1, [q(10:23:45 A), qw(10 23 45 A)]], ['10:23:45 AM', 'hms', [], 1, [q(10:23:45 AM), qw(10 23 45 AM)]], ['10:23:45 A.M.', 'hms', [], 1, [q(10:23:45 A.M.), qw(10 23 45 A.M.)]], ['10:23:45P', 'hms', [], 1, [q(10:23:45P), qw(10 23 45 P)]], ['10:23:45PM', 'hms', [], 1, [q(10:23:45PM), qw(10 23 45 PM)]], ['10:23:45P.M.', 'hms', [], 1, [q(10:23:45P.M.), qw(10 23 45 P.M.)]], ['10:23:45 P', 'hms', [], 1, [q(10:23:45 P), qw(10 23 45 P)]], ['10:23:45 PM', 'hms', [], 1, [q(10:23:45 PM), qw(10 23 45 PM)]], ['10:23:45 P.M.', 'hms', [], 1, [q(10:23:45 P.M.), qw(10 23 45 P.M.)]], # Separators ['10.23.45am', 'hms', [], 1, [qw(10.23.45am 10 23 45 am)]], ['10 23 45 am','hms', [], 1, [q(10 23 45 am), qw(10 23 45 am)]], ['10/23/45 am','hms', [], 0, ], # Hour boundaries ['0:23:45', 'hms', [], 1, [qw(0:23:45 0 23 45), undef]], ['1:23:45', 'hms', [], 1, [qw(1:23:45 1 23 45), undef]], ['12:23:45', 'hms', [], 1, [qw(12:23:45 12 23 45), undef]], ['13:23:45', 'hms', [], 1, [qw(13:23:45 13 23 45), undef]], ['23:23:45', 'hms', [], 1, [qw(23:23:45 23 23 45), undef]], ['24:34:45', 'hms', [], 0, ], ['25:46:45', 'hms', [], 0, ], ['99:46:45', 'hms', [], 0, ], # Minute limits ['10:00:45am', 'hms', [], 1, [qw(10:00:45am 10 00 45 am)]], ['10:59:45am', 'hms', [], 1, [qw(10:59:45am 10 59 45 am)]], ['10:60:45am', 'hms', [], 0, ], # No second limits! Because out-of-range means no match; must catch in normalize_hms. # Optional seconds ['10:23am', 'hms', [], 1, [qw(10:23am 10 23), undef, qw(am)]], # Optional am/pm ['10:23:45', 'hms', [], 1, [qw(10:23:45 10 23 45), undef]], # Optional both ['10:23', 'hms', [], 1, [qw(10:23 10 23), undef, undef]], ); # How many matches will succeed? my $to_succeed = scalar grep $_->[3], @match; # Run two tests per match, plus two additional per expected success $num_tests = 2 * scalar(@match) + 2 * $to_succeed; # Plus one for the 'use_ok' call $num_tests += 1; } use Test::More tests => $num_tests; use_ok('Regexp::Common', 'time'); foreach my $match (@match) { my ($text, $name, $flags, $should_succeed, $matchvars) = @$match; my $testname = qq{"$text" =~ "$name"}; my $did_succeed; my @captures; # Regexp captures # FIRST: check whether it succeeded or failed as expected. # 'keep' option is OFF; should be no captures. if (@$flags) { my $flags = join $; => @$flags; @captures = $text =~ /$RE{time}{$name}{$flags}/; } else { @captures = $text =~ /$RE{time}{$name}/; } $did_succeed = @captures > 0; my $ought = $should_succeed? 'match' : 'fail'; my $actual = $did_succeed == $should_succeed? "${ought}ed" : "did not $ought"; # TEST 1: simple matching ok ( ($should_succeed && $did_succeed) || (!$should_succeed && !$did_succeed), "$testname - $actual as expected (nokeep)."); # TEST 2: Shouldn't capture anything if ($should_succeed) { SKIP: { skip "$testname - can't check captures since match unsuccessful", 1 if !$did_succeed; is_deeply(\@captures, [1], "$testname - didn't unduly capture"); } } # SECOND: use 'keep' option to check captures. if (@$flags) { my $flags = join $; => @$flags; @captures = $text =~ /$RE{time}{$name}{$flags}{-keep}/; } else { @captures = $text =~ /$RE{time}{$name}{-keep}/; } $did_succeed = @captures > 0; # TEST 3: matching with 'keep' ok ( ($should_succeed && $did_succeed) || (!$should_succeed && !$did_succeed), "$testname - $actual as expected (keep)."); # TEST 4: capture variables should be set. if ($should_succeed) { SKIP: { skip "$testname - can't check captures since match unsuccessful", 1 if !$did_succeed; is_deeply(\@captures, $matchvars, "$testname - correct capture variables"); } } } Regexp-Common-time-0.05/t/ymd.t000444001750001750 10735112243100275 16042 0ustar00gaborgabor000000000000use strict; use vars qw(@match $num_tests %RE); # Get day/month names in current locale my ($Jan, $Feb, $Mar, $Apr, $May, $Jun, $Jul, $Aug, $Sep, $Oct, $Nov, $Dec); my ($January, $February, $March, $April, $MayFull, $June, $July, $August, $September, $October, $November, $December); BEGIN { eval { require I18N::Langinfo; I18N::Langinfo->import(qw(langinfo MON_1 ABMON_1 MON_2 ABMON_2 MON_3 ABMON_3 MON_4 ABMON_4 MON_5 ABMON_5 MON_6 ABMON_6 MON_7 ABMON_7 MON_8 ABMON_8 MON_9 ABMON_9 MON_10 ABMON_10 MON_11 ABMON_11 MON_12 ABMON_12)); ($Jan, $Feb, $Mar, $Apr, $May, $Jun, $Jul, $Aug, $Sep, $Oct, $Nov, $Dec) = map langinfo($_), (ABMON_1(), ABMON_2(), ABMON_3(), ABMON_4(), ABMON_5(), ABMON_6(), ABMON_7(), ABMON_8(), ABMON_9(), ABMON_10(), ABMON_11(), ABMON_12()); ($January, $February, $March, $April, $MayFull, $June, $July, $August, $September, $October, $November, $December) = map langinfo($_), (MON_1(), MON_2(), MON_3(), MON_4(), MON_5(), MON_6(), MON_7(), MON_8(), MON_9(), MON_10(), MON_11(), MON_12()); }; if ($@) { ($Jan, $Feb, $Mar, $Apr, $May, $Jun, $Jul, $Aug, $Sep, $Oct, $Nov, $Dec) = qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec); ($January, $February, $March, $April, $MayFull, $June, $July, $August, $September, $October, $November, $December) = qw(January February March April MayFull June July August September October November December); } @match = ( # ymd tests. ['2005/10/19', 'ymd', [], 1, [qw(2005/10/19 2005 10 19)]], ['2005.10.19', 'ymd', [], 1, [qw(2005.10.19 2005 10 19)]], ['2005-10-19', 'ymd', [], 1, [qw(2005-10-19 2005 10 19)]], ['2005x10x19', 'ymd', [], 0, ], ['20051019', 'ymd', [], 1, [qw(20051019 2005 10 19)]], # leading/trailing junk shouldn't cause the match to change ['abc2005/10/19xyz', 'ymd', [], 1, [qw(2005/10/19 2005 10 19)]], ['abc2005.10.19xyz', 'ymd', [], 1, [qw(2005.10.19 2005 10 19)]], ['abc2005-10-19xyz', 'ymd', [], 1, [qw(2005-10-19 2005 10 19)]], ['abc2005x10x19xyz', 'ymd', [], 0, ], ['abc20051019xyz', 'ymd', [], 1, [qw(20051019 2005 10 19)]], # However, leading or trailing digits should cause this loose match to fail. ['abc2005/10/190', 'ymd', [], 0, ], ['02005-10-19xyz', 'ymd', [], 0, ], # Mismatched or otherwise bogus separators ['2005:10:19', 'ymd', [], 0, ], ['2005/10-19', 'ymd', [], 0, ], ['2005-10/19', 'ymd', [], 0, ], ['2005-10.19', 'ymd', [], 0, ], ['2005.10-19', 'ymd', [], 0, ], ['2005-1019', 'ymd', [], 0, ], ['2005.1019', 'ymd', [], 0, ], ['2005/1019', 'ymd', [], 0, ], ['200510-19', 'ymd', [], 1, [qw(200510 20 05 10)]], ['200510.19', 'ymd', [], 1, [qw(200510 20 05 10)]], ['200510/19', 'ymd', [], 1, [qw(200510 20 05 10)]], # Odd number of digits in year ['5/10/19', 'ymd', [], 0, ], ['205/10/19', 'ymd', [], 0, ], ['12005/10/19','ymd', [], 0, ], # Two-year date should match ymd as well ['05/10/19', 'ymd', [], 1, [qw(05/10/19 05 10 19)]], ['05.10.19', 'ymd', [], 1, [qw(05.10.19 05 10 19)]], ['05-10-19', 'ymd', [], 1, [qw(05-10-19 05 10 19)]], ['05x10x19', 'ymd', [], 0, ], ['051019', 'ymd', [], 1, [qw(051019 05 10 19)]], # one-digit month ['2005/1/19', 'ymd', [], 1, [qw(2005/1/19 2005 1 19)]], ['2005.1.19', 'ymd', [], 1, [qw(2005.1.19 2005 1 19)]], ['2005-1-19', 'ymd', [], 1, [qw(2005-1-19 2005 1 19)]], ['2005x1x19', 'ymd', [], 0, ], ['2005119', 'ymd', [], 0, ], # one-digit day ['2005/10/9', 'ymd', [], 1, [qw(2005/10/9 2005 10 9)]], ['2005.10.9', 'ymd', [], 1, [qw(2005.10.9 2005 10 9)]], ['2005-10-9', 'ymd', [], 1, [qw(2005-10-9 2005 10 9)]], ['2005x10x9', 'ymd', [], 0, ], ['2005109', 'ymd', [], 0, ], # one-digit month and day ['2005/1/9', 'ymd', [], 1, [qw(2005/1/9 2005 1 9)]], ['2005.1.9', 'ymd', [], 1, [qw(2005.1.9 2005 1 9)]], ['2005-1-9', 'ymd', [], 1, [qw(2005-1-9 2005 1 9)]], ['2005x1x9', 'ymd', [], 0, ], ['200519', 'ymd', [], 1, [qw(200519 20 05 19)]], # yy/m/dd ['05/1/19', 'ymd', [], 1, [qw(05/1/19 05 1 19)]], ['05.1.19', 'ymd', [], 1, [qw(05.1.19 05 1 19)]], ['05-1-19', 'ymd', [], 1, [qw(05-1-19 05 1 19)]], ['05x1x19', 'ymd', [], 0, ], ['05119', 'ymd', [], 0, ], # yy/mm/d ['05/10/9', 'ymd', [], 1, [qw(05/10/9 05 10 9)]], ['05.10.9', 'ymd', [], 1, [qw(05.10.9 05 10 9)]], ['05-10-9', 'ymd', [], 1, [qw(05-10-9 05 10 9)]], ['05x10x9', 'ymd', [], 0, ], ['05109', 'ymd', [], 0, ], # yy/m/d ['05/1/9', 'ymd', [], 1, [qw(05/1/9 05 1 9)]], ['05.1.9', 'ymd', [], 1, [qw(05.1.9 05 1 9)]], ['05-1-9', 'ymd', [], 1, [qw(05-1-9 05 1 9)]], ['05x1x9', 'ymd', [], 0, ], ['0519', 'ymd', [], 0, ], # Invalid month ['2005/13/19', 'ymd', [], 0, ], ['2005/21/19', 'ymd', [], 0, ], ['2005/0/19', 'ymd', [], 0, ], ['2005/00/19', 'ymd', [], 0, ], # Invalid day ['2005/12/0', 'ymd', [], 0, ], ['2005/12/00', 'ymd', [], 0, ], ['2005/12/40', 'ymd', [], 0, ], ['2005/12/32', 'ymd', [], 0, ], # y4md tests. Mostly the same as above. ['2005/10/19', 'y4md', [], 1, [qw(2005/10/19 2005 10 19)]], ['2005.10.19', 'y4md', [], 1, [qw(2005.10.19 2005 10 19)]], ['2005-10-19', 'y4md', [], 1, [qw(2005-10-19 2005 10 19)]], ['2005x10x19', 'y4md', [], 0, ], ['20051019', 'y4md', [], 1, [qw(20051019 2005 10 19)]], # leading/trailing junk shouldn't cause the match to change # however, trailing digits will cause loose d to fail ['abc2005/10/19xyz', 'y4md', [], 1, [qw(2005/10/19 2005 10 19)]], ['abc2005.10.19000', 'y4md', [], 0, ], ['0002005-10-19000', 'y4md', [], 0, ], ['abc2005x10x19000', 'y4md', [], 0, ], ['abc20051019xyz', 'y4md', [], 1, [qw(20051019 2005 10 19)]], ['abc20051019000', 'y4md', [], 0, ], # Mismatched or otherwise bogus separators ['2005:10:19', 'y4md', [], 0, ], ['2005/10-19', 'y4md', [], 0, ], ['2005-10/19', 'y4md', [], 0, ], ['2005-10.19', 'y4md', [], 0, ], ['2005.10-19', 'y4md', [], 0, ], ['2005-1019', 'y4md', [], 0, ], ['2005.1019', 'y4md', [], 0, ], ['2005/1019', 'y4md', [], 0, ], ['200510-19', 'y4md', [], 0, ], ['200510.19', 'y4md', [], 0, ], ['200510/19', 'y4md', [], 0, ], # Two-year date should not match y4md ['05/10/19', 'y4md', [], 0, ], ['05.10.19', 'y4md', [], 0, ], ['05-10-19', 'y4md', [], 0, ], ['05x10x19', 'y4md', [], 0, ], ['051019', 'y4md', [], 0, ], # one-digit month ['2005/1/19', 'y4md', [], 1, [qw(2005/1/19 2005 1 19)]], ['2005.1.19', 'y4md', [], 1, [qw(2005.1.19 2005 1 19)]], ['2005-1-19', 'y4md', [], 1, [qw(2005-1-19 2005 1 19)]], ['2005x1x19', 'y4md', [], 0, ], ['2005119', 'y4md', [], 0, ], # one-digit day ['2005/10/9', 'y4md', [], 1, [qw(2005/10/9 2005 10 9)]], ['2005.10.9', 'y4md', [], 1, [qw(2005.10.9 2005 10 9)]], ['2005-10-9', 'y4md', [], 1, [qw(2005-10-9 2005 10 9)]], ['2005x10x9', 'y4md', [], 0, ], ['2005109', 'y4md', [], 0, ], # one-digit month and day ['2005/1/9', 'y4md', [], 1, [qw(2005/1/9 2005 1 9)]], ['2005.1.9', 'y4md', [], 1, [qw(2005.1.9 2005 1 9)]], ['2005-1-9', 'y4md', [], 1, [qw(2005-1-9 2005 1 9)]], ['2005x1x9', 'y4md', [], 0, ], ['200519', 'y4md', [], 0, ], # yy/m/dd ['05/1/19', 'y4md', [], 0, ], ['05.1.19', 'y4md', [], 0, ], ['05-1-19', 'y4md', [], 0, ], ['05x1x19', 'y4md', [], 0, ], ['05119', 'y4md', [], 0, ], # yy/mm/d ['05/10/9', 'y4md', [], 0, ], ['05.10.9', 'y4md', [], 0, ], ['05-10-9', 'y4md', [], 0, ], ['05x10x9', 'y4md', [], 0, ], ['05109', 'y4md', [], 0, ], # yy/m/d ['05/1/9', 'y4md', [], 0, ], ['05.1.9', 'y4md', [], 0, ], ['05-1-9', 'y4md', [], 0, ], ['05x1x9', 'y4md', [], 0, ], ['0519', 'y4md', [], 0, ], # Invalid month ['2005/13/19', 'y4md', [], 0, ], ['2005/21/19', 'y4md', [], 0, ], ['2005/0/19', 'y4md', [], 0, ], ['2005/00/19', 'y4md', [], 0, ], # Invalid day ['2005/12/0', 'y4md', [], 0, ], ['2005/12/00', 'y4md', [], 0, ], ['2005/12/40', 'y4md', [], 0, ], ['2005/12/32', 'y4md', [], 0, ], # y2md tests ['2005/10/19', 'y2md', [], 1, [qw(05/10/19 05 10 19)]], ['2005.10.19', 'y2md', [], 1, [qw(05.10.19 05 10 19)]], ['2005-10-19', 'y2md', [], 1, [qw(05-10-19 05 10 19)]], ['2005x10x19', 'y2md', [], 0, ], ['20051019', 'y2md', [], 1, [qw(051019 05 10 19)]], # leading/trailing junk shouldn't cause the match to change ['abc2005/10/19xyz', 'y2md', [], 1, [qw(05/10/19 05 10 19)]], ['abc2005.10.19xyz', 'y2md', [], 1, [qw(05.10.19 05 10 19)]], ['abc2005-10-19xyz', 'y2md', [], 1, [qw(05-10-19 05 10 19)]], ['abc2005x10x19xyz', 'y2md', [], 0, ], ['abc20051019xyz', 'y2md', [], 1, [qw(051019 05 10 19)]], # However, trailing digits will cause loose d to fail ['02005/10/19xyz', 'y2md', [], 1, [qw(05/10/19 05 10 19)]], ['abc2005.10.19000', 'y2md', [], 0, ], # Mismatched or otherwise bogus separators ['05:10:19', 'y2md', [], 0, ], ['05/10-19', 'y2md', [], 0, ], ['05-10/19', 'y2md', [], 0, ], ['05-10.19', 'y2md', [], 0, ], ['05.10-19', 'y2md', [], 0, ], ['05-1019', 'y2md', [], 0, ], ['05.1019', 'y2md', [], 0, ], ['05/1019', 'y2md', [], 0, ], ['0510-19', 'y2md', [], 0, ], ['0510.19', 'y2md', [], 0, ], ['0510/19', 'y2md', [], 0, ], # Two-year date should match ['05/10/19', 'y2md', [], 1, [qw(05/10/19 05 10 19)]], ['05.10.19', 'y2md', [], 1, [qw(05.10.19 05 10 19)]], ['05-10-19', 'y2md', [], 1, [qw(05-10-19 05 10 19)]], ['05x10x19', 'y2md', [], 0, ], ['051019', 'y2md', [], 1, [qw(051019 05 10 19)]], # separators ['05/10/19', 'y2md', [], 1, [qw(05/10/19 05 10 19)]], ['05.10.19', 'y2md', [], 1, [qw(05.10.19 05 10 19)]], ['05-10-19', 'y2md', [], 1, [qw(05-10-19 05 10 19)]], ['05x10x19', 'y2md', [], 0, ], ['051019', 'y2md', [], 1, [qw(051019 05 10 19)]], # one-digit month ['2005/1/19', 'y2md', [], 1, [qw(05/1/19 05 1 19)]], ['2005.1.19', 'y2md', [], 1, [qw(05.1.19 05 1 19)]], ['2005-1-19', 'y2md', [], 1, [qw(05-1-19 05 1 19)]], ['2005x1x19', 'y2md', [], 0, ], ['2005119', 'y2md', [], 0, ], # one-digit day ['2005/10/9', 'y2md', [], 1, [qw(05/10/9 05 10 9)]], ['2005.10.9', 'y2md', [], 1, [qw(05.10.9 05 10 9)]], ['2005-10-9', 'y2md', [], 1, [qw(05-10-9 05 10 9)]], ['2005x10x9', 'y2md', [], 0, ], ['2005109', 'y2md', [], 0, ], # one-digit month and day ['2005/1/9', 'y2md', [], 1, [qw(05/1/9 05 1 9)]], ['2005.1.9', 'y2md', [], 1, [qw(05.1.9 05 1 9)]], ['2005-1-9', 'y2md', [], 1, [qw(05-1-9 05 1 9)]], ['2005x1x9', 'y2md', [], 0, ], ['200519', 'y2md', [], 1, [qw(200519 20 05 19)]], # yy/m/dd ['05/1/19', 'y2md', [], 1, [qw(05/1/19 05 1 19)]], ['05.1.19', 'y2md', [], 1, [qw(05.1.19 05 1 19)]], ['05-1-19', 'y2md', [], 1, [qw(05-1-19 05 1 19)]], ['05x1x19', 'y2md', [], 0, ], ['05119', 'y2md', [], 0, ], # yy/mm/d ['05/10/9', 'y2md', [], 1, [qw(05/10/9 05 10 9)]], ['05.10.9', 'y2md', [], 1, [qw(05.10.9 05 10 9)]], ['05-10-9', 'y2md', [], 1, [qw(05-10-9 05 10 9)]], ['05x10x9', 'y2md', [], 0, ], ['05109', 'y2md', [], 0, ], # yy/m/d ['05/1/9', 'y2md', [], 1, [qw(05/1/9 05 1 9)]], ['05.1.9', 'y2md', [], 1, [qw(05.1.9 05 1 9)]], ['05-1-9', 'y2md', [], 1, [qw(05-1-9 05 1 9)]], ['05x1x9', 'y2md', [], 0, ], ['0519', 'y2md', [], 0, ], # Invalid month ['05/13/19', 'y2md', [], 0, ], ['05/21/19', 'y2md', [], 0, ], ['05/0/19', 'y2md', [], 0, ], ['05/00/19', 'y2md', [], 0, ], # Invalid day ['05/12/0', 'y2md', [], 0, ], ['05/12/00', 'y2md', [], 0, ], ['05/12/40', 'y2md', [], 0, ], ['05/12/32', 'y2md', [], 0, ], # y4m2d2 tests ['2005/10/19', 'y4m2d2', [], 1, [qw(2005/10/19 2005 10 19)]], ['2005.10.19', 'y4m2d2', [], 1, [qw(2005.10.19 2005 10 19)]], ['2005-10-19', 'y4m2d2', [], 1, [qw(2005-10-19 2005 10 19)]], ['2005x10x19', 'y4m2d2', [], 0, ], ['20051019', 'y4m2d2', [], 1, [qw(20051019 2005 10 19)]], # leading/trailing junk shouldn't cause the match to change ['abc2005/10/19000', 'y4m2d2', [], 1, [qw(2005/10/19 2005 10 19)]], ['0002005.10.19000', 'y4m2d2', [], 1, [qw(2005.10.19 2005 10 19)]], ['0002005-10-19000', 'y4m2d2', [], 1, [qw(2005-10-19 2005 10 19)]], ['abc2005x10x19000', 'y4m2d2', [], 0, ], ['abc20051019000', 'y4m2d2', [], 1, [qw(20051019 2005 10 19)]], # Two-year date should not match ['05/10/19', 'y4m2d2', [], 0, ], ['05.10.19', 'y4m2d2', [], 0, ], ['05-10-19', 'y4m2d2', [], 0, ], ['05x10x19', 'y4m2d2', [], 0, ], ['051019', 'y4m2d2', [], 0, ], # separators ['2005/10/19', 'y4m2d2', [], 1, [qw(2005/10/19 2005 10 19)]], ['2005.10.19', 'y4m2d2', [], 1, [qw(2005.10.19 2005 10 19)]], ['2005-10-19', 'y4m2d2', [], 1, [qw(2005-10-19 2005 10 19)]], ['2005x10x19', 'y4m2d2', [], 0, ], ['2005 10 19', 'y4m2d2', [], 1, ['2005 10 19', qw(2005 10 19)]], # one-digit month ['2005/1/19', 'y4m2d2', [], 0, ], ['2005.1.19', 'y4m2d2', [], 0, ], ['2005-1-19', 'y4m2d2', [], 0, ], ['2005x1x19', 'y4m2d2', [], 0, ], ['2005119', 'y4m2d2', [], 0, ], # one-digit day ['2005/10/9', 'y4m2d2', [], 0, ], ['2005.10.9', 'y4m2d2', [], 0, ], ['2005-10-9', 'y4m2d2', [], 0, ], ['2005x10x9', 'y4m2d2', [], 0, ], ['2005109', 'y4m2d2', [], 0, ], # one-digit month and day ['2005/1/9', 'y4m2d2', [], 0, ], ['2005.1.9', 'y4m2d2', [], 0, ], ['2005-1-9', 'y4m2d2', [], 0, ], ['2005x1x9', 'y4m2d2', [], 0, ], ['200519', 'y4m2d2', [], 0, ], # yy/m/dd ['05/1/19', 'y4m2d2', [], 0, ], ['05.1.19', 'y4m2d2', [], 0, ], ['05-1-19', 'y4m2d2', [], 0, ], ['05x1x19', 'y4m2d2', [], 0, ], ['05119', 'y4m2d2', [], 0, ], # yy/mm/d ['05/10/9', 'y4m2d2', [], 0, ], ['05.10.9', 'y4m2d2', [], 0, ], ['05-10-9', 'y4m2d2', [], 0, ], ['05x10x9', 'y4m2d2', [], 0, ], ['05109', 'y4m2d2', [], 0, ], # yy/m/d ['05/1/9', 'y4m2d2', [], 0, ], ['05.1.9', 'y4m2d2', [], 0, ], ['05-1-9', 'y4m2d2', [], 0, ], ['05x1x9', 'y4m2d2', [], 0, ], ['0519', 'y4m2d2', [], 0, ], # Invalid month ['2005/13/19', 'y4m2d2', [], 0, ], ['2005/21/19', 'y4m2d2', [], 0, ], ['2005/0/19', 'y4m2d2', [], 0, ], ['2005/00/19', 'y4m2d2', [], 0, ], # Invalid day ['2005/12/0', 'y4m2d2', [], 0, ], ['2005/12/00', 'y4m2d2', [], 0, ], ['2005/12/40', 'y4m2d2', [], 0, ], ['2005/12/32', 'y4m2d2', [], 0, ], # y2m2d2 tests ['2005/10/19', 'y2m2d2', [], 1, [qw(05/10/19 05 10 19)]], ['2005.10.19', 'y2m2d2', [], 1, [qw(05.10.19 05 10 19)]], ['2005-10-19', 'y2m2d2', [], 1, [qw(05-10-19 05 10 19)]], ['2005x10x19', 'y2m2d2', [], 0, ], ['20051019', 'y2m2d2', [], 1, [qw(200510 20 05 10)]], # leading/trailing junk shouldn't cause the match to change ['abc2005/10/19000', 'y2m2d2', [], 1, [qw(05/10/19 05 10 19)]], ['abc2005.10.19000', 'y2m2d2', [], 1, [qw(05.10.19 05 10 19)]], ['abc2005-10-19000', 'y2m2d2', [], 1, [qw(05-10-19 05 10 19)]], ['abc2005x10x19000', 'y2m2d2', [], 0, ], ['abc20051019000', 'y2m2d2', [], 1, [qw(200510 20 05 10)]], # Two-year date should match ['05/10/19', 'y2m2d2', [], 1, [qw(05/10/19 05 10 19)]], ['05.10.19', 'y2m2d2', [], 1, [qw(05.10.19 05 10 19)]], ['05-10-19', 'y2m2d2', [], 1, [qw(05-10-19 05 10 19)]], ['05x10x19', 'y2m2d2', [], 0, ], ['051019', 'y2m2d2', [], 1, [qw(051019 05 10 19)]], # separators ['05/10/19', 'y2m2d2', [], 1, [qw(05/10/19 05 10 19)]], ['05.10.19', 'y2m2d2', [], 1, [qw(05.10.19 05 10 19)]], ['05-10-19', 'y2m2d2', [], 1, [qw(05-10-19 05 10 19)]], ['05x10x19', 'y2m2d2', [], 0, ], ['051019', 'y2m2d2', [], 1, [qw(051019 05 10 19)]], # one-digit month ['2005/1/19', 'y2m2d2', [], 0, ], ['2005.1.19', 'y2m2d2', [], 0, ], ['2005-1-19', 'y2m2d2', [], 0, ], ['2005x1x19', 'y2m2d2', [], 0, ], ['2005119', 'y2m2d2', [], 1, [qw(200511 20 05 11)]], # one-digit day ['2005/10/9', 'y2m2d2', [], 0, ], ['2005.10.9', 'y2m2d2', [], 0, ], ['2005-10-9', 'y2m2d2', [], 0, ], ['2005x10x9', 'y2m2d2', [], 0, ], ['2005109', 'y2m2d2', [], 1, [qw(200510 20 05 10)]], # one-digit month and day ['2005/1/9', 'y2m2d2', [], 0, ], ['2005.1.9', 'y2m2d2', [], 0, ], ['2005-1-9', 'y2m2d2', [], 0, ], ['2005x1x9', 'y2m2d2', [], 0, ], ['200519', 'y2m2d2', [], 1, [qw(200519 20 05 19)]], # yy/m/dd ['05/1/19', 'y2m2d2', [], 0, ], ['05.1.19', 'y2m2d2', [], 0, ], ['05-1-19', 'y2m2d2', [], 0, ], ['05x1x19', 'y2m2d2', [], 0, ], ['05119', 'y2m2d2', [], 0, ], # yy/mm/d ['05/10/9', 'y2m2d2', [], 0, ], ['05.10.9', 'y2m2d2', [], 0, ], ['05-10-9', 'y2m2d2', [], 0, ], ['05x10x9', 'y2m2d2', [], 0, ], ['05109', 'y2m2d2', [], 0, ], # yy/m/d ['05/1/9', 'y2m2d2', [], 0, ], ['05.1.9', 'y2m2d2', [], 0, ], ['05-1-9', 'y2m2d2', [], 0, ], ['05x1x9', 'y2m2d2', [], 0, ], ['0519', 'y2m2d2', [], 0, ], # Invalid month ['05/13/19', 'y2m2d2', [], 0, ], ['05/21/19', 'y2m2d2', [], 0, ], ['05/0/19', 'y2m2d2', [], 0, ], ['05/00/19', 'y2m2d2', [], 0, ], # Invalid day ['05/12/0', 'y2m2d2', [], 0, ], ['05/12/00', 'y2m2d2', [], 0, ], ['05/12/40', 'y2m2d2', [], 0, ], ['05/12/32', 'y2m2d2', [], 0, ], # ymd tests with month names. # Basic test case ["2005 $Jan 01", "ymd", [], 1, ["2005 $Jan 01", '2005', $Jan, '01']], # 2-digit year [ "05 $Jan 01", "ymd", [], 1, [ "05 $Jan 01", '05', $Jan, '01']], # odd number of digits in year [ "0 $Jan 01", "ymd", [], 0, ], [ "120 $Jan 01", "ymd", [], 0, ], # Name spelled out ["2005 $January 01", "ymd", [], 1, ["2005 $January 01", '2005', $January, '01']], # Partial name should fail ["2005 ${Jan}u 01", "ymd", [], 0, ], # All twelve names (and abbreviations) Also valid day formats. ["2005 $February 1", "ymd", [], 1, ["2005 $February 1", '2005', $February, '1']], ["2005 $March 2", "ymd", [], 1, ["2005 $March 2", '2005', $March, '2']], ["2005 $April 09", "ymd", [], 1, ["2005 $April 09", '2005', $April, '09']], ["2005 $May 9", "ymd", [], 1, ["2005 $May 9", '2005', $May, '9']], ["2005 $June 10", "ymd", [], 1, ["2005 $June 10", '2005', $June, '10']], ["2005 $July 11", "ymd", [], 1, ["2005 $July 11", '2005', $July, '11']], ["2005 $August 19", "ymd", [], 1, ["2005 $August 19", '2005', $August, '19']], ["2005 $September 20", "ymd", [], 1, ["2005 $September 20", '2005', $September, '20']], ["2005 $October 21", "ymd", [], 1, ["2005 $October 21", '2005', $October, '21']], ["2005 $November 30", "ymd", [], 1, ["2005 $November 30", '2005', $November, '30']], ["2005 $December 31", "ymd", [], 1, ["2005 $December 31", '2005', $December, '31']], ["2005 $Feb 1", "ymd", [], 1, ["2005 $Feb 1", '2005', $Feb, '1']], ["2005 $Mar 2", "ymd", [], 1, ["2005 $Mar 2", '2005', $Mar, '2']], ["2005 $Apr 09", "ymd", [], 1, ["2005 $Apr 09", '2005', $Apr, '09']], ["2005 $May 9", "ymd", [], 1, ["2005 $May 9", '2005', $May, '9']], ["2005 $Jun 10", "ymd", [], 1, ["2005 $Jun 10", '2005', $Jun, '10']], ["2005 $Jul 11", "ymd", [], 1, ["2005 $Jul 11", '2005', $Jul, '11']], ["2005 $Aug 19", "ymd", [], 1, ["2005 $Aug 19", '2005', $Aug, '19']], ["2005 $Sep 20", "ymd", [], 1, ["2005 $Sep 20", '2005', $Sep, '20']], ["2005 $Oct 21", "ymd", [], 1, ["2005 $Oct 21", '2005', $Oct, '21']], ["2005 $Nov 30", "ymd", [], 1, ["2005 $Nov 30", '2005', $Nov, '30']], ["2005 $Dec 31", "ymd", [], 1, ["2005 $Dec 31", '2005', $Dec, '31']], # Case insensitivity ["2005 \L$Jan 01", "ymd", [], 1, ["2005 \L$Jan 01", '2005', lc($Jan), '01']], ["2005 \U\l$Jan 01", "ymd", [], 1, ["2005 \U\l$Jan 01", '2005', lcfirst(uc $Jan), '01']], # Alternate separators ["2005-$Jan-01", "ymd", [], 1, ["2005-$Jan-01", '2005', $Jan, '01']], ["2005.$Jan.01", "ymd", [], 1, ["2005.$Jan.01", '2005', $Jan, '01']], # Schmutz before/after the date ["blah2005 $Jan 01", "ymd", [], 1, ["2005 $Jan 01", '2005', $Jan, '01']], ["2005 $Jan 01blah", "ymd", [], 1, ["2005 $Jan 01", '2005', $Jan, '01']], ["2005 $Jan 011", "ymd", [], 0, ], ["205 $Jan 01", "ymd", [], 0, ], ["02005 $Jan 01", "ymd", [], 0, ], # Bad separator ["2005x${Jan}x01", "ymd", [], 0, ], # Bad day ["2005-$Jan-00", "ymd", [], 0, ], ["2005-$Jan-0", "ymd", [], 0, ], ["2005-$Jan-32", "ymd", [], 0, ], ["2005-$Jan-40", "ymd", [], 0, ], ["2005-$Jan-99", "ymd", [], 0, ], # y4md tests with month names. # Basic test case ["2005 $Jan 01", "y4md", [], 1, ["2005 $Jan 01", '2005', $Jan, '01']], # 2-digit year [ "05 $Jan 01", "y4md", [], 0, ], # odd number of digits in year [ "0 $Jan 01", "y4md", [], 0, ], [ "120 $Jan 01", "y4md", [], 0, ], # Name spelled out ["2005 $January 01", "y4md", [], 1, ["2005 $January 01", '2005', $January, '01']], # Partial name should fail ["2005 ${Jan}u 01", "y4md", [], 0, ], # All twelve names (and abbreviations) Also valid day formats. ["2005 $February 1", "y4md", [], 1, ["2005 $February 1", '2005', $February, '1']], ["2005 $March 2", "y4md", [], 1, ["2005 $March 2", '2005', $March, '2']], ["2005 $April 09", "y4md", [], 1, ["2005 $April 09", '2005', $April, '09']], ["2005 $May 9", "y4md", [], 1, ["2005 $May 9", '2005', $May, '9']], ["2005 $June 10", "y4md", [], 1, ["2005 $June 10", '2005', $June, '10']], ["2005 $July 11", "y4md", [], 1, ["2005 $July 11", '2005', $July, '11']], ["2005 $August 19", "y4md", [], 1, ["2005 $August 19", '2005', $August, '19']], ["2005 $September 20", "y4md", [], 1, ["2005 $September 20", '2005', $September, '20']], ["2005 $October 21", "y4md", [], 1, ["2005 $October 21", '2005', $October, '21']], ["2005 $November 30", "y4md", [], 1, ["2005 $November 30", '2005', $November, '30']], ["2005 $December 31", "y4md", [], 1, ["2005 $December 31", '2005', $December, '31']], ["2005 $Feb 1", "y4md", [], 1, ["2005 $Feb 1", '2005', $Feb, '1']], ["2005 $Mar 2", "y4md", [], 1, ["2005 $Mar 2", '2005', $Mar, '2']], ["2005 $Apr 09", "y4md", [], 1, ["2005 $Apr 09", '2005', $Apr, '09']], ["2005 $May 9", "y4md", [], 1, ["2005 $May 9", '2005', $May, '9']], ["2005 $Jun 10", "y4md", [], 1, ["2005 $Jun 10", '2005', $Jun, '10']], ["2005 $Jul 11", "y4md", [], 1, ["2005 $Jul 11", '2005', $Jul, '11']], ["2005 $Aug 19", "y4md", [], 1, ["2005 $Aug 19", '2005', $Aug, '19']], ["2005 $Sep 20", "y4md", [], 1, ["2005 $Sep 20", '2005', $Sep, '20']], ["2005 $Oct 21", "y4md", [], 1, ["2005 $Oct 21", '2005', $Oct, '21']], ["2005 $Nov 30", "y4md", [], 1, ["2005 $Nov 30", '2005', $Nov, '30']], ["2005 $Dec 31", "y4md", [], 1, ["2005 $Dec 31", '2005', $Dec, '31']], # Case insensitivity ["2005 \L$Jan 01", "y4md", [], 1, ["2005 \L$Jan 01", '2005', lc($Jan), '01']], ["2005 \U\l$Jan 01", "y4md", [], 1, ["2005 \U\l$Jan 01", '2005', lcfirst(uc $Jan), '01']], # Alternate separators ["2005-$Jan-01", "y4md", [], 1, ["2005-$Jan-01", '2005', $Jan, '01']], ["2005.$Jan.01", "y4md", [], 1, ["2005.$Jan.01", '2005', $Jan, '01']], # Schmutz before/after the date ["blah2005 $Jan 01", "y4md", [], 1, ["2005 $Jan 01", '2005', $Jan, '01']], ["2005 $Jan 01blah", "y4md", [], 1, ["2005 $Jan 01", '2005', $Jan, '01']], ["2005 $Jan 011", "y4md", [], 0, ], ["12005 $Jan 01", "y4md", [], 1, ["2005 $Jan 01", '2005', $Jan, '01']], # Bad separator ["2005x${Jan}x01", "y4md", [], 0, ], # Bad day ["2005-$Jan-00", "y4md", [], 0, ], ["2005-$Jan-0", "y4md", [], 0, ], ["2005-$Jan-32", "y4md", [], 0, ], ["2005-$Jan-40", "y4md", [], 0, ], ["2005-$Jan-99", "y4md", [], 0, ], # y2md tests with month names. # Basic test case [ "05 $Jan 01", "y2md", [], 1, ["05 $Jan 01", '05', $Jan, '01']], # 4-digit year ["2005 $Jan 01", "y2md", [], 1, ["05 $Jan 01", '05', $Jan, '01']], # odd number of digits in year [ "0 $Jan 01", "y2md", [], 0, ], [ "120 $Jan 01", "y2md", [], 1, ["20 $Jan 01", '20', $Jan, '01']], # Name spelled out ["05 $January 01", "y2md", [], 1, ["05 $January 01", '05', $January, '01']], # Partial name should fail ["05 ${Jan}u 01", "y2md", [], 0, ], # All twelve names (and abbreviations) Also valid day formats. ["05 $February 1", "y2md", [], 1, ["05 $February 1", '05', $February, '1']], ["05 $March 2", "y2md", [], 1, ["05 $March 2", '05', $March, '2']], ["05 $April 09", "y2md", [], 1, ["05 $April 09", '05', $April, '09']], ["05 $May 9", "y2md", [], 1, ["05 $May 9", '05', $May, '9']], ["05 $June 10", "y2md", [], 1, ["05 $June 10", '05', $June, '10']], ["05 $July 11", "y2md", [], 1, ["05 $July 11", '05', $July, '11']], ["05 $August 19", "y2md", [], 1, ["05 $August 19", '05', $August, '19']], ["05 $September 20", "y2md", [], 1, ["05 $September 20", '05', $September, '20']], ["05 $October 21", "y2md", [], 1, ["05 $October 21", '05', $October, '21']], ["05 $November 30", "y2md", [], 1, ["05 $November 30", '05', $November, '30']], ["05 $December 31", "y2md", [], 1, ["05 $December 31", '05', $December, '31']], ["05 $Feb 1", "y2md", [], 1, ["05 $Feb 1", '05', $Feb, '1']], ["05 $Mar 2", "y2md", [], 1, ["05 $Mar 2", '05', $Mar, '2']], ["05 $Apr 09", "y2md", [], 1, ["05 $Apr 09", '05', $Apr, '09']], ["05 $May 9", "y2md", [], 1, ["05 $May 9", '05', $May, '9']], ["05 $Jun 10", "y2md", [], 1, ["05 $Jun 10", '05', $Jun, '10']], ["05 $Jul 11", "y2md", [], 1, ["05 $Jul 11", '05', $Jul, '11']], ["05 $Aug 19", "y2md", [], 1, ["05 $Aug 19", '05', $Aug, '19']], ["05 $Sep 20", "y2md", [], 1, ["05 $Sep 20", '05', $Sep, '20']], ["05 $Oct 21", "y2md", [], 1, ["05 $Oct 21", '05', $Oct, '21']], ["05 $Nov 30", "y2md", [], 1, ["05 $Nov 30", '05', $Nov, '30']], ["05 $Dec 31", "y2md", [], 1, ["05 $Dec 31", '05', $Dec, '31']], # Case insensitivity ["05 \L$Jan 01", "y2md", [], 1, ["05 \L$Jan 01", '05', lc($Jan), '01']], ["05 \U\l$Jan 01", "y2md", [], 1, ["05 \U\l$Jan 01", '05', lcfirst(uc $Jan), '01']], # Alternate separators ["05-$Jan-01", "y2md", [], 1, ["05-$Jan-01", '05', $Jan, '01']], ["05.$Jan.01", "y2md", [], 1, ["05.$Jan.01", '05', $Jan, '01']], # Schmutz before/after the date ["blah05 $Jan 01", "y2md", [], 1, ["05 $Jan 01", '05', $Jan, '01']], ["05 $Jan 01blah", "y2md", [], 1, ["05 $Jan 01", '05', $Jan, '01']], ["05 $Jan 011", "y2md", [], 0, ], ["05 $Jan 01x", "y2md", [], 1, ["05 $Jan 01", '05', $Jan, '01']], ["105 $Jan 01", "y2md", [], 1, ["05 $Jan 01", '05', $Jan, '01']], # Bad separator ["05x${Jan}x01", "y2md", [], 0, ], # Bad day ["05-$Jan-00", "y2md", [], 0, ], ["05-$Jan-0", "y2md", [], 0, ], ["05-$Jan-32", "y2md", [], 0, ], ["05-$Jan-40", "y2md", [], 0, ], ["05-$Jan-99", "y2md", [], 0, ], # Add"l tests # In loose "ymd" format, trailing digits should cause the dd not to match. ["10-SEP-2005", "ymd", [], 0, ], ); # YMD is an exact synonym for y4m2d2 my @YMD = grep { $_->[1] eq 'y4m2d2' } @match; $_->[1] = 'YMD' for @YMD; push @match, @YMD; # How many matches will succeed? my $to_succeed = scalar grep $_->[3], @match; # Run two tests per match, plus two additional per expected success $num_tests = 2 * scalar(@match) + 2 * $to_succeed; # Plus one for the 'use_ok' call $num_tests += 1; } use Test::More tests => $num_tests; use_ok('Regexp::Common', 'time'); foreach my $match (@match) { my ($text, $name, $flags, $should_succeed, $matchvars) = @$match; my $testname = qq{"$text" =~ "$name"}; my $did_succeed; my @captures; # Regexp captures # FIRST: check whether it succeeded or failed as expected. # 'keep' option is OFF; should be no captures. if (@$flags) { my $flags = join $; => @$flags; @captures = $text =~ /$RE{time}{$name}{$flags}/; } else { @captures = $text =~ /$RE{time}{$name}/; } $did_succeed = @captures > 0; my $ought = $should_succeed? 'match' : 'fail'; my $actual = $did_succeed == $should_succeed? "${ought}ed" : "did not $ought"; # TEST 1: simple matching ok ( ($should_succeed && $did_succeed) || (!$should_succeed && !$did_succeed), "$testname - $actual as expected (nokeep)."); # TEST 2: Shouldn't capture anything if ($should_succeed) { SKIP: { skip "$testname - can't check captures since match unsuccessful", 1 if !$did_succeed; is_deeply(\@captures, [1], "$testname - didn't unduly capture"); } } # SECOND: use 'keep' option to check captures. if (@$flags) { my $flags = join $; => @$flags; @captures = $text =~ /$RE{time}{$name}{$flags}{-keep}/; } else { @captures = $text =~ /$RE{time}{$name}{-keep}/; } $did_succeed = @captures > 0; # TEST 3: matching with 'keep' ok ( ($should_succeed && $did_succeed) || (!$should_succeed && !$did_succeed), "$testname - $actual as expected (keep)."); # TEST 4: capture variables should be set. if ($should_succeed) { SKIP: { skip "$testname - can't check captures since match unsuccessful", 1 if !$did_succeed; is_deeply(\@captures, $matchvars, "$testname - correct capture variables"); } } } Regexp-Common-time-0.05/t/mail.t000444001750001750 1245512243100275 16153 0ustar00gaborgabor000000000000use vars qw(@match $num_tests); BEGIN { @match = ( # RFC-2822 (mail format) tests # Base case ['28 Mar 2008 01:02:03 +0600', 'mail', [], 1, [qq(28 Mar 2008 01:02:03 +0600), qw(28 Mar 2008 01 02 03 +0600)]], # 11 other months, plus some fun timezone variants. ['28 Jan 2008 01:02:03 +0600', 'mail', [], 1, [qq(28 Jan 2008 01:02:03 +0600), qw(28 Jan 2008 01 02 03 +0600)]], ['28 Feb 2008 01:02:03 -0600', 'mail', [], 1, [qq(28 Feb 2008 01:02:03 -0600), qw(28 Feb 2008 01 02 03 -0600)]], ['28 Apr 2008 01:02:03 +2300', 'mail', [], 1, [qq(28 Apr 2008 01:02:03 +2300), qw(28 Apr 2008 01 02 03 +2300)]], ['28 May 2008 01:02:03 -2300', 'mail', [], 1, [qq(28 May 2008 01:02:03 -2300), qw(28 May 2008 01 02 03 -2300)]], ['28 Jun 2008 01:02:03 +2359', 'mail', [], 1, [qq(28 Jun 2008 01:02:03 +2359), qw(28 Jun 2008 01 02 03 +2359)]], ['28 Jul 2008 01:02:03 -2359', 'mail', [], 1, [qq(28 Jul 2008 01:02:03 -2359), qw(28 Jul 2008 01 02 03 -2359)]], ['28 Aug 2008 01:02:03 EDT', 'mail', [], 1, [qq(28 Aug 2008 01:02:03 EDT), qw(28 Aug 2008 01 02 03 EDT)]], ['28 Sep 2008 01:02:03 EST', 'mail', [], 1, [qq(28 Sep 2008 01:02:03 EST), qw(28 Sep 2008 01 02 03 EST)]], ['28 Oct 2008 01:02:03 PDT', 'mail', [], 1, [qq(28 Oct 2008 01:02:03 PDT), qw(28 Oct 2008 01 02 03 PDT)]], ['28 Nov 2008 01:02:03 PST', 'mail', [], 1, [qq(28 Nov 2008 01:02:03 PST), qw(28 Nov 2008 01 02 03 PST)]], ['28 Dec 2008 01:02:03 Z', 'mail', [], 1, [qq(28 Dec 2008 01:02:03 Z), qw(28 Dec 2008 01 02 03 Z)]], # Add weekday, as would be found in the typical case ['Wed, 28 Mar 2008 01:02:03 +0600', 'mail', [], 1, [qq(28 Mar 2008 01:02:03 +0600), qw(28 Mar 2008 01 02 03 +0600)]], # Two-digit years are allowed, though the standard frowns upon them. ['28 Dec 08 01:02:03 +0500', 'mail', [], 1, [qq(28 Dec 08 01:02:03 +0500), qw(28 Dec 08 01 02 03 +0500)]], # Full month names should not match. Except for "May"! ['28 January 2008 01:02:03 +0600', 'mail', [], 0, ], ['28 February 2008 01:02:03 +0600', 'mail', [], 0, ], ['28 March 2008 01:02:03 +0600', 'mail', [], 0, ], ['28 April 2008 01:02:03 +0600', 'mail', [], 0, ], ['28 June 2008 01:02:03 +0600', 'mail', [], 0, ], ['28 July 2008 01:02:03 +0600', 'mail', [], 0, ], ['28 August 2008 01:02:03 +0600', 'mail', [], 0, ], ['28 September 2008 01:02:03 +0600', 'mail', [], 0, ], ['28 October 2008 01:02:03 +0600', 'mail', [], 0, ], ['28 November 2008 01:02:03 +0600', 'mail', [], 0, ], ['28 December 2008 01:02:03 +0600', 'mail', [], 0, ], # Leading/trailing garbage variations ['128 Mar 2008 01:02:03 +0600', 'mail', [], 0, ], ['28 Mar 2008 01:02:03 +06000', 'mail', [], 0, ], ); # How many matches will succeed? my $to_succeed = scalar grep $_->[3], @match; # Run two tests per match, plus two additional per expected success $num_tests = 2 * scalar(@match) + 2 * $to_succeed; # Plus one for the 'use_ok' call $num_tests += 1; } use Test::More tests => $num_tests; use_ok('Regexp::Common', 'time'); foreach my $match (@match) { my ($text, $name, $flags, $should_succeed, $matchvars) = @$match; my $testname = qq{"$text" =~ "$name"}; my $did_succeed; my @captures; # Regexp captures # FIRST: check whether it succeeded or failed as expected. # 'keep' option is OFF; should be no captures. if (@$flags) { my $flags = join $; => @$flags; @captures = $text =~ /$RE{time}{$name}{$flags}/; } else { @captures = $text =~ /$RE{time}{$name}/; } $did_succeed = @captures > 0; my $ought = $should_succeed? 'match' : 'fail'; my $actual = $did_succeed == $should_succeed? "${ought}ed" : "did not $ought"; # TEST 1: simple matching ok ( ($should_succeed && $did_succeed) || (!$should_succeed && !$did_succeed), "$testname - $actual as expected (nokeep)."); # TEST 2: Shouldn't capture anything if ($should_succeed) { SKIP: { skip "$testname - can't check captures since match unsuccessful", 1 if !$did_succeed; is_deeply(\@captures, [1], "$testname - didn't unduly capture"); } } # SECOND: use 'keep' option to check captures. if (@$flags) { my $flags = join $; => @$flags; @captures = $text =~ /$RE{time}{$name}{$flags}{-keep}/; } else { @captures = $text =~ /$RE{time}{$name}{-keep}/; } $did_succeed = @captures > 0; # TEST 3: matching with 'keep' ok ( ($should_succeed && $did_succeed) || (!$should_succeed && !$did_succeed), "$testname - $actual as expected (keep)."); # TEST 4: capture variables should be set. if ($should_succeed) { SKIP: { skip "$testname - can't check captures since match unsuccessful", 1 if !$did_succeed; is_deeply(\@captures, $matchvars, "$testname - correct capture variables"); } } } Regexp-Common-time-0.05/t/zone.t000444001750001750 242612243100275 16161 0ustar00gaborgabor000000000000use Test::More tests => 109; sub begins_with { my ($got, $exp) = @_; my $ok = substr($got,0,length $exp) eq $exp; if (!$ok) { diag "expected '$exp...'\n", " got '$got'\n"; } return $ok; } use_ok('Regexp::Common', 'time'); # Time zone tests # These should all succeed: for my $in (qw(Z UT UTC GMT EST EDT CST CDT MST MDT PST PDT +0000 -0000 +00:00 -00:00 +00 -00 +0100 -0200 +03:00 -04:00 +05 -06 +1100 -1200 +13:00 -22:00 +23 -24 +0130 -0230 +03:45 -04:17 +05:59 +0659 )) { my @out = $in =~ /\A$RE{time}{tf}{-pat => 'tz'}{-keep}\z/; is_deeply (\@out, [$in, $in], qq{TF '$in' should succeed}); @out = $in =~ /\A$RE{time}{strftime}{-pat => '%Z'}{-keep}\z/; is_deeply (\@out, [$in], qq{stftime '$in' should succeed}); } # These should all fail: for my $in (qw(X EJR QQT ABC RST +2500 -2500 +25:00 -25:00 +25 -25 0100 02:00 03 +1160 -1270 +13:80 -22:80 )) { my @out = $in =~ /\A$RE{time}{tf}{-pat => 'tz'}{-keep}\z/; is_deeply (\@out, [], qq{TF '$in should fail'}); @out = $in =~ /\A$RE{time}{strftime}{-pat => '%Z'}{-keep}\z/; is_deeply (\@out, [], qq{strftime '$in' should fail}); } Regexp-Common-time-0.05/t/mail-strict.t000444001750001750 1311612243100275 17454 0ustar00gaborgabor000000000000use vars qw(@match $num_tests); BEGIN { @match = ( # RFC-2822 (mail format) tests # Base case ['28 Mar 2008 01:02:03 +0600', 'MAIL', [], 1, [qq(28 Mar 2008 01:02:03 +0600), qw(28 Mar 2008 01 02 03 +0600)]], # 11 other months, plus some fun timezone variants. ['28 Jan 2008 01:02:03 +0600', 'MAIL', [], 1, [qq(28 Jan 2008 01:02:03 +0600), qw(28 Jan 2008 01 02 03 +0600)]], ['28 Feb 2008 01:02:03 -0600', 'MAIL', [], 1, [qq(28 Feb 2008 01:02:03 -0600), qw(28 Feb 2008 01 02 03 -0600)]], ['28 Apr 2008 01:02:03 +2300', 'MAIL', [], 1, [qq(28 Apr 2008 01:02:03 +2300), qw(28 Apr 2008 01 02 03 +2300)]], ['28 May 2008 01:02:03 -2300', 'MAIL', [], 1, [qq(28 May 2008 01:02:03 -2300), qw(28 May 2008 01 02 03 -2300)]], ['28 Jun 2008 01:02:03 +2359', 'MAIL', [], 1, [qq(28 Jun 2008 01:02:03 +2359), qw(28 Jun 2008 01 02 03 +2359)]], ['28 Jul 2008 01:02:03 -2359', 'MAIL', [], 1, [qq(28 Jul 2008 01:02:03 -2359), qw(28 Jul 2008 01 02 03 -2359)]], ['28 Aug 2008 01:02:03 +0300', 'MAIL', [], 1, [qq(28 Aug 2008 01:02:03 +0300), qw(28 Aug 2008 01 02 03 +0300)]], ['28 Sep 2008 01:02:03 +0300', 'MAIL', [], 1, [qq(28 Sep 2008 01:02:03 +0300), qw(28 Sep 2008 01 02 03 +0300)]], ['28 Oct 2008 01:02:03 +0300', 'MAIL', [], 1, [qq(28 Oct 2008 01:02:03 +0300), qw(28 Oct 2008 01 02 03 +0300)]], ['28 Nov 2008 01:02:03 +0300', 'MAIL', [], 1, [qq(28 Nov 2008 01:02:03 +0300), qw(28 Nov 2008 01 02 03 +0300)]], ['28 Dec 2008 01:02:03 +0300', 'MAIL', [], 1, [qq(28 Dec 2008 01:02:03 +0300), qw(28 Dec 2008 01 02 03 +0300)]], # Alphanumeric time zones are not permitted ['28 Aug 2008 01:02:03 EDT', 'MAIL', [], 0, ], ['28 Sep 2008 01:02:03 EST', 'MAIL', [], 0, ], ['28 Oct 2008 01:02:03 PDT', 'MAIL', [], 0, ], ['28 Nov 2008 01:02:03 PST', 'MAIL', [], 0, ], ['28 Dec 2008 01:02:03 Z', 'MAIL', [], 0, ], # Two-digit years are not permitted ['28 Dec 08 01:02:03 +0500', 'MAIL', [], 0, ], # Add weekday, as would be found in the typical case ['Wed, 28 Mar 2008 01:02:03 +0600', 'MAIL', [], 1, [qq(28 Mar 2008 01:02:03 +0600), qw(28 Mar 2008 01 02 03 +0600)]], # Full month names should not match. Except for "May"! ['28 January 2008 01:02:03 +0600', 'MAIL', [], 0, ], ['28 February 2008 01:02:03 +0600', 'MAIL', [], 0, ], ['28 March 2008 01:02:03 +0600', 'MAIL', [], 0, ], ['28 April 2008 01:02:03 +0600', 'MAIL', [], 0, ], ['28 June 2008 01:02:03 +0600', 'MAIL', [], 0, ], ['28 July 2008 01:02:03 +0600', 'MAIL', [], 0, ], ['28 August 2008 01:02:03 +0600', 'MAIL', [], 0, ], ['28 September 2008 01:02:03 +0600', 'MAIL', [], 0, ], ['28 October 2008 01:02:03 +0600', 'MAIL', [], 0, ], ['28 November 2008 01:02:03 +0600', 'MAIL', [], 0, ], ['28 December 2008 01:02:03 +0600', 'MAIL', [], 0, ], # Leading/trailing garbage variations ['128 Mar 2008 01:02:03 +0600', 'MAIL', [], 0, ], ['28 Mar 2008 01:02:03 +06000', 'MAIL', [], 0, ], ); # How many matches will succeed? my $to_succeed = scalar grep $_->[3], @match; # Run two tests per match, plus two additional per expected success $num_tests = 2 * scalar(@match) + 2 * $to_succeed; # Plus one for the 'use_ok' call $num_tests += 1; } use Test::More tests => $num_tests; use_ok('Regexp::Common', 'time'); foreach my $match (@match) { my ($text, $name, $flags, $should_succeed, $matchvars) = @$match; my $testname = qq{"$text" =~ "$name"}; my $did_succeed; my @captures; # Regexp captures # FIRST: check whether it succeeded or failed as expected. # 'keep' option is OFF; should be no captures. if (@$flags) { my $flags = join $; => @$flags; @captures = $text =~ /$RE{time}{$name}{$flags}/; } else { @captures = $text =~ /$RE{time}{$name}/; } $did_succeed = @captures > 0; my $ought = $should_succeed? 'match' : 'fail'; my $actual = $did_succeed == $should_succeed? "${ought}ed" : "did not $ought"; # TEST 1: simple matching ok ( ($should_succeed && $did_succeed) || (!$should_succeed && !$did_succeed), "$testname - $actual as expected (nokeep)."); # TEST 2: Shouldn't capture anything if ($should_succeed) { SKIP: { skip "$testname - can't check captures since match unsuccessful", 1 if !$did_succeed; is_deeply(\@captures, [1], "$testname - didn't unduly capture"); } } # SECOND: use 'keep' option to check captures. if (@$flags) { my $flags = join $; => @$flags; @captures = $text =~ /$RE{time}{$name}{$flags}{-keep}/; } else { @captures = $text =~ /$RE{time}{$name}{-keep}/; } $did_succeed = @captures > 0; # TEST 3: matching with 'keep' ok ( ($should_succeed && $did_succeed) || (!$should_succeed && !$did_succeed), "$testname - $actual as expected (keep)."); # TEST 4: capture variables should be set. if ($should_succeed) { SKIP: { skip "$testname - can't check captures since match unsuccessful", 1 if !$did_succeed; is_deeply(\@captures, $matchvars, "$testname - correct capture variables"); } } } Regexp-Common-time-0.05/t/tf.t000444001750001750 6004012243100275 15633 0ustar00gaborgabor000000000000use strict; use vars qw(@match $num_tests %RE); use vars qw(@MONTH @MON @WEEKDAY @DAY); BEGIN { # Man, this locale stuff is a pain. Why can't everyone just speak English?! # First set defaults: @MONTH = qw(January February March April May June July August September October November December); @MON = qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec); @WEEKDAY = qw(Sunday Monday Tuesday Wednesday Thursday Friday Saturday); @DAY = qw(Sun Mon Tue Wed Thu Fri Sat); eval { require POSIX; require I18N::Langinfo; eval { @MONTH = map I18N::Langinfo::langinfo($_), I18N::Langinfo::MON_1(), I18N::Langinfo::MON_2(), I18N::Langinfo::MON_3(), I18N::Langinfo::MON_4(), I18N::Langinfo::MON_5(), I18N::Langinfo::MON_6(), I18N::Langinfo::MON_7(), I18N::Langinfo::MON_8(), I18N::Langinfo::MON_9(), I18N::Langinfo::MON_10(), I18N::Langinfo::MON_11(), I18N::Langinfo::MON_12(); }; eval { @MON = map I18N::Langinfo::langinfo($_), I18N::Langinfo::ABMON_1(), I18N::Langinfo::ABMON_2(), I18N::Langinfo::ABMON_3(), I18N::Langinfo::ABMON_4(), I18N::Langinfo::ABMON_5(), I18N::Langinfo::ABMON_6(), I18N::Langinfo::ABMON_7(), I18N::Langinfo::ABMON_8(), I18N::Langinfo::ABMON_9(), I18N::Langinfo::ABMON_10(), I18N::Langinfo::ABMON_11(), I18N::Langinfo::ABMON_12(); }; eval { @WEEKDAY = map I18N::Langinfo::langinfo($_), I18N::Langinfo::DAY_1(), I18N::Langinfo::DAY_2(), I18N::Langinfo::DAY_3(), I18N::Langinfo::DAY_4(), I18N::Langinfo::DAY_5(), I18N::Langinfo::DAY_6(), I18N::Langinfo::DAY_7(); }; eval { @DAY = map I18N::Langinfo::langinfo($_), I18N::Langinfo::ABDAY_1(), I18N::Langinfo::ABDAY_2(), I18N::Langinfo::ABDAY_3(), I18N::Langinfo::ABDAY_4(), I18N::Langinfo::ABDAY_5(), I18N::Langinfo::ABDAY_6(), I18N::Langinfo::ABDAY_7(); }; }; # target, pattern, values, name @match = ( # 'day' : abbreviated weekday name [$DAY[0], '\Aday\z', [$DAY[0], $DAY[0]], 'Sun'], [$DAY[1], '\Aday\z', [$DAY[1], $DAY[1]], 'Mon'], [$DAY[2], '\Aday\z', [$DAY[2], $DAY[2]], 'Tue'], [$DAY[3], '\Aday\z', [$DAY[3], $DAY[3]], 'Wed'], [$DAY[4], '\Aday\z', [$DAY[4], $DAY[4]], 'Thu'], [$DAY[5], '\Aday\z', [$DAY[5], $DAY[5]], 'Fri'], [$DAY[6], '\Aday\z', [$DAY[6], $DAY[6]], 'Sat'], ['*&^@#(','\Aday\z', undef, '"a" garbage'], ["blaz$DAY[1]blaz", 'blazdayblaz', ["blaz$DAY[1]blaz", $DAY[1]], 'Mon blazz'], # 'Weekday' : full weekday name [$WEEKDAY[0], '\AWeekday\z', [$WEEKDAY[0], $WEEKDAY[0]], 'Sunday'], [$WEEKDAY[1], '\AWeekday\z', [$WEEKDAY[1], $WEEKDAY[1]], 'Monday'], [$WEEKDAY[2], '\AWeekday\z', [$WEEKDAY[2], $WEEKDAY[2]], 'Tuesday'], [$WEEKDAY[3], '\AWeekday\z', [$WEEKDAY[3], $WEEKDAY[3]], 'Wednesday'], [$WEEKDAY[4], '\AWeekday\z', [$WEEKDAY[4], $WEEKDAY[4]], 'Thursday'], [$WEEKDAY[5], '\AWeekday\z', [$WEEKDAY[5], $WEEKDAY[5]], 'Friday'], [$WEEKDAY[6], '\AWeekday\z', [$WEEKDAY[6], $WEEKDAY[6]], 'Saturday'], ["blaz$WEEKDAY[1]blaz", 'blazweekdayblaz', ["blaz$WEEKDAY[1]blaz", $WEEKDAY[1]], 'Monday blazz'], ['*&^@#(', '\AWeekday\z', undef, '"Weekday" garbage'], # 'Mon' : abbreviated month name [$MON[ 0], '\AMon\z', [$MON[ 0], $MON[ 0]], 'Jan'], [$MON[ 1], '\AMon\z', [$MON[ 1], $MON[ 1]], 'Feb'], [$MON[ 2], '\AMon\z', [$MON[ 2], $MON[ 2]], 'Mar'], [$MON[ 3], '\AMon\z', [$MON[ 3], $MON[ 3]], 'Apr'], [$MON[ 4], '\AMon\z', [$MON[ 4], $MON[ 4]], 'May'], [$MON[ 5], '\AMon\z', [$MON[ 5], $MON[ 5]], 'Jun'], [$MON[ 6], '\AMon\z', [$MON[ 6], $MON[ 6]], 'Jul'], [$MON[ 7], '\AMon\z', [$MON[ 7], $MON[ 7]], 'Aug'], [$MON[ 8], '\AMon\z', [$MON[ 8], $MON[ 8]], 'Sep'], [$MON[ 9], '\AMon\z', [$MON[ 9], $MON[ 9]], 'Oct'], [$MON[10], '\AMon\z', [$MON[10], $MON[10]], 'Nov'], [$MON[11], '\AMon\z', [$MON[11], $MON[11]], 'Dec'], # 'MONTH' : full month name [$MONTH[ 0], '\AMONTH\z', [$MONTH[ 0], $MONTH[ 0]], 'January'], [$MONTH[ 1], '\AMONTH\z', [$MONTH[ 1], $MONTH[ 1]], 'February'], [$MONTH[ 2], '\AMONTH\z', [$MONTH[ 2], $MONTH[ 2]], 'March'], [$MONTH[ 3], '\AMONTH\z', [$MONTH[ 3], $MONTH[ 3]], 'April'], [$MONTH[ 4], '\AMONTH\z', [$MONTH[ 4], $MONTH[ 4]], 'May'], [$MONTH[ 5], '\AMONTH\z', [$MONTH[ 5], $MONTH[ 5]], 'June'], [$MONTH[ 6], '\AMONTH\z', [$MONTH[ 6], $MONTH[ 6]], 'July'], [$MONTH[ 7], '\AMONTH\z', [$MONTH[ 7], $MONTH[ 7]], 'August'], [$MONTH[ 8], '\AMONTH\z', [$MONTH[ 8], $MONTH[ 8]], 'September'], [$MONTH[ 9], '\AMONTH\z', [$MONTH[ 9], $MONTH[ 9]], 'Octtober'], [$MONTH[10], '\AMONTH\z', [$MONTH[10], $MONTH[10]], 'November'], [$MONTH[11], '\AMONTH\z', [$MONTH[11], $MONTH[11]], 'December'], # 'dd' : Day number ['01', '\Add\z', ['01', '01'], 'dd Day 01'], ['09', '\Add\z', ['09', '09'], 'dd Day 09'], ['10', '\Add\z', ['10', '10'], 'dd Day 10'], ['21', '\Add\z', ['21', '21'], 'dd Day 21'], ['30', '\Add\z', ['30', '30'], 'dd Day 30'], ['31', '\Add\z', ['31', '31'], 'dd Day 31'], ['00', '\Add\z', undef, 'dd Day 00'], ['32', '\Add\z', undef, 'dd Day 32'], ['99', '\Add\z', undef, 'dd Day 99'], [' 8', '\Add\z', undef, 'dd Day 8'], ['8', '\Add\z', undef, 'dd Day 8'], # 'd' : Day number ['0', '\Ad\z', undef, 'd Day 0'], ['01', '\Ad\z', ['01', '01'], 'd Day 01'], ['1' , '\Ad\z', ['1' , '1' ], 'd Day 1' ], ['10', '\Ad\z', ['10', '10'], 'd Day 10'], ['21', '\Ad\z', ['21', '21'], 'd Day 21'], ['30', '\Ad\z', ['30', '30'], 'd Day 30'], ['31', '\Ad\z', ['31', '31'], 'd Day 31'], ['00', '\Ad\z', undef, 'd Day 00'], ['32', '\Ad\z', undef, 'd Day 32'], ['99', '\Ad\z', undef, 'd Day 99'], [' 8', '\Ad\z', undef, 'd Day 8'], # '?d' : Day number ['00', '\A?d\z', undef, '?d Day 00'], [' 0', '\A?d\z', undef, '?d Day 09'], ['01', '\A?d\z', undef, '?d Day 01'], ['10', '\A?d\z', ['10', '10'], '?d Day 10'], ['21', '\A?d\z', ['21', '21'], '?d Day 21'], ['30', '\A?d\z', ['30', '30'], '?d Day 30'], ['31', '\A?d\z', ['31', '31'], '?d Day 31'], ['32', '\A?d\z', undef, '?d Day 32'], ['99', '\A?d\z', undef, '?d Day 99'], [' 8', '\A?d\z', [' 8', ' 8'], '?d Day 8'], ['8', '\A?d\z', undef, '?d Day 8'], # Combo: m/d/y ['01/02/03', 'mm/dd/yy', ['01/02/03', '01', '02', '03'], 'mm/dd/yy 01/02/03'], ['00/02/03', 'mm/dd/yy', undef, 'mm/dd/yy 00/02/03'], ['13/02/03', 'mm/dd/yy', undef, 'mm/dd/yy 13/02/03'], ['03/31/03', 'mm/dd/yy', ['03/31/03', '03', '31', '03'], 'mm/dd/yy 03/31/03'], ['03/32/03', 'mm/dd/yy', undef, 'mm/dd/yy 03/31/03'], # 'hh' : hour, 00-23 ['00', 'hh', ['00', '00'], 'hour24 hh 00'], ['01', 'hh', ['01', '01'], 'hour24 hh 01'], ['10', 'hh', ['10', '10'], 'hour24 hh 10'], ['13', 'hh', ['13', '13'], 'hour24 hh 13'], ['20', 'hh', ['20', '20'], 'hour24 hh 20'], ['23', 'hh', ['23', '23'], 'hour24 hh 23'], [' 0', 'hh', undef, 'hour24 hh 0'], [' 1', 'hh', undef, 'hour24 hh 1'], ['24', 'hh', undef, 'hour24 hh 24'], # 'h' : hour, 0-23 ['00', 'h', ['00', '00'], 'hour24 h 00'], ['01', 'h', ['01', '01'], 'hour24 h 01'], ['10', 'h', ['10', '10'], 'hour24 h 10'], ['13', 'h', ['13', '13'], 'hour24 h 13'], ['20', 'h', ['20', '20'], 'hour24 h 20'], ['23', 'h', ['23', '23'], 'hour24 h 23'], [' 0', '\Ah\z', undef, 'hour24 h 0'], [' 1', '\Ah\z', undef, 'hour24 h 1'], ['0', 'h', ['0', '0'], 'hour24 h 0'], ['1', 'h', ['1', '1'], 'hour24 h 1'], ['24', '\Ah\z', undef, 'hour24 h 24'], # '?h' : hour, 0-23 ['00', '?h', undef, 'hour24 ?h 00'], ['01', '?h', undef, 'hour24 ?h 01'], ['10', '?h', ['10', '10'], 'hour24 ?h 10'], ['13', '?h', ['13', '13'], 'hour24 ?h 13'], ['20', '?h', ['20', '20'], 'hour24 ?h 20'], ['23', '?h', ['23', '23'], 'hour24 ?h 23'], ['0', '?h', undef, 'hour24 ?h 0'], ['1', '?h', undef, 'hour24 ?h 1'], [' 0', '?h', [' 0', ' 0'], 'hour24 ?h 0'], [' 1', '?h', [' 1', ' 1'], 'hour24 ?h 1'], ['24', '?h', undef, 'hour24 ?h 24'], # 'HH' : hour, 01-12 ['00', 'HH', undef, 'hour12 HH 00'], ['01', 'HH', ['01', '01'], 'hour12 HH 01'], ['10', 'HH', ['10', '10'], 'hour12 HH 10'], ['13', 'HH', undef, 'hour12 HH 13'], [' 0', 'HH', undef, 'hour12 HH 0'], [' 1', 'HH', undef, 'hour12 HH 1'], # 'H' : hour, 1-12 ['00', 'H', undef, 'hour12 H 00'], ['01', 'H', ['01', '01'], 'hour12 H 01'], ['10', 'H', ['10', '10'], 'hour12 H 10'], ['13', '\AH\z', undef, 'hour12 H 13'], [' 0', '\AH\z', undef, 'hour12 H 0'], [' 1', '\AH\z', undef, 'hour12 H 1'], ['0', 'H', undef, 'hour12 H 0'], ['1', 'H', ['1', '1'], 'hour12 H 1'], # '?h' : hour, 1-12 ['00', '?H', undef, 'hour12 ?H 00'], ['01', '?H', undef, 'hour12 ?H 01'], ['10', '?H', ['10', '10'], 'hour12 ?H 10'], ['13', '?H', undef, 'hour12 ?H 13'], ['0', '?H', undef, 'hour12 ?H 0'], ['1', '?H', undef, 'hour12 ?H 1'], [' 0', '?H', undef, 'hour12 ?H 0'], [' 1', '?H', [' 1', ' 1'], 'hour12 ?H 1'], # 'mm{on}' : month number, 01-12 ['01', 'mm{on}', ['01', '01'], 'month mm 01'], ['10', 'mm{on}', ['10', '10'], 'month mm 10'], ['12', 'mm{on}', ['12', '12'], 'month mm 12'], ['13', 'mm{on}', undef, 'month mm 13'], ['00', 'mm{on}', undef, 'month mm 00'], [' 0', 'mm{on}', undef, 'month mm 0'], [' 1', 'mm{on}', undef, 'month mm 1'], # 'm{on}' : month number, 1-12 ['01', '\Am{on}\z', ['01', '01'], 'month m 01'], ['10', 'm{on}', ['10', '10'], 'month m 10'], ['12', 'm{on}', ['12', '12'], 'month m 12'], ['13', '\Am{on}\z', undef, 'month m 13'], ['00', 'm{on}', undef, 'month m 00'], [' 0', '\Am{on}\z', undef, 'month m 0'], [' 1', '\Am{on}\z', undef, 'month m 1'], # '?m{on}' : month number, 1-12 ['01', '?m{on}', undef, 'month ?m 01'], ['10', '?m{on}', ['10', '10'], 'month ?m 10'], ['12', '?m{on}', ['12', '12'], 'month ?m 12'], ['13', '?m{on}', undef, 'month ?m 13'], ['00', '?m{on}', undef, 'month ?m 00'], [' 0', '?m{on}', undef, 'month ?m 0'], [' 1', '?m{on}', [' 1', ' 1'], 'month ?m 1'], # 'mm{in}' : minute number, 00-59 ['00', '\Amm{in}\z', ['00', '00'], 'minute mm 00'], ['01', '\Amm{in}\z', ['01', '01'], 'minute mm 01'], ['10', '\Amm{in}\z', ['10', '10'], 'minute mm 10'], ['20', '\Amm{in}\z', ['20', '20'], 'minute mm 20'], ['30', '\Amm{in}\z', ['30', '30'], 'minute mm 30'], ['40', '\Amm{in}\z', ['40', '40'], 'minute mm 40'], ['50', '\Amm{in}\z', ['50', '50'], 'minute mm 50'], ['59', '\Amm{in}\z', ['59', '59'], 'minute mm 59'], ['60', '\Amm{in}\z', undef, 'minute mm 60'], [' 0', '\Amm{in}\z', undef, 'minute mm 0'], [ '1', '\Amm{in}\z', undef, 'minute mm 1' ], # 'm{in}' : minute number, 0-59 ['00', '\Am{in}\z', ['00', '00'], 'minute m 00'], ['01', '\Am{in}\z', ['01', '01'], 'minute m 01'], ['10', '\Am{in}\z', ['10', '10'], 'minute m 10'], ['20', '\Am{in}\z', ['20', '20'], 'minute m 20'], ['30', '\Am{in}\z', ['30', '30'], 'minute m 30'], ['40', '\Am{in}\z', ['40', '40'], 'minute m 40'], ['50', '\Am{in}\z', ['50', '50'], 'minute m 50'], ['59', '\Am{in}\z', ['59', '59'], 'minute m 59'], ['60', '\Am{in}\z', undef, 'minute m 60'], [' 0', '\Am{in}\z', undef, 'minute m 0'], [' 1', '\Am{in}\z', undef, 'minute m 1' ], [ '0', '\Am{in}\z', ['0', '0'], 'minute m 0'], [ '1', '\Am{in}\z', ['1', '1'], 'minute m 1' ], # '?m{in}' : minute number, 0-59 ['00', '\A?m{in}\z', undef, 'minute ?m 00'], ['01', '\A?m{in}\z', undef, 'minute ?m 01'], ['10', '\A?m{in}\z', ['10', '10'], 'minute ?m 10'], ['20', '\A?m{in}\z', ['20', '20'], 'minute ?m 20'], ['30', '\A?m{in}\z', ['30', '30'], 'minute ?m 30'], ['40', '\A?m{in}\z', ['40', '40'], 'minute ?m 40'], ['50', '\A?m{in}\z', ['50', '50'], 'minute ?m 50'], ['59', '\A?m{in}\z', ['59', '59'], 'minute ?m 59'], ['60', '\A?m{in}\z', undef, 'minute ?m 60'], [' 0', '\A?m{in}\z', [' 0', ' 0'], 'minute ?m 0'], [' 1', '\A?m{in}\z', [' 1', ' 1'], 'minute ?m 1'], ['0', '\A?m{in}\z', undef, 'minute ?m 0'], ['1', '\A?m{in}\z', undef, 'minute ?m 1'], # 'ss' : second number, 00-59 ['00', '\Ass\z', ['00', '00'], 'second ss 00'], ['01', '\Ass\z', ['01', '01'], 'second ss 01'], ['10', '\Ass\z', ['10', '10'], 'second ss 10'], ['20', '\Ass\z', ['20', '20'], 'second ss 20'], ['30', '\Ass\z', ['30', '30'], 'second ss 30'], ['40', '\Ass\z', ['40', '40'], 'second ss 40'], ['50', '\Ass\z', ['50', '50'], 'second ss 50'], ['59', '\Ass\z', ['59', '59'], 'second ss 59'], ['60', '\Ass\z', ['60', '60'], 'second ss 60'], ['61', '\Ass\z', ['61', '61'], 'second ss 61'], ['62', '\Ass\z', undef, 'second ss 62'], [' 0', '\Ass\z', undef, 'second ss 0'], [ '1', '\Ass\z', undef, 'second ss 1' ], # 's' : second number, 00-61 ['00', '\As\z', ['00', '00'], 'second s 00'], ['01', '\As\z', ['01', '01'], 'second s 01'], ['10', '\As\z', ['10', '10'], 'second s 10'], ['20', '\As\z', ['20', '20'], 'second s 20'], ['30', '\As\z', ['30', '30'], 'second s 30'], ['40', '\As\z', ['40', '40'], 'second s 40'], ['50', '\As\z', ['50', '50'], 'second s 50'], ['59', '\As\z', ['59', '59'], 'second s 59'], ['60', '\As\z', ['60', '60'], 'second s 60'], ['61', '\As\z', ['61', '61'], 'second s 61'], ['62', '\As\z', undef, 'second s 62'], [' 0', '\As\z', undef, 'second s 0'], [' 1', '\As\z', undef, 'second s 1'], [ '0', '\As\z', ['0', '0'], 'second s 0'], [ '1', '\As\z', ['1', '1'], 'second s 1' ], # '?s' : second number, 0-59 ['00', '\A?s\z', undef, 'second ?s 00'], ['01', '\A?s\z', undef, 'second ?s 01'], ['10', '\A?s\z', ['10', '10'], 'second ?s 10'], ['20', '\A?s\z', ['20', '20'], 'second ?s 20'], ['30', '\A?s\z', ['30', '30'], 'second ?s 30'], ['40', '\A?s\z', ['40', '40'], 'second ?s 40'], ['50', '\A?s\z', ['50', '50'], 'second ?s 50'], ['59', '\A?s\z', ['59', '59'], 'second ?s 59'], ['60', '\A?s\z', ['60', '60'], 'second ?s 60'], ['61', '\A?s\z', ['61', '61'], 'second ?s 61'], ['62', '\A?s\z', undef, 'second ?s 62'], [' 0', '\A?s\z', [' 0', ' 0'], 'second ?s 0'], [' 1', '\A?s\z', [' 1', ' 1'], 'second ?s 1'], ['0', '\A?s\z', undef, 'second ?s 0'], ['1', '\A?s\z', undef, 'second ?s 1'], # Combo: H24:M:S ['00:00:00', 'hh:mm:ss', ['00:00:00', '00', '00', '00'], 'hh:mm:ss 00:00:00'], ['01:00:00', 'hh:mm:ss', ['01:00:00', '01', '00', '00'], 'hh:mm:ss 01:00:00'], ['10:00:00', 'hh:mm:ss', ['10:00:00', '10', '00', '00'], 'hh:mm:ss 10:00:00'], ['13:00:00', 'hh:mm:ss', ['13:00:00', '13', '00', '00'], 'hh:mm:ss 13:00:00'], ['20:00:00', 'hh:mm:ss', ['20:00:00', '20', '00', '00'], 'hh:mm:ss 20:00:00'], ['23:00:00', 'hh:mm:ss', ['23:00:00', '23', '00', '00'], 'hh:mm:ss 23:00:00'], [' 0:00:00', 'hh:mm:ss', undef, 'hh:mm:ss 0:00:00'], [' 1:00:00', 'hh:mm:ss', undef, 'hh:mm:ss 1:00:00'], ['24:00:00', 'hh:mm:ss', undef, 'hh:mm:ss 24:00:00'], ['02:00:00', 'hh:mm:ss', ['02:00:00', '02', '00', '00'], 'hh:mm:ss 02:00:00'], ['02:01:00', 'hh:mm:ss', ['02:01:00', '02', '01', '00'], 'hh:mm:ss 02:01:00'], ['02:10:00', 'hh:mm:ss', ['02:10:00', '02', '10', '00'], 'hh:mm:ss 02:10:00'], ['02:20:00', 'hh:mm:ss', ['02:20:00', '02', '20', '00'], 'hh:mm:ss 02:20:00'], ['02:30:00', 'hh:mm:ss', ['02:30:00', '02', '30', '00'], 'hh:mm:ss 02:30:00'], ['02:40:00', 'hh:mm:ss', ['02:40:00', '02', '40', '00'], 'hh:mm:ss 02:40:00'], ['02:50:00', 'hh:mm:ss', ['02:50:00', '02', '50', '00'], 'hh:mm:ss 02:50:00'], ['02:59:00', 'hh:mm:ss', ['02:59:00', '02', '59', '00'], 'hh:mm:ss 02:59:00'], ['02:60:00', 'hh:mm:ss', undef, 'hh:mm:ss 02:60:00'], ['02: 0:00', 'hh:mm:ss', undef, 'hh:mm:ss 02: 0:00'], ['02:1:00' , 'hh:mm:ss', undef, 'hh:mm:ss 02:1:00' ], ['13:45:00', 'hh:mm:ss', ['13:45:00', '13', '45', '00'], 'hh:mm:ss 13:45:00'], ['13:45:01', 'hh:mm:ss', ['13:45:01', '13', '45', '01'], 'hh:mm:ss 13:45:01'], ['13:45:10', 'hh:mm:ss', ['13:45:10', '13', '45', '10'], 'hh:mm:ss 13:45:10'], ['13:45:20', 'hh:mm:ss', ['13:45:20', '13', '45', '20'], 'hh:mm:ss 13:45:20'], ['13:45:30', 'hh:mm:ss', ['13:45:30', '13', '45', '30'], 'hh:mm:ss 13:45:30'], ['13:45:40', 'hh:mm:ss', ['13:45:40', '13', '45', '40'], 'hh:mm:ss 13:45:40'], ['13:45:50', 'hh:mm:ss', ['13:45:50', '13', '45', '50'], 'hh:mm:ss 13:45:50'], ['13:45:59', 'hh:mm:ss', ['13:45:59', '13', '45', '59'], 'hh:mm:ss 13:45:59'], ['13:45:60', 'hh:mm:ss', ['13:45:60', '13', '45', '60'], 'hh:mm:ss 13:45:60'], ['13:45:61', 'hh:mm:ss', ['13:45:61', '13', '45', '61'], 'hh:mm:ss 13:45:61'], ['13:45:62', 'hh:mm:ss', undef, 'hh:mm:ss 13:45:62'], ['13:45: 0', 'hh:mm:ss', undef, 'hh:mm:ss 13:45: 0'], ['13:45:1', 'hh:mm:ss', undef, 'hh:mm:ss 13:45:1' ], # 'yy' : 2-digit year number ['00', 'yy', ['00', '00'], '2-digit year 00'], ['01', 'yy', ['01', '01'], '2-digit year 01'], ['90', 'yy', ['90', '90'], '2-digit year 90'], ['99', 'yy', ['99', '99'], '2-digit year 99'], ['3', 'yy', undef, '2-digit year 3'], # 'yyyy' : 4-digit year number ['0000', 'yyyy', ['0000', '0000'], '4-digit year 0000'], ['1801', 'yyyy', ['1801', '1801'], '4-digit year 1801'], ['1990', 'yyyy', ['1990', '1990'], '4-digit year 1990'], ['2099', 'yyyy', ['2099', '2099'], '4-digit year 2099'], ['9999', 'yyyy', ['9999', '9999'], '4-digit year 9999'], ['30', 'yyyy', undef, '4-digit year 30'], # 'mmm' : millisecond ['000', 'mmm', ['000', '000'], 'millisecond 000'], ['101', 'mmm', ['101', '101'], 'millisecond 101'], ['190', 'mmm', ['190', '190'], 'millisecond 190'], ['999', 'mmm', ['999', '999'], 'millisecond 999'], [ '0', 'mmm', undef, 'millisecond 0'], [ '01', 'mmm', undef, 'millisecond 01'], # 'uuuuuu' : microsecond ['000000', 'uuuuuu', ['000000', '000000'], 'microsecond 000000'], ['101101', 'uuuuuu', ['101101', '101101'], 'microsecond 101101'], ['999999', 'uuuuuu', ['999999', '999999'], 'microsecond 999999'], [ '0', 'uuuuuu', undef, 'microsecond 0'], [ '01', 'uuuuuu', undef, 'microsecond 01'], ); # How many matches will succeed? my $to_succeed = scalar grep $_->[2], @match; # Run two tests per match, plus two additional per expected success $num_tests = 2 * scalar(@match) + 2 * $to_succeed; # Plus one for the 'use_ok' call $num_tests += 1; } use Test::More tests => $num_tests; use_ok('Regexp::Common', 'time'); foreach my $match (@match) { my ($text, $pattern, $matchvars, $testname) = @$match; my $did_succeed; my $should_succeed = defined $matchvars; my @captures; # Regexp captures # FIRST: check whether it succeeded or failed as expected. # 'keep' option is OFF; should be no captures. @captures = $text =~ /$RE{time}{tf}{-pat=>$pattern}/; $did_succeed = @captures > 0; # TEST 1: simple matching my $ought = $should_succeed? 'match' : 'fail'; my $actual = $did_succeed == $should_succeed? "${ought}ed" : "did not $ought"; ok ( ($should_succeed && $did_succeed) || (!$should_succeed && !$did_succeed), "$testname - $actual as expected (nokeep)."); # TEST 2: Shouldn't capture anything if ($should_succeed) { SKIP: { skip "$testname - can't check captures since match unsuccessful", 1 if !$did_succeed; skip "$testname - user-controlled captures", 1 if $pattern =~ /\(/; is_deeply(\@captures, [1], "$testname - didn't unduly capture"); } } # SECOND: use 'keep' option to check captures. @captures = $text =~ /$RE{time}{tf}{-pat=>$pattern}{-keep}/; $did_succeed = @captures > 0; # TEST 3: matching with 'keep' ok ( ($should_succeed && $did_succeed) || (!$should_succeed && !$did_succeed), "$testname - $actual as expected (keep)."); # TEST 4: capture variables should be set. if ($should_succeed) { SKIP: { skip "$testname - can't check captures since match unsuccessful", 1 if !$did_succeed; is_deeply(\@captures, $matchvars, "$testname - correct capture variables"); } } } Regexp-Common-time-0.05/t/dmy.t000444001750001750 10564512243100275 16046 0ustar00gaborgabor000000000000use strict; use vars qw(@match $num_tests %RE); # Get day/month names in current locale my ($Jan, $Feb, $Mar, $Apr, $May, $Jun, $Jul, $Aug, $Sep, $Oct, $Nov, $Dec); my ($January, $February, $March, $April, $MayFull, $June, $July, $August, $September, $October, $November, $December); BEGIN { eval { require I18N::Langinfo; I18N::Langinfo->import(qw(langinfo MON_1 ABMON_1 MON_2 ABMON_2 MON_3 ABMON_3 MON_4 ABMON_4 MON_5 ABMON_5 MON_6 ABMON_6 MON_7 ABMON_7 MON_8 ABMON_8 MON_9 ABMON_9 MON_10 ABMON_10 MON_11 ABMON_11 MON_12 ABMON_12)); ($Jan, $Feb, $Mar, $Apr, $May, $Jun, $Jul, $Aug, $Sep, $Oct, $Nov, $Dec) = map langinfo($_), (ABMON_1(), ABMON_2(), ABMON_3(), ABMON_4(), ABMON_5(), ABMON_6(), ABMON_7(), ABMON_8(), ABMON_9(), ABMON_10(), ABMON_11(), ABMON_12()); ($January, $February, $March, $April, $MayFull, $June, $July, $August, $September, $October, $November, $December) = map langinfo($_), (MON_1(), MON_2(), MON_3(), MON_4(), MON_5(), MON_6(), MON_7(), MON_8(), MON_9(), MON_10(), MON_11(), MON_12()); }; if ($@) { ($Jan, $Feb, $Mar, $Apr, $May, $Jun, $Jul, $Aug, $Sep, $Oct, $Nov, $Dec) = qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec); ($January, $February, $March, $April, $MayFull, $June, $July, $August, $September, $October, $November, $December) = qw(January February March April May June July August September October November December); } @match = ( # dmy tests. ['19/10/2005', 'dmy', [], 1, [qw(19/10/2005 19 10 2005)]], ['19.10.2005', 'dmy', [], 1, [qw(19.10.2005 19 10 2005)]], ['19-10-2005', 'dmy', [], 1, [qw(19-10-2005 19 10 2005)]], ['19x10x2005', 'dmy', [], 0, ], ['19102005', 'dmy', [], 1, [qw(19102005 19 10 2005)]], # leading/trailing junk shouldn't cause the match to change ['abc19/10/2005zyx', 'dmy', [], 1, [qw(19/10/2005 19 10 2005)]], ['abc19.10.2005zyx', 'dmy', [], 1, [qw(19.10.2005 19 10 2005)]], ['abc19-10-2005zyx', 'dmy', [], 1, [qw(19-10-2005 19 10 2005)]], ['abc19x10x2005zyx', 'dmy', [], 0, ], ['abc19102005zyx', 'dmy', [], 1, [qw(19102005 19 10 2005)]], # However, leading or trailing digits should cause this loose match to fail. ['019/10/2005', 'dmy', [], 0, ], ['19/10/050', 'dmy', [], 0, ], ['19/10/20050', 'dmy', [], 0, ], # Two-year date should match dmy as well ['19/10/05', 'dmy', [], 1, [qw(19/10/05 19 10 05)]], ['19.10.05', 'dmy', [], 1, [qw(19.10.05 19 10 05)]], ['19-10-05', 'dmy', [], 1, [qw(19-10-05 19 10 05)]], ['19x10x05', 'dmy', [], 0, ], ['191005', 'dmy', [], 1, [qw(191005 19 10 05)]], # separators ['19:10:2005', 'dmy', [], 0, ], ['19 10 2005', 'dmy', [], 1, [ q(19 10 2005), qw(19 10 2005)]], ['19*10*2005', 'dmy', [], 0, ], ['19?10?2005', 'dmy', [], 0, ], # one-digit month ['19/1/2005', 'dmy', [], 1, [qw(19/1/2005 19 1 2005)]], ['19.1.2005', 'dmy', [], 1, [qw(19.1.2005 19 1 2005)]], ['19-1-2005', 'dmy', [], 1, [qw(19-1-2005 19 1 2005)]], ['19 1 2005', 'dmy', [], 1, [q(19 1 2005), qw(19 1 2005)]], ['19x1x2005', 'dmy', [], 0, ], ['1912005', 'dmy', [], 0, ], # one-digit day ['9/10/2005', 'dmy', [], 1, [qw(9/10/2005 9 10 2005)]], ['9.10.2005', 'dmy', [], 1, [qw(9.10.2005 9 10 2005)]], ['9-10-2005', 'dmy', [], 1, [qw(9-10-2005 9 10 2005)]], ['9x10x2005', 'dmy', [], 0, ], ['9102005', 'dmy', [], 0, ], ['9101205', 'dmy', [], 0, ], # one-digit month and day ['9/1/2005', 'dmy', [], 1, [qw(9/1/2005 9 1 2005)]], ['9.1.2005', 'dmy', [], 1, [qw(9.1.2005 9 1 2005)]], ['9-1-2005', 'dmy', [], 1, [qw(9-1-2005 9 1 2005)]], ['9x1x2005', 'dmy', [], 0, ], ['912005', 'dmy', [], 0, ], # dd/m/yy ['19/1/05', 'dmy', [], 1, [qw(19/1/05 19 1 05)]], ['19.1.05', 'dmy', [], 1, [qw(19.1.05 19 1 05)]], ['19-1-05', 'dmy', [], 1, [qw(19-1-05 19 1 05)]], ['19x1x05', 'dmy', [], 0, ], ['19105', 'dmy', [], 0, ], # d/mm/yy ['9/10/05', 'dmy', [], 1, [qw(9/10/05 9 10 05)]], ['9.10.05', 'dmy', [], 1, [qw(9.10.05 9 10 05)]], ['9-10-05', 'dmy', [], 1, [qw(9-10-05 9 10 05)]], ['9x10x05', 'dmy', [], 0, ], ['91005', 'dmy', [], 0, ], # d/m/yy ['9/1/05', 'dmy', [], 1, [qw(9/1/05 9 1 05)]], ['9.1.05', 'dmy', [], 1, [qw(9.1.05 9 1 05)]], ['9-1-05', 'dmy', [], 1, [qw(9-1-05 9 1 05)]], ['9x1x05', 'dmy', [], 0, ], ['9105', 'dmy', [], 0, ], # Invalid month ['19/13/2005', 'dmy', [], 0, ], ['19/21/2005', 'dmy', [], 0, ], ['19/0/2005', 'dmy', [], 0, ], ['19/00/2005', 'dmy', [], 0, ], # Invalid day ['0/12/2005', 'dmy', [], 0, ], ['00/12/2005', 'dmy', [], 0, ], ['40/12/2005', 'dmy', [], 0, ], ['32/12/2005', 'dmy', [], 0, ], # dmy4 tests. Mostly the same as above. ['19/10/2005', 'dmy4', [], 1, [qw(19/10/2005 19 10 2005)]], ['19.10.2005', 'dmy4', [], 1, [qw(19.10.2005 19 10 2005)]], ['19-10-2005', 'dmy4', [], 1, [qw(19-10-2005 19 10 2005)]], ['19x10x2005', 'dmy4', [], 0, ], ['19102005', 'dmy4', [], 1, [qw(19102005 19 10 2005)]], # leading/trailing junk shouldn't cause the match to change ['abc19/10/2005000', 'dmy4', [], 1, [qw(19/10/2005 19 10 2005)]], ['abc19.10.2005xyz', 'dmy4', [], 1, [qw(19.10.2005 19 10 2005)]], ['abc19-10-2005xyz', 'dmy4', [], 1, [qw(19-10-2005 19 10 2005)]], ['abc19x10x2005xyz', 'dmy4', [], 0, ], ['abc19102005000', 'dmy4', [], 1, [qw(19102005 19 10 2005)]], # However, leading digits will cause loose d to fail ['019/10/2005', 'dmy4', [], 0, ], # Two-year date should not match dmy4 ['19/10/05', 'dmy4', [], 0, ], ['19.10.05', 'dmy4', [], 0, ], ['19-10-05', 'dmy4', [], 0, ], ['19x10x05', 'dmy4', [], 0, ], ['191005', 'dmy4', [], 0, ], # separators ['19:10:2005', 'dmy4', [], 0, ], ['19 10 2005', 'dmy4', [], 1, [ q(19 10 2005), qw(19 10 2005)]], ['19*10*2005', 'dmy4', [], 0, ], ['19?10?2005', 'dmy4', [], 0, ], # one-digit month ['19/1/2005', 'dmy4', [], 1, [qw(19/1/2005 19 1 2005)]], ['19.1.2005', 'dmy4', [], 1, [qw(19.1.2005 19 1 2005)]], ['19-1-2005', 'dmy4', [], 1, [qw(19-1-2005 19 1 2005)]], ['19x1x2005', 'dmy4', [], 0, ], ['1912005', 'dmy4', [], 0, ], # one-digit day ['9/10/2005', 'dmy4', [], 1, [qw(9/10/2005 9 10 2005)]], ['9.10.2005', 'dmy4', [], 1, [qw(9.10.2005 9 10 2005)]], ['9-10-2005', 'dmy4', [], 1, [qw(9-10-2005 9 10 2005)]], ['9x10x2005', 'dmy4', [], 0, ], ['9102005', 'dmy4', [], 0, ], # one-digit month and day ['9/1/2005', 'dmy4', [], 1, [qw(9/1/2005 9 1 2005)]], ['9.1.2005', 'dmy4', [], 1, [qw(9.1.2005 9 1 2005)]], ['9-1-2005', 'dmy4', [], 1, [qw(9-1-2005 9 1 2005)]], ['9x1x2005', 'dmy4', [], 0, ], ['912005', 'dmy4', [], 0, ], # dd/m/yy ['19/1/05', 'dmy4', [], 0, ], ['19.1.05', 'dmy4', [], 0, ], ['19-1-05', 'dmy4', [], 0, ], ['19x1x05', 'dmy4', [], 0, ], ['19105', 'dmy4', [], 0, ], # d/mm/yy ['9/10/05', 'dmy4', [], 0, ], ['9.10.05', 'dmy4', [], 0, ], ['9-10-05', 'dmy4', [], 0, ], ['9x10x05', 'dmy4', [], 0, ], ['91005', 'dmy4', [], 0, ], # d/m/yy ['9/1/05', 'dmy4', [], 0, ], ['9.1.05', 'dmy4', [], 0, ], ['9-1-05', 'dmy4', [], 0, ], ['9x1x05', 'dmy4', [], 0, ], ['9105', 'dmy4', [], 0, ], # Invalid month ['19/13/2005', 'dmy4', [], 0, ], ['19/21/2005', 'dmy4', [], 0, ], ['19/0/2005', 'dmy4', [], 0, ], ['19/00/2005', 'dmy4', [], 0, ], # Invalid day ['0/12/2005', 'dmy4', [], 0, ], ['00/12/2005', 'dmy4', [], 0, ], ['40/12/2005', 'dmy4', [], 0, ], ['32/12/2005', 'dmy4', [], 0, ], # dmy2 tests ['19/10/2005', 'dmy2', [], 1, [qw(19/10/20 19 10 20)]], ['19.10.2005', 'dmy2', [], 1, [qw(19.10.20 19 10 20)]], ['19-10-2005', 'dmy2', [], 1, [qw(19-10-20 19 10 20)]], ['19x10x2005', 'dmy2', [], 0, ], ['19102005', 'dmy2', [], 1, [qw(191020 19 10 20)]], # Trailing digits will NOT cause y2 to fail ['abc191005000', 'dmy2', [], 1, [qw(191005 19 10 05)]], ['abc191005xyz', 'dmy2', [], 1, [qw(191005 19 10 05)]], # Leading digits WILL cause loose d to fail ['abc191005', 'dmy2', [], 1, [qw(191005 19 10 05)]], ['000191005', 'dmy2', [], 0, ], ['0191005', 'dmy2', [], 0, ], # Two-year date should match dmy2 ['19/10/05', 'dmy2', [], 1, [qw(19/10/05 19 10 05)]], ['19.10.05', 'dmy2', [], 1, [qw(19.10.05 19 10 05)]], ['19-10-05', 'dmy2', [], 1, [qw(19-10-05 19 10 05)]], ['19x10x05', 'dmy2', [], 0, ], ['191005', 'dmy2', [], 1, [qw(191005 19 10 05)]], # separators ['19:10:05', 'dmy2', [], 0, ], ['19 10 05', 'dmy2', [], 1, [ q(19 10 05), qw(19 10 05)]], ['19*10*05', 'dmy2', [], 0, ], ['19x10x05', 'dmy2', [], 0, ], ['191005', 'dmy2', [], 1, [qw(191005 19 10 05)]], # one-digit month ['19/1/05', 'dmy2', [], 1, [qw(19/1/05 19 1 05)]], ['19.1.05', 'dmy2', [], 1, [qw(19.1.05 19 1 05)]], ['19-1-05', 'dmy2', [], 1, [qw(19-1-05 19 1 05)]], ['19x1x05', 'dmy2', [], 0, ], ['19105', 'dmy2', [], 0, ], # one-digit day ['9/10/05', 'dmy2', [], 1, [qw(9/10/05 9 10 05)]], ['9.10.05', 'dmy2', [], 1, [qw(9.10.05 9 10 05)]], ['9-10-05', 'dmy2', [], 1, [qw(9-10-05 9 10 05)]], ['9x10x05', 'dmy2', [], 0, ], ['91005', 'dmy2', [], 0, ], # one-digit month and day ['9/1/05', 'dmy2', [], 1, [qw(9/1/05 9 1 05)]], ['9.1.05', 'dmy2', [], 1, [qw(9.1.05 9 1 05)]], ['9-1-05', 'dmy2', [], 1, [qw(9-1-05 9 1 05)]], ['9x1x05', 'dmy2', [], 0, ], ['9105', 'dmy2', [], 0, ], # dd/m/yyyy ['19/1/2005', 'dmy2', [], 1, [qw(19/1/20 19 1 20)]], ['19.1.2005', 'dmy2', [], 1, [qw(19.1.20 19 1 20)]], ['19-1-2005', 'dmy2', [], 1, [qw(19-1-20 19 1 20)]], ['19x1x2005', 'dmy2', [], 0, ], ['1912005', 'dmy2', [], 1, [qw(191200 19 12 00)]], # d/mm/yyyy ['9/10/2005', 'dmy2', [], 1, [qw(9/10/20 9 10 20)]], ['9.10.2005', 'dmy2', [], 1, [qw(9.10.20 9 10 20)]], ['9-10-2005', 'dmy2', [], 1, [qw(9-10-20 9 10 20)]], ['9x10x2005', 'dmy2', [], 0, ], ['9102005', 'dmy2', [], 0, ], ['9101205', 'dmy2', [], 0, ], # d/m/yyyy ['9/1/2005', 'dmy2', [], 1, [qw(9/1/20 9 1 20)]], ['9.1.2005', 'dmy2', [], 1, [qw(9.1.20 9 1 20)]], ['9-1-2005', 'dmy2', [], 1, [qw(9-1-20 9 1 20)]], ['9x1x2005', 'dmy2', [], 0, ], ['912005', 'dmy2', [], 0, ], # Invalid month ['19/13/05', 'dmy2', [], 0, ], ['19/21/05', 'dmy2', [], 0, ], ['19/0/05', 'dmy2', [], 0, ], ['19/00/05', 'dmy2', [], 0, ], # Invalid day ['0/12/05', 'dmy2', [], 0, ], ['00/12/05', 'dmy2', [], 0, ], ['40/12/05', 'dmy2', [], 0, ], ['32/12/05', 'dmy2', [], 0, ], # d2m2y4 tests ['19/10/2005', 'd2m2y4', [], 1, [qw(19/10/2005 19 10 2005)]], ['19.10.2005', 'd2m2y4', [], 1, [qw(19.10.2005 19 10 2005)]], ['19-10-2005', 'd2m2y4', [], 1, [qw(19-10-2005 19 10 2005)]], ['19x10x2005', 'd2m2y4', [], 0, ], ['19102005', 'd2m2y4', [], 1, [qw(19102005 19 10 2005)]], # leading/trailing junk shouldn't cause the match to change ['abc19/10/2005000', 'd2m2y4', [], 1, [qw(19/10/2005 19 10 2005)]], ['abc19.10.2005000', 'd2m2y4', [], 1, [qw(19.10.2005 19 10 2005)]], ['00019-10-2005xyz', 'd2m2y4', [], 1, [qw(19-10-2005 19 10 2005)]], ['abc19x10x2005000', 'd2m2y4', [], 0, ], ['abc19102005000', 'd2m2y4', [], 1, [qw(19102005 19 10 2005)]], # Two-year date should not match ['19/10/05', 'd2m2y4', [], 0, ], ['19.10.05', 'd2m2y4', [], 0, ], ['19-10-05', 'd2m2y4', [], 0, ], ['19x10x05', 'd2m2y4', [], 0, ], ['191005', 'd2m2y4', [], 0, ], # separators ['19:10:2005', 'd2m2y4', [], 0, ], ['19*10*2005', 'd2m2y4', [], 0, ], ['19?10?2005', 'd2m2y4', [], 0, ], ['19x10x2005', 'd2m2y4', [], 0, ], # one-digit month ['19/1/2005', 'd2m2y4', [], 0, ], ['19.1.2005', 'd2m2y4', [], 0, ], ['19-1-2005', 'd2m2y4', [], 0, ], ['19x1x2005', 'd2m2y4', [], 0, ], ['1912005', 'd2m2y4', [], 0, ], # one-digit day ['9/10/2005', 'd2m2y4', [], 0, ], ['9.10.2005', 'd2m2y4', [], 0, ], ['9-10-2005', 'd2m2y4', [], 0, ], ['9x10x2005', 'd2m2y4', [], 0, ], ['9102005', 'd2m2y4', [], 0, ], # one-digit month and day ['9/1/2005', 'd2m2y4', [], 0, ], ['9.1.2005', 'd2m2y4', [], 0, ], ['9-1-2005', 'd2m2y4', [], 0, ], ['9x1x2005', 'd2m2y4', [], 0, ], ['912005', 'd2m2y4', [], 0, ], # m/dd/yy ['19/1/05', 'd2m2y4', [], 0, ], ['19.1.05', 'd2m2y4', [], 0, ], ['19-1-05', 'd2m2y4', [], 0, ], ['19x1x05', 'd2m2y4', [], 0, ], ['19105', 'd2m2y4', [], 0, ], # mm/d/yy ['9/10/05', 'd2m2y4', [], 0, ], ['9.10.05', 'd2m2y4', [], 0, ], ['9-10-05', 'd2m2y4', [], 0, ], ['9x10x05', 'd2m2y4', [], 0, ], ['91005', 'd2m2y4', [], 0, ], # m/d/yy ['9/1/05', 'd2m2y4', [], 0, ], ['9.1.05', 'd2m2y4', [], 0, ], ['9-1-05', 'd2m2y4', [], 0, ], ['9x1x05', 'd2m2y4', [], 0, ], ['9105', 'd2m2y4', [], 0, ], # Invalid month ['19/13/2005', 'd2m2y4', [], 0, ], ['19/21/2005', 'd2m2y4', [], 0, ], ['19/0/2005', 'd2m2y4', [], 0, ], ['19/00/2005', 'd2m2y4', [], 0, ], # Invalid day ['0/12/2005', 'd2m2y4', [], 0, ], ['00/12/2005', 'd2m2y4', [], 0, ], ['40/12/2005', 'd2m2y4', [], 0, ], ['32/12/2005', 'd2m2y4', [], 0, ], # d2m2y2 tests ['19/10/2005', 'd2m2y2', [], 1, [qw(19/10/20 19 10 20)]], ['19.10.2005', 'd2m2y2', [], 1, [qw(19.10.20 19 10 20)]], ['19-10-2005', 'd2m2y2', [], 1, [qw(19-10-20 19 10 20)]], ['19x10x2005', 'd2m2y2', [], 0, ], ['19102005', 'd2m2y2', [], 1, [qw(191020 19 10 20)]], # leading/trailing junk shouldn't cause the match to change # Not even trailing digits, since we're specifying y2. ['abc19/10/2005000', 'd2m2y2', [], 1, [qw(19/10/20 19 10 20)]], ['0019102005xyz', 'd2m2y2', [], 1, [qw(191020 19 10 20)]], ['abc191005abc', 'd2m2y2', [], 1, [qw(191005 19 10 05)]], # Two-year date should match ['19/10/05', 'd2m2y2', [], 1, [qw(19/10/05 19 10 05)]], ['19.10.05', 'd2m2y2', [], 1, [qw(19.10.05 19 10 05)]], ['19-10-05', 'd2m2y2', [], 1, [qw(19-10-05 19 10 05)]], ['19x10x05', 'd2m2y2', [], 0, ], ['191005', 'd2m2y2', [], 1, [qw(191005 19 10 05)]], # separators ['19:10:05', 'd2m2y2', [], 0, ], ['19 10 05', 'd2m2y2', [], 1, [ q(19 10 05), qw(19 10 05)]], ['19?10?05', 'd2m2y2', [], 0, ], ['19x10x05', 'd2m2y2', [], 0, ], # Mismatched separators ['19/10 05', 'd2m2y2', [], 0, ], ['19-1005', 'd2m2y2', [], 0, ], ['19?10-05', 'd2m2y2', [], 0, ], ['19/10x05', 'd2m2y2', [], 0, ], # one-digit month ['19/1/2005', 'd2m2y2', [], 0, ], ['19.1.2005', 'd2m2y2', [], 0, ], ['19-1-2005', 'd2m2y2', [], 0, ], ['19x1x2005', 'd2m2y2', [], 0, ], ['1912005', 'd2m2y2', [], 1, [qw(191200 19 12 00)]], # one-digit day ['9/10/2005', 'd2m2y2', [], 0, ], ['9.10.2005', 'd2m2y2', [], 0, ], ['9-10-2005', 'd2m2y2', [], 0, ], ['9x10x2005', 'd2m2y2', [], 0, ], ['9102005', 'd2m2y2', [], 0, ], ['9102005', 'd2m2y2', [], 0, ], # one-digit month and day ['9/1/2005', 'd2m2y2', [], 0, ], ['9.1.2005', 'd2m2y2', [], 0, ], ['9-1-2005', 'd2m2y2', [], 0, ], ['9x1x2005', 'd2m2y2', [], 0, ], ['912005', 'd2m2y2', [], 0, ], ['912005', 'd2m2y2', [], 0, ], # m/dd/yy ['19/1/05', 'd2m2y2', [], 0, ], ['19.1.05', 'd2m2y2', [], 0, ], ['19-1-05', 'd2m2y2', [], 0, ], ['19x1x05', 'd2m2y2', [], 0, ], ['19105', 'd2m2y2', [], 0, ], ['19105', 'd2m2y2', [], 0, ], # mm/d/yy ['9/10/05', 'd2m2y2', [], 0, ], ['9.10.05', 'd2m2y2', [], 0, ], ['9-10-05', 'd2m2y2', [], 0, ], ['9x10x05', 'd2m2y2', [], 0, ], ['91005', 'd2m2y2', [], 0, ], # m/d/yy ['9/1/05', 'd2m2y2', [], 0, ], ['9.1.05', 'd2m2y2', [], 0, ], ['9-1-05', 'd2m2y2', [], 0, ], ['9x1x05', 'd2m2y2', [], 0, ], ['9105', 'd2m2y2', [], 0, ], # Invalid month ['19/13/05', 'd2m2y2', [], 0, ], ['19/21/05', 'd2m2y2', [], 0, ], ['19/0/05', 'd2m2y2', [], 0, ], ['19/00/05', 'd2m2y2', [], 0, ], # Invalid day ['0/12/05', 'd2m2y2', [], 0, ], ['00/12/05', 'd2m2y2', [], 0, ], ['40/12/05', 'd2m2y2', [], 0, ], ['32/12/05', 'd2m2y2', [], 0, ], # month name tests # Basic test case ["01 $Jan 2005", "dmy", [], 1, ["01 $Jan 2005", '01', $Jan, '2005']], # 2-digit year ["01 $Jan 05", "dmy", [], 1, ["01 $Jan 05", '01', $Jan, '05']], # odd number of digits in year [ "01 $Jan 9", "dmy", [], 0, ], [ "01 $Jan 120", "dmy", [], 0, ], [ "01 $Jan 20051", "dmy", [], 0, ], # Leading/trailing junk ["abc01 $Jan 05", "dmy", [], 1, ["01 $Jan 05", '01', $Jan, '05']], ["01 $Jan 05xyz", "dmy", [], 1, ["01 $Jan 05", '01', $Jan, '05']], ["001 $Jan 05", "dmy", [], 0, ], ["01 $Jan 050", "dmy", [], 0, ], ["01 $Jan 20050", "dmy", [], 0, ], # Name spelled out ["01 $January 2005", "dmy", [], 1, ["01 $January 2005", '01', $January, 2005]], # Partial name should fail ["01 ${Jan}u 2005", "dmy", [], 0, ], # All twelve names (and abbreviations) Also valid day formats. [ "1 $February 2005", "dmy", [], 1, [ "1 $February 2005", '1', $February , 2005]], [ "2 $March 2005", "dmy", [], 1, [ "2 $March 2005", '2', $March , 2005]], ["09 $April 2005", "dmy", [], 1, ["09 $April 2005", '09', $April , 2005]], [ "9 $MayFull 2005", "dmy", [], 1, [ "9 $MayFull 2005", '9', $MayFull , 2005]], ["10 $June 2005", "dmy", [], 1, ["10 $June 2005", '10', $June , 2005]], ["11 $July 2005", "dmy", [], 1, ["11 $July 2005", '11', $July , 2005]], ["19 $August 2005", "dmy", [], 1, ["19 $August 2005", '19', $August , 2005]], ["20 $September 2005", "dmy", [], 1, ["20 $September 2005", '20', $September, 2005]], ["21 $October 2005", "dmy", [], 1, ["21 $October 2005", '21', $October , 2005]], ["30 $November 2005", "dmy", [], 1, ["30 $November 2005", '30', $November , 2005]], ["31 $December 2005", "dmy", [], 1, ["31 $December 2005", '31', $December , 2005]], [ "1 $Feb 2005", "dmy", [], 1, [ "1 $Feb 2005", '1', $Feb, 2005]], [ "2 $Mar 2005", "dmy", [], 1, [ "2 $Mar 2005", '2', $Mar, 2005]], ["09 $Apr 2005", "dmy", [], 1, ["09 $Apr 2005", '09', $Apr, 2005]], [ "9 $MayFull 2005", "dmy", [], 1, [ "9 $MayFull 2005", '9', $MayFull, 2005]], ["10 $Jun 2005", "dmy", [], 1, ["10 $Jun 2005", '10', $Jun, 2005]], ["11 $Jul 2005", "dmy", [], 1, ["11 $Jul 2005", '11', $Jul, 2005]], ["19 $Aug 2005", "dmy", [], 1, ["19 $Aug 2005", '19', $Aug, 2005]], ["20 $Sep 2005", "dmy", [], 1, ["20 $Sep 2005", '20', $Sep, 2005]], ["21 $Oct 2005", "dmy", [], 1, ["21 $Oct 2005", '21', $Oct, 2005]], ["30 $Nov 2005", "dmy", [], 1, ["30 $Nov 2005", '30', $Nov, 2005]], ["31 $Dec 2005", "dmy", [], 1, ["31 $Dec 2005", '31', $Dec, 2005]], # Case insensitivity ["01 \L$Jan 2005", "dmy", [], 1, ["01 \L$Jan 2005", qw(01), lc($Jan), 2005]], ["01 \U\l$Jan 2005", "dmy", [], 1, ["01 \U\l$Jan 2005", qw(01), lcfirst(uc($Jan)), 2005]], # Alternate separators ["01:$Jan:2005", "dmy", [], 0, ], ["01-$Jan-2005", "dmy", [], 1, ["01-$Jan-2005", '01', $Jan, '2005']], ["01.$Jan.2005", "dmy", [], 1, ["01.$Jan.2005", '01', $Jan, '2005']], # Schmutz before/after the date ["01 blah$Jan 2005", "dmy", [], 0, ], ["01 $Jan 2005blah", "dmy", [], 1, ["01 $Jan 2005", '01', $Jan, '2005']], # Bad separator ["01 $Jan 2005", "dmy", [], 0, ], # Bad day ["00 $Jan 2005", "dmy", [], 0, ], [ "0 $Jan 2005", "dmy", [], 0, ], ["32 $Jan 2005", "dmy", [], 0, ], ["40 $Jan 2005", "dmy", [], 0, ], ["99 $Jan 2005", "dmy", [], 0, ], # month name tests # Basic test case ["01 $Jan 2005", "dmy4", [], 1, ["01 $Jan 2005", '01', $Jan, '2005']], # 2-digit year ["01 $Jan 05", "dmy4", [], 0, ], # odd number of digits in year [ "01 $Jan 9", "dmy4", [], 0, ], [ "01 $Jan 120", "dmy4", [], 0, ], [ "01 $Jan 20051", "dmy4", [], 1, ["01 $Jan 2005", '01', $Jan, '2005']], # Leading/trailing junk ["abc01 $Jan 2005", "dmy4", [], 1, ["01 $Jan 2005", '01', $Jan, '2005']], ["01 $Jan 2005xyz", "dmy4", [], 1, ["01 $Jan 2005", '01', $Jan, '2005']], ["001 $Jan 2005", "dmy4", [], 0, ], ["01 $Jan 20050", "dmy4", [], 1, ["01 $Jan 2005", '01', $Jan, '2005']], # Name spelled out ["01 $January 2005", "dmy4", [], 1, ["01 $January 2005", '01', $January, '2005']], # Partial name should fail ["01 ${Jan}u 2005", "dmy4", [], 0, ], # All twelve names (and abbreviations) Also valid day formats. [ "1 $February 2005", "dmy4", [], 1, [ "1 $February 2005", '1', $February, '2005']], [ "2 $March 2005", "dmy4", [], 1, [ "2 $March 2005", '2', $March, '2005']], ["09 $April 2005", "dmy4", [], 1, ["09 $April 2005", '09', $April, '2005']], [ "9 $MayFull 2005", "dmy4", [], 1, [ "9 $MayFull 2005", '9', $MayFull, '2005']], ["10 $June 2005", "dmy4", [], 1, ["10 $June 2005", '10', $June, '2005']], ["11 $July 2005", "dmy4", [], 1, ["11 $July 2005", '11', $July, '2005']], ["19 $August 2005", "dmy4", [], 1, ["19 $August 2005", '19', $August, '2005']], ["20 $September 2005", "dmy4", [], 1, ["20 $September 2005", '20', $September, '2005']], ["21 $October 2005", "dmy4", [], 1, ["21 $October 2005", '21', $October, '2005']], ["30 $November 2005", "dmy4", [], 1, ["30 $November 2005", '30', $November, '2005']], ["31 $December 2005", "dmy4", [], 1, ["31 $December 2005", '31', $December, '2005']], [ "1 $Feb 2005", "dmy4", [], 1, [ "1 $Feb 2005", '1', $Feb, '2005']], [ "2 $Mar 2005", "dmy4", [], 1, [ "2 $Mar 2005", '2', $Mar, '2005']], ["09 $Apr 2005", "dmy4", [], 1, ["09 $Apr 2005", '09', $Apr, '2005']], [ "9 $MayFull 2005", "dmy4", [], 1, [ "9 $MayFull 2005", '9', $MayFull, '2005']], ["10 $Jun 2005", "dmy4", [], 1, ["10 $Jun 2005", '10', $Jun, '2005']], ["11 $Jul 2005", "dmy4", [], 1, ["11 $Jul 2005", '11', $Jul, '2005']], ["19 $Aug 2005", "dmy4", [], 1, ["19 $Aug 2005", '19', $Aug, '2005']], ["20 $Sep 2005", "dmy4", [], 1, ["20 $Sep 2005", '20', $Sep, '2005']], ["21 $Oct 2005", "dmy4", [], 1, ["21 $Oct 2005", '21', $Oct, '2005']], ["30 $Nov 2005", "dmy4", [], 1, ["30 $Nov 2005", '30', $Nov, '2005']], ["31 $Dec 2005", "dmy4", [], 1, ["31 $Dec 2005", '31', $Dec, '2005']], # Case insensitivity ["01 \L$Jan 2005", "dmy4", [], 1, ["01 \L$Jan 2005", '01', lc($Jan), '2005']], ["01 \U\l$Jan 2005", "dmy4", [], 1, ["01 \U\l$Jan 2005", '01', lcfirst(uc($Jan)), '2005']], # Alternate separators ["01:$Jan:2005", "dmy4", [], 0, ], ["01-$Jan-2005", "dmy4", [], 1, ["01-$Jan-2005", '01', $Jan, '2005']], ["01.$Jan.2005", "dmy4", [], 1, ["01.$Jan.2005", '01', $Jan, '2005']], # Schmutz before/after the date ["01 blah$Jan 2005", "dmy4", [], 0, ], ["01 $Jan 2005blah", "dmy4", [], 1, ["01 $Jan 2005", '01', $Jan, '2005']], # Bad separator ["01 $Jan 2005", "dmy4", [], 0, ], # Bad day ["00 $Jan 2005", "dmy4", [], 0, ], [ "0 $Jan 2005", "dmy4", [], 0, ], ["32 $Jan 2005", "dmy4", [], 0, ], ["40 $Jan 2005", "dmy4", [], 0, ], ["99 $Jan 2005", "dmy4", [], 0, ], # month name tests # Basic test case ["01 $Jan 2005", "dmy2", [], 1, ["01 $Jan 20", '01', $Jan, '20']], # 2-digit year ["01 $Jan 05", "dmy2", [], 1, ["01 $Jan 05", '01', $Jan, '05']], # odd number of digits in year [ "01 $Jan 9", "dmy2", [], 0, ], [ "01 $Jan 120", "dmy2", [], 1, ["01 $Jan 12", '01', $Jan, '12']], # Leading/trailing junk ["abc01 $Jan 05", "dmy2", [], 1, ["01 $Jan 05", '01', $Jan, '05']], ["01 $Jan 05xyz", "dmy2", [], 1, ["01 $Jan 05", '01', $Jan, '05']], ["001 $Jan 05", "dmy2", [], 0, ], ["01 $Jan 050", "dmy2", [], 1, ["01 $Jan 05", '01', $Jan, '05']], # Name spelled out ["01 $January 05", "dmy2", [], 1, ["01 $January 05", '01', $January, '05']], # Partial name should fail ["01 ${Jan}u 05", "dmy2", [], 0, ], # All twelve names (and abbreviations) Also valid day formats. [ "1 $February 05", "dmy2", [], 1, [ "1 $February 05", '1', $February, '05']], [ "2 $March 05", "dmy2", [], 1, [ "2 $March 05", '2', $March, '05']], ["09 $April 05", "dmy2", [], 1, ["09 $April 05", '09', $April, '05']], [ "9 $MayFull 05", "dmy2", [], 1, [ "9 $MayFull 05", '9', $MayFull, '05']], ["10 $June 05", "dmy2", [], 1, ["10 $June 05", '10', $June, '05']], ["11 $July 05", "dmy2", [], 1, ["11 $July 05", '11', $July, '05']], ["19 $August 05", "dmy2", [], 1, ["19 $August 05", '19', $August, '05']], ["20 $September 05", "dmy2", [], 1, ["20 $September 05", '20', $September, '05']], ["21 $October 05", "dmy2", [], 1, ["21 $October 05", '21', $October, '05']], ["30 $November 05", "dmy2", [], 1, ["30 $November 05", '30', $November, '05']], ["31 $December 05", "dmy2", [], 1, ["31 $December 05", '31', $December, '05']], [ "1 $Feb 05", "dmy2", [], 1, [ "1 $Feb 05", '1', $Feb, '05']], [ "2 $Mar 05", "dmy2", [], 1, [ "2 $Mar 05", '2', $Mar, '05']], ["09 $Apr 05", "dmy2", [], 1, ["09 $Apr 05", '09', $Apr, '05']], [ "9 $MayFull 05", "dmy2", [], 1, [ "9 $MayFull 05", '9', $MayFull, '05']], ["10 $Jun 05", "dmy2", [], 1, ["10 $Jun 05", '10', $Jun, '05']], ["11 $Jul 05", "dmy2", [], 1, ["11 $Jul 05", '11', $Jul, '05']], ["19 $Aug 05", "dmy2", [], 1, ["19 $Aug 05", '19', $Aug, '05']], ["20 $Sep 05", "dmy2", [], 1, ["20 $Sep 05", '20', $Sep, '05']], ["21 $Oct 05", "dmy2", [], 1, ["21 $Oct 05", '21', $Oct, '05']], ["30 $Nov 05", "dmy2", [], 1, ["30 $Nov 05", '30', $Nov, '05']], ["31 $Dec 05", "dmy2", [], 1, ["31 $Dec 05", '31', $Dec, '05']], # Case insensitivity ["01 \L$Jan 05", "dmy2", [], 1, ["01 \L$Jan 05", '01', lc($Jan), '05']], ["01 \U\l$Jan 05", "dmy2", [], 1, ["01 \U\l$Jan 05", '01', lcfirst(uc($Jan)), '05']], # Alternate separators ["01:$Jan:05", "dmy2", [], 0, ], ["01-$Jan-05", "dmy2", [], 1, ["01-$Jan-05", '01', $Jan, '05']], ["01.$Jan.05", "dmy2", [], 1, ["01.$Jan.05", '01', $Jan, '05']], # Schmutz before/after the date ["01 blah$Jan 05", "dmy2", [], 0, ], ["01 $Jan 05blah", "dmy2", [], 1, ["01 $Jan 05", '01', $Jan, '05']], # Bad separator ["01 $Jan 05", "dmy2", [], 0, ], # Bad day ["00 $Jan 05", "dmy2", [], 0, ], [ "0 $Jan 05", "dmy2", [], 0, ], ["32 $Jan 05", "dmy2", [], 0, ], ["40 $Jan 05", "dmy2", [], 0, ], ["99 $Jan 05", "dmy2", [], 0, ], ); # DMY is an exact synonym for d2m2y4 my @DMY = grep { $_->[1] eq 'd2m2y4' } @match; $_->[1] = 'DMY' for @DMY; push @match, @DMY; # How many matches will succeed? my $to_succeed = scalar grep $_->[3], @match; # Run two tests per match, plus two additional per expected success $num_tests = 2 * scalar(@match) + 2 * $to_succeed; # Plus one for the 'use_ok' call $num_tests += 1; } use Test::More tests => $num_tests; use_ok('Regexp::Common', 'time'); foreach my $match (@match) { my ($text, $name, $flags, $should_succeed, $matchvars) = @$match; my $testname = qq{"$text" =~ "$name"}; my $did_succeed; my @captures; # Regexp captures # FIRST: check whether it succeeded or failed as expected. # 'keep' option is OFF; should be no captures. if (@$flags) { my $flags = join $; => @$flags; @captures = $text =~ /$RE{time}{$name}{$flags}/; } else { @captures = $text =~ /$RE{time}{$name}/; } $did_succeed = @captures > 0; my $ought = $should_succeed? 'match' : 'fail'; my $actual = $did_succeed == $should_succeed? "${ought}ed" : "did not $ought"; # TEST 1: simple matching ok ( ($should_succeed && $did_succeed) || (!$should_succeed && !$did_succeed), "$testname - $actual as expected (nokeep)."); # TEST 2: Shouldn't capture anything if ($should_succeed) { SKIP: { skip "$testname - can't check captures since match unsuccessful", 1 if !$did_succeed; is_deeply(\@captures, [1], "$testname - didn't unduly capture"); } } # SECOND: use 'keep' option to check captures. if (@$flags) { my $flags = join $; => @$flags; @captures = $text =~ /$RE{time}{$name}{$flags}{-keep}/; } else { @captures = $text =~ /$RE{time}{$name}{-keep}/; } $did_succeed = @captures > 0; # TEST 3: matching with 'keep' ok ( ($should_succeed && $did_succeed) || (!$should_succeed && !$did_succeed), "$testname - $actual as expected (keep)."); # TEST 4: capture variables should be set. if ($should_succeed) { SKIP: { skip "$testname - can't check captures since match unsuccessful", 1 if !$did_succeed; is_deeply(\@captures, $matchvars, "$testname - correct capture variables"); } } } Regexp-Common-time-0.05/t/doc.t000444001750001750 763312243100275 15760 0ustar00gaborgabor000000000000use Test::More tests => 20; # Must test all examples in the documentation, # so as to be sure we're not lying to the poor user. sub begins_with { my ($got, $exp) = @_; my $ok = substr($got,0,length $exp) eq $exp; if (!$ok) { diag "expected '$exp...'\n", " got '$got'\n"; } return $ok; } use_ok('Regexp::Common', 'time'); # Get day/month names in current locale my ($November, $Thu); eval { require I18N::Langinfo; I18N::Langinfo->import(qw(langinfo MON_11 ABDAY_5)); ($November, $Thu) = map langinfo($_), (MON_11(), ABDAY_5()); }; if ($@) { ($November, $Thu) = qw(November Thu); } my ($record, $time); my ($year, $month, $day, $h24, $h12, $min, $sec, $ampm); my (@date_data, @time_data); my $pass = 1; my $str; my $result; my @result; # Time::Format pattern example 1 $str = "$Thu $November 2, 2005"; eval {@result = $str =~ $RE{time}{tf}{-pat => 'Day Month d, yyyy'}{-keep}}; is ($@, q{}, 'Time::Format example 1, no error'); is_deeply (\@result, [$str, $Thu, $November, 2, 2005], 'Time::Format example 1, expected values'); # Time::Format pattern example 2 eval {@result = $str =~ $RE{time}{tf}{-pat => '(Weekday|Day) (Month|Mon) d, yyyy'}{-keep}}; is ($@, q{}, 'Time::Format example 2, no error'); is_deeply (\@result, [$Thu, $November], 'Time::Format example 2, expected values'); # strftime pattern example 1 $str = "$Thu $November 2, 2005"; @result = eval {$str =~ $RE{time}{strftime}{-pat => '%a %B %_d, %Y'}{-keep}}; is ($@, q{}, 'strftime example 1, no error'); is_deeply (\@result, [$str, $Thu, $November, 2, 2005], 'strftime example 1, expected values'); # strftime pattern example 2 $str = "$Thu $November 2, 2005"; eval {@result = $str =~ $RE{time}{strftime}{-pat => '(%A|%a)? (%B|%b) ?%_d, %Y'}{-keep}}; is ($@, q{}, 'strftime example 2, no error'); is_deeply (\@result, [$Thu, $November], 'strftime example 2, expected values'); # Typical usage: parsing a data record. # $rec = "blah blah 2005/10/21 blah blarrrrrgh"; @date = $rec =~ m{^blah blah $RE{time}{YMD}{-keep}}; ok (scalar @date, 'Fuzzy record parsing matched'); is_deeply (\@date, ['2005/10/21', 2005, 10, 21], 'Fuzzy record parsing, expected results'); @date = $rec =~ m{^blah blah $RE{time}{tf}{-pat=>'yyyy/mm/dd'}{-keep}}; ok (scalar @date, 'TF record parsing matched'); is_deeply (\@date, ['2005/10/21', 2005, 10, 21], 'TF record parsing, expected results'); @date = $rec =~ m{^blah blah $RE{time}{strftime}{-pat=>'%Y/%m/%d'}{-keep}}; ok (scalar @date, 'strftime record parsing matched'); is_deeply (\@date, ['2005/10/21', 2005, 10, 21], 'strftime record parsing, expected results'); # Typical usage: parsing variable-format data. # eval { require Time::Normalize; Time::Normalize->import(); }; my $dont_have_normalize = $@? 1 : 0; SKIP: { skip "Test relies on Time::Normalize, which you don't have", 3 if $dont_have_normalize; my $pass = 1; $record = "10-SEP-2005"; if ( ((undef,$m,$d,$y) = $record =~ /^$RE{time}{mdy}{-keep}/) || ((undef,$d,$m,$y) = $record =~ /^$RE{time}{dmy}{-keep}/) || ((undef,$y,$m,$d) = $record =~ /^$RE{time}{ymd}{-keep}/) ) { eval {($year, $month, $day) = normalize_ymd($y, $m, $d)}; } else # give up { $pass = undef; } is ($@, q{}, 'variable parse: no error'); ok($pass, 'variable parse: matched'); # $day is now 10; $month is now 09; $year is now 2005. is_deeply ([$day, $month, $year], [10, '09', 2005], 'variable parse: worked'); } # Time examples # $time = '9:10pm'; @time_data = $time =~ /$RE{time}{hms}{-keep}/; # captures '9:10pm', '9', ':', '10', undef, 'pm' is_deeply (\@time_data, ['9:10pm', '9', '10', undef, 'pm'], 'Time example 1'); @time_data = $time =~ /$RE{time}{tf}{-pat => '(h):(mm)(:ss)?(am)?'}{-keep}/; # captures '9', '10', undef, 'pm' is_deeply (\@time_data, ['9', '10', undef, 'pm'], 'Time example 2'); Regexp-Common-time-0.05/t/mdy.t000444001750001750 12165512243100275 16045 0ustar00gaborgabor000000000000use strict; use vars qw(@match $num_tests %RE); # Get day/month names in current locale my ($Jan, $Feb, $Mar, $Apr, $May, $Jun, $Jul, $Aug, $Sep, $Oct, $Nov, $Dec); my ($January, $February, $March, $April, $MayFull, $June, $July, $August, $September, $October, $November, $December); BEGIN { eval { require I18N::Langinfo; I18N::Langinfo->import(qw(langinfo MON_1 ABMON_1 MON_2 ABMON_2 MON_3 ABMON_3 MON_4 ABMON_4 MON_5 ABMON_5 MON_6 ABMON_6 MON_7 ABMON_7 MON_8 ABMON_8 MON_9 ABMON_9 MON_10 ABMON_10 MON_11 ABMON_11 MON_12 ABMON_12)); ($Jan, $Feb, $Mar, $Apr, $May, $Jun, $Jul, $Aug, $Sep, $Oct, $Nov, $Dec) = map langinfo($_), (ABMON_1(), ABMON_2(), ABMON_3(), ABMON_4(), ABMON_5(), ABMON_6(), ABMON_7(), ABMON_8(), ABMON_9(), ABMON_10(), ABMON_11(), ABMON_12()); ($January, $February, $March, $April, $MayFull, $June, $July, $August, $September, $October, $November, $December) = map langinfo($_), (MON_1(), MON_2(), MON_3(), MON_4(), MON_5(), MON_6(), MON_7(), MON_8(), MON_9(), MON_10(), MON_11(), MON_12()); }; if ($@) { ($Jan, $Feb, $Mar, $Apr, $May, $Jun, $Jul, $Aug, $Sep, $Oct, $Nov, $Dec) = qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec); ($January, $February, $March, $April, $MayFull, $June, $July, $August, $September, $October, $November, $December) = qw(January February March April May June July August September October November December); } @match = ( # mdy tests. ['10/19/2005', 'mdy', [], 1, [qw(10/19/2005 10 19 2005)]], ['10.19.2005', 'mdy', [], 1, [qw(10.19.2005 10 19 2005)]], ['10-19-2005', 'mdy', [], 1, [qw(10-19-2005 10 19 2005)]], ['10x19x2005', 'mdy', [], 0, ], ['10192005', 'mdy', [], 1, [qw(10192005 10 19 2005)]], # leading/trailing junk shouldn't cause the match to change ['abc10/19/2005xyz', 'mdy', [], 1, [qw(10/19/2005 10 19 2005)]], ['abc10.19.2005xyz', 'mdy', [], 1, [qw(10.19.2005 10 19 2005)]], ['abc10-19-2005xyz', 'mdy', [], 1, [qw(10-19-2005 10 19 2005)]], ['abc10x19x2005xyz', 'mdy', [], 0, ], ['abc10192005xyz', 'mdy', [], 1, [qw(10192005 10 19 2005)]], # However, leading digits cause loose m to fail, and trailing digits cause loose y to fail ['010/19/2005', 'mdy', [], 0, ], ['10/19/20050', 'mdy', [], 0, ], ['10/19/050', 'mdy', [], 0, ], # Mismatched or invalid separators ['10/19-2005', 'mdy', [], 0, ], ['10-19.2005', 'mdy', [], 0, ], ['10%19%2005', 'mdy', [], 0, ], # Two-year date should match mdy as well ['10/19/05', 'mdy', [], 1, [qw(10/19/05 10 19 05)]], ['10.19.05', 'mdy', [], 1, [qw(10.19.05 10 19 05)]], ['10-19-05', 'mdy', [], 1, [qw(10-19-05 10 19 05)]], ['10x19x05', 'mdy', [], 0, ], ['101905', 'mdy', [], 1, [qw(101905 10 19 05)]], # one-digit month ['1/19/2005', 'mdy', [], 1, [qw(1/19/2005 1 19 2005)]], ['1.19.2005', 'mdy', [], 1, [qw(1.19.2005 1 19 2005)]], ['1-19-2005', 'mdy', [], 1, [qw(1-19-2005 1 19 2005)]], ['1x19x2005', 'mdy', [], 0, ], ['1192005', 'mdy', [], 0, ], # one-digit day ['10/9/2005', 'mdy', [], 1, [qw(10/9/2005 10 9 2005)]], ['10.9.2005', 'mdy', [], 1, [qw(10.9.2005 10 9 2005)]], ['10-9-2005', 'mdy', [], 1, [qw(10-9-2005 10 9 2005)]], ['10x9x2005', 'mdy', [], 0, ], ['1092005', 'mdy', [], 0, ], # one-digit month and day ['1/9/2005', 'mdy', [], 1, [qw(1/9/2005 1 9 2005)]], ['1.9.2005', 'mdy', [], 1, [qw(1.9.2005 1 9 2005)]], ['1-9-2005', 'mdy', [], 1, [qw(1-9-2005 1 9 2005)]], ['1x9x2005', 'mdy', [], 0, ], ['192005', 'mdy', [], 0, ], # m/dd/yy ['1/19/05', 'mdy', [], 1, [qw(1/19/05 1 19 05)]], ['1.19.05', 'mdy', [], 1, [qw(1.19.05 1 19 05)]], ['1-19-05', 'mdy', [], 1, [qw(1-19-05 1 19 05)]], ['1x19x05', 'mdy', [], 0, ], ['11905', 'mdy', [], 0, ], # mm/d/yy ['10/9/05', 'mdy', [], 1, [qw(10/9/05 10 9 05)]], ['10.9.05', 'mdy', [], 1, [qw(10.9.05 10 9 05)]], ['10-9-05', 'mdy', [], 1, [qw(10-9-05 10 9 05)]], ['10x9x05', 'mdy', [], 0, ], ['10905', 'mdy', [], 0, ], # m/d/yy ['1/9/05', 'mdy', [], 1, [qw(1/9/05 1 9 05)]], ['1.9.05', 'mdy', [], 1, [qw(1.9.05 1 9 05)]], ['1-9-05', 'mdy', [], 1, [qw(1-9-05 1 9 05)]], ['1x9x05', 'mdy', [], 0, ], ['1905', 'mdy', [], 0, ], # Invalid month ['13/19/2005', 'mdy', [], 0, ], ['21/19/2005', 'mdy', [], 0, ], ['0/19/2005', 'mdy', [], 0, ], ['00/19/2005', 'mdy', [], 0, ], # Invalid day ['12/0/2005', 'mdy', [], 0, ], ['12/00/2005', 'mdy', [], 0, ], ['12/40/2005', 'mdy', [], 0, ], ['12/32/2005', 'mdy', [], 0, ], # mdy4 tests. Mostly the same as above. ['10/19/2005', 'mdy4', [], 1, [qw(10/19/2005 10 19 2005)]], ['10.19.2005', 'mdy4', [], 1, [qw(10.19.2005 10 19 2005)]], ['10-19-2005', 'mdy4', [], 1, [qw(10-19-2005 10 19 2005)]], ['10x19x2005', 'mdy4', [], 0, ], ['10192005', 'mdy4', [], 1, [qw(10192005 10 19 2005)]], # leading/trailing junk shouldn't cause the match to change ['abc10/19/2005000', 'mdy4', [], 1, [qw(10/19/2005 10 19 2005)]], ['abc10.19.2005000', 'mdy4', [], 1, [qw(10.19.2005 10 19 2005)]], ['abc10-19-2005xyz', 'mdy4', [], 1, [qw(10-19-2005 10 19 2005)]], ['abc10x19x2005xyz', 'mdy4', [], 0, ], ['abc10192005000', 'mdy4', [], 1, [qw(10192005 10 19 2005)]], # However, leading digits cause loose m to fail ['010/19/2005', 'mdy4', [], 0, ], # Mismatched or invalid separators ['10/19-2005', 'mdy4', [], 0, ], ['10-19.2005', 'mdy4', [], 0, ], ['10%19%2005', 'mdy4', [], 0, ], # Two-year date should not match mdy4 ['10/19/05', 'mdy4', [], 0, ], ['10.19.05', 'mdy4', [], 0, ], ['10-19-05', 'mdy4', [], 0, ], ['10x19x05', 'mdy4', [], 0, ], ['101905', 'mdy4', [], 0, ], # one-digit month ['1/19/2005', 'mdy4', [], 1, [qw(1/19/2005 1 19 2005)]], ['1.19.2005', 'mdy4', [], 1, [qw(1.19.2005 1 19 2005)]], ['1-19-2005', 'mdy4', [], 1, [qw(1-19-2005 1 19 2005)]], ['1x19x2005', 'mdy4', [], 0, ], ['1192005', 'mdy4', [], 0, ], # one-digit day ['10/9/2005', 'mdy4', [], 1, [qw(10/9/2005 10 9 2005)]], ['10.9.2005', 'mdy4', [], 1, [qw(10.9.2005 10 9 2005)]], ['10-9-2005', 'mdy4', [], 1, [qw(10-9-2005 10 9 2005)]], ['10x9x2005', 'mdy4', [], 0, ], ['1092005', 'mdy4', [], 0, ], # one-digit month and day ['1/9/2005', 'mdy4', [], 1, [qw(1/9/2005 1 9 2005)]], ['1.9.2005', 'mdy4', [], 1, [qw(1.9.2005 1 9 2005)]], ['1-9-2005', 'mdy4', [], 1, [qw(1-9-2005 1 9 2005)]], ['1x9x2005', 'mdy4', [], 0, ], ['192005', 'mdy4', [], 0, ], # m/dd/yy ['1/19/05', 'mdy4', [], 0, ], ['1.19.05', 'mdy4', [], 0, ], ['1-19-05', 'mdy4', [], 0, ], ['1x19x05', 'mdy4', [], 0, ], ['11905', 'mdy4', [], 0, ], ['11905', 'mdy4', [], 0, ], # mm/d/yy ['10/9/05', 'mdy4', [], 0, ], ['10.9.05', 'mdy4', [], 0, ], ['10-9-05', 'mdy4', [], 0, ], ['10x9x05', 'mdy4', [], 0, ], ['10905', 'mdy4', [], 0, ], # m/d/yy ['1/9/05', 'mdy4', [], 0, ], ['1.9.05', 'mdy4', [], 0, ], ['1-9-05', 'mdy4', [], 0, ], ['1x9x05', 'mdy4', [], 0, ], ['1905', 'mdy4', [], 0, ], # Invalid month ['13/19/2005', 'mdy4', [], 0, ], ['21/19/2005', 'mdy4', [], 0, ], ['0/19/2005', 'mdy4', [], 0, ], ['00/19/2005', 'mdy4', [], 0, ], # Invalid day ['12/0/2005', 'mdy4', [], 0, ], ['12/00/2005', 'mdy4', [], 0, ], ['12/40/2005', 'mdy4', [], 0, ], ['12/32/2005', 'mdy4', [], 0, ], # mdy2 tests ['10/19/2005', 'mdy2', [], 1, [qw(10/19/20 10 19 20)]], ['10.19.2005', 'mdy2', [], 1, [qw(10.19.20 10 19 20)]], ['10-19-2005', 'mdy2', [], 1, [qw(10-19-20 10 19 20)]], ['10x19x2005', 'mdy2', [], 0, ], ['10192005', 'mdy2', [], 1, [qw(101920 10 19 20)]], # leading/trailing junk shouldn't cause the match to change ['abc10/19/2005000', 'mdy2', [], 1, [qw(10/19/20 10 19 20)]], ['abc10.19.2005000', 'mdy2', [], 1, [qw(10.19.20 10 19 20)]], ['abc10-19-20vwxyz', 'mdy2', [], 1, [qw(10-19-20 10 19 20)]], ['abc10x19x20vwxyz', 'mdy2', [], 0, ], ['abc10192005000', 'mdy2', [], 1, [qw(101920 10 19 20)]], # However, leading digits cause loose m to fail ['910/19/2005000', 'mdy2', [], 0, ], # Mismatched or invalid separators ['10/19-05', 'mdy2', [], 0, ], ['10-19.05', 'mdy2', [], 0, ], ['10%19%05', 'mdy2', [], 0, ], # Two-year date should match ['10/19/05', 'mdy2', [], 1, [qw(10/19/05 10 19 05)]], ['10.19.05', 'mdy2', [], 1, [qw(10.19.05 10 19 05)]], ['10-19-05', 'mdy2', [], 1, [qw(10-19-05 10 19 05)]], ['10x19x05', 'mdy2', [], 0, ], ['101905', 'mdy2', [], 1, [qw(101905 10 19 05)]], # one-digit month ['1/19/2005', 'mdy2', [], 1, [qw(1/19/20 1 19 20)]], ['1.19.2005', 'mdy2', [], 1, [qw(1.19.20 1 19 20)]], ['1-19-2005', 'mdy2', [], 1, [qw(1-19-20 1 19 20)]], ['1x19x2005', 'mdy2', [], 0, ], ['1192005', 'mdy2', [], 0, ], # one-digit day ['10/9/2005', 'mdy2', [], 1, [qw(10/9/20 10 9 20)]], ['10.9.2005', 'mdy2', [], 1, [qw(10.9.20 10 9 20)]], ['10-9-2005', 'mdy2', [], 1, [qw(10-9-20 10 9 20)]], ['10x9x2005', 'mdy2', [], 0, ], ['1092005', 'mdy2', [], 0, ], # one-digit month and day ['1/9/2005', 'mdy2', [], 1, [qw(1/9/20 1 9 20)]], ['1.9.2005', 'mdy2', [], 1, [qw(1.9.20 1 9 20)]], ['1-9-2005', 'mdy2', [], 1, [qw(1-9-20 1 9 20)]], ['1x9x2005', 'mdy2', [], 0, ], ['192005', 'mdy2', [], 0, ], # m/dd/yy ['1/19/05', 'mdy2', [], 1, [qw(1/19/05 1 19 05)]], ['1.19.05', 'mdy2', [], 1, [qw(1.19.05 1 19 05)]], ['1-19-05', 'mdy2', [], 1, [qw(1-19-05 1 19 05)]], ['1x19x05', 'mdy2', [], 0, ], ['11905', 'mdy2', [], 0, ], # mm/d/yy ['10/9/05', 'mdy2', [], 1, [qw(10/9/05 10 9 05)]], ['10.9.05', 'mdy2', [], 1, [qw(10.9.05 10 9 05)]], ['10-9-05', 'mdy2', [], 1, [qw(10-9-05 10 9 05)]], ['10x9x05', 'mdy2', [], 0, ], ['10905', 'mdy2', [], 0, ], # m/d/yy ['1/9/05', 'mdy2', [], 1, [qw(1/9/05 1 9 05)]], ['1.9.05', 'mdy2', [], 1, [qw(1.9.05 1 9 05)]], ['1-9-05', 'mdy2', [], 1, [qw(1-9-05 1 9 05)]], ['1x9x05', 'mdy2', [], 0, ], ['1905', 'mdy2', [], 0, ], # Invalid month ['13/19/05', 'mdy2', [], 0, ], ['21/19/05', 'mdy2', [], 0, ], ['0/19/05', 'mdy2', [], 0, ], ['00/19/05', 'mdy2', [], 0, ], # Invalid day ['12/0/05', 'mdy2', [], 0, ], ['12/00/05', 'mdy2', [], 0, ], ['12/40/05', 'mdy2', [], 0, ], ['12/32/05', 'mdy2', [], 0, ], # m2d2y4 tests ['10/19/2005', 'm2d2y4', [], 1, [qw(10/19/2005 10 19 2005)]], ['10.19.2005', 'm2d2y4', [], 1, [qw(10.19.2005 10 19 2005)]], ['10-19-2005', 'm2d2y4', [], 1, [qw(10-19-2005 10 19 2005)]], ['10x19x2005', 'm2d2y4', [], 0, ], ['10192005', 'm2d2y4', [], 1, [qw(10192005 10 19 2005)]], # leading/trailing junk shouldn't cause the match to change ['abc10/19/2005000', 'm2d2y4', [], 1, [qw(10/19/2005 10 19 2005)]], ['abc10.19.2005000', 'm2d2y4', [], 1, [qw(10.19.2005 10 19 2005)]], ['00010-19-2005000', 'm2d2y4', [], 1, [qw(10-19-2005 10 19 2005)]], ['abc10x19x2005000', 'm2d2y4', [], 0, ], ['10192005000', 'm2d2y4', [], 1, [qw(10192005 10 19 2005)]], # Mismatched or invalid separators ['10/19-2005', 'm2d2y4', [], 0, ], ['10-19.2005', 'm2d2y4', [], 0, ], ['10%19%2005', 'm2d2y4', [], 0, ], # Two-year date should not match ['10/19/05', 'm2d2y4', [], 0, ], ['10.19.05', 'm2d2y4', [], 0, ], ['10-19-05', 'm2d2y4', [], 0, ], ['10x19x05', 'm2d2y4', [], 0, ], ['101905', 'm2d2y4', [], 0, ], # one-digit month ['1/19/2005', 'm2d2y4', [], 0, ], ['1.19.2005', 'm2d2y4', [], 0, ], ['1-19-2005', 'm2d2y4', [], 0, ], ['1x19x2005', 'm2d2y4', [], 0, ], ['1192005', 'm2d2y4', [], 0, ], # one-digit day ['10/9/2005', 'm2d2y4', [], 0, ], ['10.9.2005', 'm2d2y4', [], 0, ], ['10-9-2005', 'm2d2y4', [], 0, ], ['10x9x2005', 'm2d2y4', [], 0, ], ['1092005', 'm2d2y4', [], 0, ], # one-digit month and day ['1/9/2005', 'm2d2y4', [], 0, ], ['1.9.2005', 'm2d2y4', [], 0, ], ['1-9-2005', 'm2d2y4', [], 0, ], ['1x9x2005', 'm2d2y4', [], 0, ], ['192005', 'm2d2y4', [], 0, ], # m/dd/yy ['1/19/05', 'm2d2y4', [], 0, ], ['1.19.05', 'm2d2y4', [], 0, ], ['1-19-05', 'm2d2y4', [], 0, ], ['1x19x05', 'm2d2y4', [], 0, ], ['11905', 'm2d2y4', [], 0, ], # mm/d/yy ['10/9/05', 'm2d2y4', [], 0, ], ['10.9.05', 'm2d2y4', [], 0, ], ['10-9-05', 'm2d2y4', [], 0, ], ['10x9x05', 'm2d2y4', [], 0, ], ['10905', 'm2d2y4', [], 0, ], # m/d/yy ['1/9/05', 'm2d2y4', [], 0, ], ['1.9.05', 'm2d2y4', [], 0, ], ['1-9-05', 'm2d2y4', [], 0, ], ['1x9x05', 'm2d2y4', [], 0, ], ['1905', 'm2d2y4', [], 0, ], # Invalid month ['13/19/2005', 'm2d2y4', [], 0, ], ['21/19/2005', 'm2d2y4', [], 0, ], ['0/19/2005', 'm2d2y4', [], 0, ], ['00/19/2005', 'm2d2y4', [], 0, ], # Invalid day ['12/0/2005', 'm2d2y4', [], 0, ], ['12/00/2005', 'm2d2y4', [], 0, ], ['12/40/2005', 'm2d2y4', [], 0, ], ['12/32/2005', 'm2d2y4', [], 0, ], # m2d2y2 tests ['10/19/2005', 'm2d2y2', [], 1, [qw(10/19/20 10 19 20)]], ['10.19.2005', 'm2d2y2', [], 1, [qw(10.19.20 10 19 20)]], ['10-19-2005', 'm2d2y2', [], 1, [qw(10-19-20 10 19 20)]], ['10x19x2005', 'm2d2y2', [], 0, ], ['10192005', 'm2d2y2', [], 1, [qw(101920 10 19 20)]], # leading/trailing junk shouldn't cause the match to change ['abc10/19/2005000', 'm2d2y2', [], 1, [qw(10/19/20 10 19 20)]], ['abc10.19.2005000', 'm2d2y2', [], 1, [qw(10.19.20 10 19 20)]], ['00010-19-2005000', 'm2d2y2', [], 1, [qw(10-19-20 10 19 20)]], ['abc10x19x2005000', 'm2d2y2', [], 0, ], ['abc10192005000', 'm2d2y2', [], 1, [qw(101920 10 19 20)]], # Mismatched or invalid separators ['10/19-05', 'm2d2y2', [], 0, ], ['10-19.05', 'm2d2y2', [], 0, ], ['10%19%05', 'm2d2y2', [], 0, ], # Two-year date should match ['10/19/05', 'm2d2y2', [], 1, [qw(10/19/05 10 19 05)]], ['10.19.05', 'm2d2y2', [], 1, [qw(10.19.05 10 19 05)]], ['10-19-05', 'm2d2y2', [], 1, [qw(10-19-05 10 19 05)]], ['10x19x05', 'm2d2y2', [], 0, ], ['101905', 'm2d2y2', [], 1, [qw(101905 10 19 05)]], # one-digit month ['1/19/2005', 'm2d2y2', [], 0, ], ['1.19.2005', 'm2d2y2', [], 0, ], ['1-19-2005', 'm2d2y2', [], 0, ], ['1x19x2005', 'm2d2y2', [], 0, ], ['1192005', 'm2d2y2', [], 0, ], # one-digit day ['10/9/2005', 'm2d2y2', [], 0, ], ['10.9.2005', 'm2d2y2', [], 0, ], ['10-9-2005', 'm2d2y2', [], 0, ], ['10x9x2005', 'm2d2y2', [], 0, ], ['1092005', 'm2d2y2', [], 1, [qw(092005 09 20 05)]], # one-digit month and day ['1/9/2005', 'm2d2y2', [], 0, ], ['1.9.2005', 'm2d2y2', [], 0, ], ['1-9-2005', 'm2d2y2', [], 0, ], ['1x9x2005', 'm2d2y2', [], 0, ], ['192005', 'm2d2y2', [], 0, ], # m/dd/yy ['1/19/05', 'm2d2y2', [], 0, ], ['1.19.05', 'm2d2y2', [], 0, ], ['1-19-05', 'm2d2y2', [], 0, ], ['1x19x05', 'm2d2y2', [], 0, ], ['11905', 'm2d2y2', [], 0, ], # mm/d/yy ['10/9/05', 'm2d2y2', [], 0, ], ['10.9.05', 'm2d2y2', [], 0, ], ['10-9-05', 'm2d2y2', [], 0, ], ['10x9x05', 'm2d2y2', [], 0, ], ['10905', 'm2d2y2', [], 0, ], # m/d/yy ['1/9/05', 'm2d2y2', [], 0, ], ['1.9.05', 'm2d2y2', [], 0, ], ['1-9-05', 'm2d2y2', [], 0, ], ['1x9x05', 'm2d2y2', [], 0, ], ['1905', 'm2d2y2', [], 0, ], # Invalid month ['13/19/05', 'm2d2y2', [], 0, ], ['21/19/05', 'm2d2y2', [], 0, ], ['0/19/05', 'm2d2y2', [], 0, ], ['00/19/05', 'm2d2y2', [], 0, ], # Invalid day ['12/0/05', 'm2d2y2', [], 0, ], ['12/00/05', 'm2d2y2', [], 0, ], ['12/40/05', 'm2d2y2', [], 0, ], ['12/32/05', 'm2d2y2', [], 0, ], # mdy tests with named month. # Basic test case ["$Jan 01, 2005", "mdy", [], 1, ["$Jan 01, 2005", $Jan, qw( 01 2005)]], # 2-digit year ["$Jan 01, 05", "mdy", [], 1, ["$Jan 01, 05", $Jan, qw( 01 05)]], # No separator ["${Jan}012005", "mdy", [], 1, ["${Jan}012005", $Jan, qw( 01 2005)]], ["${Jan}0105", "mdy", [], 1, ["${Jan}0105", $Jan, qw( 01 05)]], # odd number of digits in year [ "$Jan 01, 9", "mdy", [], 0, ], [ "$Jan 01, 120", "mdy", [], 0, ], ["$Jan 01, 90120", "mdy", [], 0, ], # Name spelled out ["$January 01, 2005", "mdy", [], 1, ["$January 01, 2005", $January, qw( 01 2005)]], # Partial name should fail ["${Jan}u 01, 2005", "mdy", [], 0, ], # All twelve names (and abbreviations) Also valid day formats. ["$February 1, 2005", "mdy", [], 1, ["$February 1, 2005", $February, qw( 1 2005)]], ["$March 2, 2005", "mdy", [], 1, ["$March 2, 2005", $March, qw( 2 2005)]], ["$April 09, 2005", "mdy", [], 1, ["$April 09, 2005", $April, qw( 09 2005)]], ["$MayFull 9, 2005", "mdy", [], 1, ["$MayFull 9, 2005", "$MayFull", qw( 9 2005)]], ["$June 10, 2005", "mdy", [], 1, ["$June 10, 2005", $June, qw( 10 2005)]], ["$July 11, 2005", "mdy", [], 1, ["$July 11, 2005", $July, qw( 11 2005)]], ["$August 19, 2005", "mdy", [], 1, ["$August 19, 2005", $August, qw( 19 2005)]], ["$September 20, 2005", "mdy", [], 1, ["$September 20, 2005", $September, qw( 20 2005)]], ["$October 21, 2005", "mdy", [], 1, ["$October 21, 2005", $October, qw( 21 2005)]], ["$November 30, 2005", "mdy", [], 1, ["$November 30, 2005", $November, qw( 30 2005)]], ["$December 31, 2005", "mdy", [], 1, ["$December 31, 2005", $December, qw( 31 2005)]], ["$Feb 1, 2005", "mdy", [], 1, ["$Feb 1, 2005", $Feb, qw( 1 2005)]], ["$Mar 2, 2005", "mdy", [], 1, ["$Mar 2, 2005", $Mar, qw( 2 2005)]], ["$Apr 09, 2005", "mdy", [], 1, ["$Apr 09, 2005", $Apr, qw( 09 2005)]], ["$May 9, 2005", "mdy", [], 1, ["$May 9, 2005", $May, qw( 9 2005)]], ["$Jun 10, 2005", "mdy", [], 1, ["$Jun 10, 2005", $Jun, qw( 10 2005)]], ["$Jul 11, 2005", "mdy", [], 1, ["$Jul 11, 2005", $Jul, qw( 11 2005)]], ["$Aug 19, 2005", "mdy", [], 1, ["$Aug 19, 2005", $Aug, qw( 19 2005)]], ["$Sep 20, 2005", "mdy", [], 1, ["$Sep 20, 2005", $Sep, qw( 20 2005)]], ["$Oct 21, 2005", "mdy", [], 1, ["$Oct 21, 2005", $Oct, qw( 21 2005)]], ["$Nov 30, 2005", "mdy", [], 1, ["$Nov 30, 2005", $Nov, qw( 30 2005)]], ["$Dec 31, 2005", "mdy", [], 1, ["$Dec 31, 2005", $Dec, qw( 31 2005)]], # Case insensitivity ["\L$Jan 01, 2005", "mdy", [], 1, ["\L$Jan 01, 2005", "\L$Jan", qw( 01 2005)]], ["\U\l$Jan 01, 2005", "mdy", [], 1, ["\U\l$Jan 01, 2005", "\U\l$Jan", qw( 01 2005)]], # Alternate separators ["$Jan 01 ,2005", "mdy", [], 0, ], ["$Jan 01 2005", "mdy", [], 1, ["$Jan 01 2005", $Jan, qw( 01 2005)]], ["$Jan-01-2005", "mdy", [], 1, ["$Jan-01-2005", $Jan, qw( 01 2005)]], # Mismatched or invalid separators ["$Jan/19-2005", "mdy", [], 0, ], ["$Jan-19.2005", "mdy", [], 0, ], ["$Jan%19%2005", "mdy", [], 0, ], ["$Jan-01,-2005", "mdy", [], 0, ], ["$Jan:01,:2005", "mdy", [], 0, ], # Schmutz before/after the date ["blah$Jan 01, 2005", "mdy", [], 1, ["$Jan 01, 2005", $Jan, qw( 01 2005)]], ["$Jan 01, 2005blah", "mdy", [], 1, ["$Jan 01, 2005", $Jan, qw( 01 2005)]], # Bad day ["$Jan 00, 2005", "mdy", [], 0, ], ["$Jan 0, 2005", "mdy", [], 0, ], ["$Jan 32, 2005", "mdy", [], 0, ], ["$Jan 40, 2005", "mdy", [], 0, ], ["$Jan 99, 2005", "mdy", [], 0, ], # mdy4 tests with named month. # Basic test case ["$Jan 01, 2005", "mdy4", [], 1, ["$Jan 01, 2005", $Jan, qw( 01 2005)]], # 2-digit year ["$Jan 01, 05", "mdy4", [], 0, ], # No separator ["${Jan}012005", "mdy4", [], 1, ["${Jan}012005", $Jan, qw( 01 2005)]], ["${Jan}0105", "mdy4", [], 0, ], # odd number of digits in year [ "$Jan 01, 9", "mdy4", [], 0, ], [ "$Jan 01, 120", "mdy4", [], 0, ], ["$Jan 01, 90120", "mdy4", [], 1, ["$Jan 01, 9012", $Jan, qw( 01 9012)]], # Name spelled out ["$January 01, 2005", "mdy4", [], 1, ["$January 01, 2005", $January, qw( 01 2005)]], # Partial name should fail ["${Jan}u 01, 2005", "mdy4", [], 0, ], # All twelve names (and abbreviations) Also valid day formats. ["$February 1, 2005", "mdy4", [], 1, ["$February 1, 2005", $February, qw( 1 2005)]], ["$March 2, 2005", "mdy4", [], 1, ["$March 2, 2005", $March, qw( 2 2005)]], ["$April 09, 2005", "mdy4", [], 1, ["$April 09, 2005", $April, qw( 09 2005)]], ["$MayFull 9, 2005", "mdy4", [], 1, ["$MayFull 9, 2005", "$MayFull", qw( 9 2005)]], ["$June 10, 2005", "mdy4", [], 1, ["$June 10, 2005", $June, qw( 10 2005)]], ["$July 11, 2005", "mdy4", [], 1, ["$July 11, 2005", $July, qw( 11 2005)]], ["$August 19, 2005", "mdy4", [], 1, ["$August 19, 2005", $August, qw( 19 2005)]], ["$September 20, 2005", "mdy4", [], 1, ["$September 20, 2005", $September, qw( 20 2005)]], ["$October 21, 2005", "mdy4", [], 1, ["$October 21, 2005", $October, qw( 21 2005)]], ["$November 30, 2005", "mdy4", [], 1, ["$November 30, 2005", $November, qw( 30 2005)]], ["$December 31, 2005", "mdy4", [], 1, ["$December 31, 2005", $December, qw( 31 2005)]], ["$Feb 1, 2005", "mdy4", [], 1, ["$Feb 1, 2005", $Feb, qw( 1 2005)]], ["$Mar 2, 2005", "mdy4", [], 1, ["$Mar 2, 2005", $Mar, qw( 2 2005)]], ["$Apr 09, 2005", "mdy4", [], 1, ["$Apr 09, 2005", $Apr, qw( 09 2005)]], ["$May 9, 2005", "mdy4", [], 1, ["$May 9, 2005", $May, qw( 9 2005)]], ["$Jun 10, 2005", "mdy4", [], 1, ["$Jun 10, 2005", $Jun, qw( 10 2005)]], ["$Jul 11, 2005", "mdy4", [], 1, ["$Jul 11, 2005", $Jul, qw( 11 2005)]], ["$Aug 19, 2005", "mdy4", [], 1, ["$Aug 19, 2005", $Aug, qw( 19 2005)]], ["$Sep 20, 2005", "mdy4", [], 1, ["$Sep 20, 2005", $Sep, qw( 20 2005)]], ["$Oct 21, 2005", "mdy4", [], 1, ["$Oct 21, 2005", $Oct, qw( 21 2005)]], ["$Nov 30, 2005", "mdy4", [], 1, ["$Nov 30, 2005", $Nov, qw( 30 2005)]], ["$Dec 31, 2005", "mdy4", [], 1, ["$Dec 31, 2005", $Dec, qw( 31 2005)]], # Case insensitivity ["\L$Jan 01, 2005", "mdy4", [], 1, ["\L$Jan 01, 2005", "\L$Jan", qw( 01 2005)]], ["\U\l$Jan 01, 2005", "mdy4", [], 1, ["\U\l$Jan 01, 2005", "\U\l$Jan", qw( 01 2005)]], # Alternate separators ["$Jan 01 ,2005", "mdy4", [], 0, ], ["$Jan 01 2005", "mdy4", [], 1, ["$Jan 01 2005", $Jan, qw( 01 2005)]], ["$Jan-01-2005", "mdy4", [], 1, ["$Jan-01-2005", $Jan, qw( 01 2005)]], # Mismatched or invalid separators ["$Jan/19-2005", "mdy4", [], 0, ], ["$Jan-19.2005", "mdy4", [], 0, ], ["$Jan%19%2005", "mdy4", [], 0, ], ["$Jan-01,-2005", "mdy4", [], 0, ], ["$Jan:01,:2005", "mdy4", [], 0, ], # Schmutz before/after the date ["blah$Jan 01, 2005", "mdy4", [], 1, ["$Jan 01, 2005", $Jan, qw( 01 2005)]], ["$Jan 01, 2005blah", "mdy4", [], 1, ["$Jan 01, 2005", $Jan, qw( 01 2005)]], # Bad day ["$Jan 00, 2005", "mdy4", [], 0, ], ["$Jan 0, 2005", "mdy4", [], 0, ], ["$Jan 32, 2005", "mdy4", [], 0, ], ["$Jan 40, 2005", "mdy4", [], 0, ], ["$Jan 99, 2005", "mdy4", [], 0, ], # mdy2 tests with named month. # Basic test case ["$Jan 01, 2005", "mdy2", [], 1, ["$Jan 01, 20", $Jan, qw( 01 20)]], # 2-digit year ["$Jan 01, 05", "mdy2", [], 1, ["$Jan 01, 05", $Jan, qw( 01 05)]], # No separator ["${Jan}012005", "mdy2", [], 1, ["${Jan}0120", $Jan, qw( 01 20)]], ["${Jan}0105", "mdy2", [], 1, ["${Jan}0105", $Jan, qw( 01 05)]], # odd number of digits in year [ "$Jan 01, 9", "mdy2", [], 0, ], [ "$Jan 01, 120", "mdy2", [], 1, ["$Jan 01, 12", $Jan, qw( 01 12)]], # Name spelled out ["$January 01, 2005", "mdy2", [], 1, ["$January 01, 20", $January, qw( 01 20)]], # Partial name should fail ["${Jan}u 01, 2005", "mdy2", [], 0, ], # All twelve names (and abbreviations) Also valid day formats. ["$February 1, 05", "mdy2", [], 1, ["$February 1, 05", $February, qw( 1 05)]], ["$March 2, 05", "mdy2", [], 1, ["$March 2, 05", $March, qw( 2 05)]], ["$April 09, 05", "mdy2", [], 1, ["$April 09, 05", $April, qw( 09 05)]], ["$MayFull 9, 05", "mdy2", [], 1, ["$MayFull 9, 05", "$MayFull", qw( 9 05)]], ["$June 10, 05", "mdy2", [], 1, ["$June 10, 05", $June, qw( 10 05)]], ["$July 11, 05", "mdy2", [], 1, ["$July 11, 05", $July, qw( 11 05)]], ["$August 19, 05", "mdy2", [], 1, ["$August 19, 05", $August, qw( 19 05)]], ["$September 20, 05", "mdy2", [], 1, ["$September 20, 05", $September, qw( 20 05)]], ["$October 21, 05", "mdy2", [], 1, ["$October 21, 05", $October, qw( 21 05)]], ["$November 30, 05", "mdy2", [], 1, ["$November 30, 05", $November, qw( 30 05)]], ["$December 31, 05", "mdy2", [], 1, ["$December 31, 05", $December, qw( 31 05)]], ["$Feb 1, 05", "mdy2", [], 1, ["$Feb 1, 05", $Feb, qw( 1 05)]], ["$Mar 2, 05", "mdy2", [], 1, ["$Mar 2, 05", $Mar, qw( 2 05)]], ["$Apr 09, 05", "mdy2", [], 1, ["$Apr 09, 05", $Apr, qw( 09 05)]], ["$May 9, 05", "mdy2", [], 1, ["$May 9, 05", $May, qw( 9 05)]], ["$Jun 10, 05", "mdy2", [], 1, ["$Jun 10, 05", $Jun, qw( 10 05)]], ["$Jul 11, 05", "mdy2", [], 1, ["$Jul 11, 05", $Jul, qw( 11 05)]], ["$Aug 19, 05", "mdy2", [], 1, ["$Aug 19, 05", $Aug, qw( 19 05)]], ["$Sep 20, 05", "mdy2", [], 1, ["$Sep 20, 05", $Sep, qw( 20 05)]], ["$Oct 21, 05", "mdy2", [], 1, ["$Oct 21, 05", $Oct, qw( 21 05)]], ["$Nov 30, 05", "mdy2", [], 1, ["$Nov 30, 05", $Nov, qw( 30 05)]], ["$Dec 31, 05", "mdy2", [], 1, ["$Dec 31, 05", $Dec, qw( 31 05)]], # Case insensitivity ["\L$Jan 01, 05", "mdy2", [], 1, ["\L$Jan 01, 05", "\L$Jan", qw( 01 05)]], ["\U\l$Jan 01, 05", "mdy2", [], 1, ["\U\l$Jan 01, 05", "\U\l$Jan", qw( 01 05)]], # Alternate separators ["$Jan 01 ,05", "mdy2", [], 0, ], ["$Jan 01 05", "mdy2", [], 1, ["$Jan 01 05", $Jan, qw( 01 05)]], ["$Jan-01-05", "mdy2", [], 1, ["$Jan-01-05", $Jan, qw( 01 05)]], # Mismatched or invalid separators ["$Jan/19-05", "mdy2", [], 0, ], ["$Jan-19.05", "mdy2", [], 0, ], ["$Jan%19%05", "mdy2", [], 0, ], ["$Jan-01,-05", "mdy2", [], 0, ], ["$Jan:01,:05", "mdy2", [], 0, ], # Schmutz before/after the date ["blah$Jan 01, 05", "mdy2", [], 1, ["$Jan 01, 05", $Jan, qw( 01 05)]], ["$Jan 01, 05blah", "mdy2", [], 1, ["$Jan 01, 05", $Jan, qw( 01 05)]], # Bad day ["$Jan 00, 05", "mdy2", [], 0, ], ["$Jan 0, 05", "mdy2", [], 0, ], ["$Jan 32, 05", "mdy2", [], 0, ], ["$Jan 40, 05", "mdy2", [], 0, ], ["$Jan 99, 05", "mdy2", [], 0, ], # m2d2y4 tests with named month. # Basic test case ["$Jan 01, 2005", "m2d2y4", [], 0, ], # 2-digit year ["$Jan 01, 05", "m2d2y4", [], 0, ], # No separator ["${Jan}012005", "m2d2y4", [], 0, ], ["${Jan}0105", "m2d2y4", [], 0, ], # odd number of digits in year [ "$Jan 01, 9", "m2d2y4", [], 0, ], [ "$Jan 01, 120", "m2d2y4", [], 0, ], ["$Jan 01, 90120", "m2d2y4", [], 0, ], # Name spelled out ["$January 01, 2005", "m2d2y4", [], 0, ], # All twelve names (and abbreviations) Also valid day formats. ["$February 1, 2005", "m2d2y4", [], 0, ], ["$March 2, 2005", "m2d2y4", [], 0, ], ["$April 09, 2005", "m2d2y4", [], 0, ], ["$MayFull 9, 2005", "m2d2y4", [], 0, ], ["$June 10, 2005", "m2d2y4", [], 0, ], ["$July 11, 2005", "m2d2y4", [], 0, ], ["$August 19, 2005", "m2d2y4", [], 0, ], ["$September 20, 2005", "m2d2y4", [], 0, ], ["$October 21, 2005", "m2d2y4", [], 0, ], ["$November 30, 2005", "m2d2y4", [], 0, ], ["$December 31, 2005", "m2d2y4", [], 0, ], ["$Feb 1, 2005", "m2d2y4", [], 0, ], ["$Mar 2, 2005", "m2d2y4", [], 0, ], ["$Apr 09, 2005", "m2d2y4", [], 0, ], ["$May 9, 2005", "m2d2y4", [], 0, ], ["$Jun 10, 2005", "m2d2y4", [], 0, ], ["$Jul 11, 2005", "m2d2y4", [], 0, ], ["$Aug 19, 2005", "m2d2y4", [], 0, ], ["$Sep 20, 2005", "m2d2y4", [], 0, ], ["$Oct 21, 2005", "m2d2y4", [], 0, ], ["$Nov 30, 2005", "m2d2y4", [], 0, ], ["$Dec 31, 2005", "m2d2y4", [], 0, ], # Case insensitivity ["\L$Jan 01, 2005", "m2d2y4", [], 0, ], ["\U\l$Jan 01, 2005", "m2d2y4", [], 0, ], # Alternate separators ["$Jan 01 ,2005", "m2d2y4", [], 0, ], ["$Jan 01 2005", "m2d2y4", [], 0, ], ["$Jan-01-2005", "m2d2y4", [], 0, ], # Mismatched or invalid separators ["$Jan/19-2005", "mdy", [], 0, ], ["$Jan-19.2005", "mdy", [], 0, ], ["$Jan%19%2005", "mdy", [], 0, ], ["$Jan-01,-2005", "mdy", [], 0, ], ["$Jan:01,:2005", "mdy", [], 0, ], # Schmutz before/after the date ["blah$Jan 01, 2005", "m2d2y4", [], 0, ], ["$Jan 01, 2005blah", "m2d2y4", [], 0, ], # Bad day ["$Jan 00, 2005", "m2d2y4", [], 0, ], ["$Jan 0, 2005", "m2d2y4", [], 0, ], ["$Jan 32, 2005", "m2d2y4", [], 0, ], ["$Jan 40, 2005", "m2d2y4", [], 0, ], ["$Jan 99, 2005", "m2d2y4", [], 0, ], # m2d2y2 tests with named month. # Basic test case ["$Jan 01, 2005", "m2d2y2", [], 0, ], # 2-digit year ["$Jan 01, 05", "m2d2y2", [], 0, ], # No separator ["${Jan}012005", "m2d2y2", [], 1, [qw(012005 01 20 05)]], ["${Jan}0105", "m2d2y2", [], 0, ], # odd number of digits in year [ "$Jan 01, 9", "m2d2y2", [], 0, ], [ "$Jan 01, 120", "m2d2y2", [], 0, ], # Name spelled out ["$January 01, 2005", "m2d2y2", [], 0, ], # All twelve names (and abbreviations) Also valid day formats. ["$February 1, 05", "m2d2y2", [], 0, ], ["$March 2, 05", "m2d2y2", [], 0, ], ["$April 09, 05", "m2d2y2", [], 0, ], ["$May 9, 05", "m2d2y2", [], 0, ], ["$June 10, 05", "m2d2y2", [], 0, ], ["$July 11, 05", "m2d2y2", [], 0, ], ["$August 19, 05", "m2d2y2", [], 0, ], ["$September 20, 05", "m2d2y2", [], 0, ], ["$October 21, 05", "m2d2y2", [], 0, ], ["$November 30, 05", "m2d2y2", [], 0, ], ["$December 31, 05", "m2d2y2", [], 0, ], ["$Feb 1, 05", "m2d2y2", [], 0, ], ["$Mar 2, 05", "m2d2y2", [], 0, ], ["$Apr 09, 05", "m2d2y2", [], 0, ], ["$May 9, 05", "m2d2y2", [], 0, ], ["$Jun 10, 05", "m2d2y2", [], 0, ], ["$Jul 11, 05", "m2d2y2", [], 0, ], ["$Aug 19, 05", "m2d2y2", [], 0, ], ["$Sep 20, 05", "m2d2y2", [], 0, ], ["$Oct 21, 05", "m2d2y2", [], 0, ], ["$Nov 30, 05", "m2d2y2", [], 0, ], ["$Dec 31, 05", "m2d2y2", [], 0, ], # Case insensitivity ["\L$Jan 01, 05", "m2d2y2", [], 0, ], ["\U\l$Jan 01, 05", "m2d2y2", [], 0, ], # Alternate separators ["$Jan 01 ,05", "m2d2y2", [], 0, ], ["$Jan 01 05", "m2d2y2", [], 0, ], ["$Jan-01-05", "m2d2y2", [], 0, ], # Mismatched or invalid separators ["$Jan/19-05", "mdy", [], 0, ], ["$Jan-19.05", "mdy", [], 0, ], ["$Jan%19%05", "mdy", [], 0, ], ["$Jan-01,-05", "mdy", [], 0, ], ["$Jan:01,:05", "mdy", [], 0, ], # Schmutz before/after the date ["blah$Jan 01, 05", "m2d2y2", [], 0, ], ["$Jan 01, 05blah", "m2d2y2", [], 0, ], # Bad day ["$Jan 00, 05", "m2d2y2", [], 0, ], ["$Jan 0, 05", "m2d2y2", [], 0, ], ["$Jan 32, 05", "m2d2y2", [], 0, ], ["$Jan 40, 05", "m2d2y2", [], 0, ], ["$Jan 99, 05", "m2d2y2", [], 0, ], ); # MDY is an exact synonym for m2d2y4 my @MDY = grep { $_->[1] eq 'm2d2y4' } @match; $_->[1] = 'MDY' for @MDY; push @match, @MDY; # How many matches will succeed? my $to_succeed = scalar grep $_->[3], @match; # Run two tests per match, plus two additional per expected success $num_tests = 2 * scalar(@match) + 2 * $to_succeed; # Plus one for the 'use_ok' call $num_tests += 1; } use Test::More tests => $num_tests; use_ok('Regexp::Common', 'time'); foreach my $match (@match) { my ($text, $name, $flags, $should_succeed, $matchvars) = @$match; my $testname = qq{"$text" =~ "$name"}; my $did_succeed; my @captures; # Regexp captures # FIRST: check whether it succeeded or failed as expected. # 'keep' option is OFF; should be no captures. if (@$flags) { my $flags = join $; => @$flags; @captures = $text =~ /$RE{time}{$name}{$flags}/; } else { @captures = $text =~ /$RE{time}{$name}/; } $did_succeed = @captures > 0; my $ought = $should_succeed? 'match' : 'fail'; my $actual = $did_succeed == $should_succeed? "${ought}ed" : "did not $ought"; # TEST 1: simple matching ok ( ($should_succeed && $did_succeed) || (!$should_succeed && !$did_succeed), "$testname - $actual as expected (nokeep)."); # TEST 2: Shouldn't capture anything if ($should_succeed) { SKIP: { skip "$testname - can't check captures since match unsuccessful", 1 if !$did_succeed; is_deeply(\@captures, [1], "$testname - didn't unduly capture"); } } # SECOND: use 'keep' option to check captures. if (@$flags) { my $flags = join $; => @$flags; @captures = $text =~ /$RE{time}{$name}{$flags}{-keep}/; } else { @captures = $text =~ /$RE{time}{$name}{-keep}/; } $did_succeed = @captures > 0; # TEST 3: matching with 'keep' ok ( ($should_succeed && $did_succeed) || (!$should_succeed && !$did_succeed), "$testname - $actual as expected (keep)."); # TEST 4: capture variables should be set. if ($should_succeed) { SKIP: { skip "$testname - can't check captures since match unsuccessful", 1 if !$did_succeed; is_deeply(\@captures, $matchvars, "$testname - correct capture variables"); } } } Regexp-Common-time-0.05/t/1-load.t000444001750001750 10612243100275 16234 0ustar00gaborgabor000000000000 use Test::More tests => 1; BEGIN { use_ok('Regexp::Common::time') }; Regexp-Common-time-0.05/t/strftime.t000444001750001750 5542412243100275 17071 0ustar00gaborgabor000000000000use strict; use vars qw(@match $num_tests %RE); use vars qw(@MONTH @MON @WEEKDAY @DAY); BEGIN { # Man, this locale stuff is a pain. Why can't everyone just speak English?! ;-) # Set defaults: @MONTH = qw(January February March April May June July August September October November December); @MON = qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec); @WEEKDAY = qw(Sunday Monday Tuesday Wednesday Thursday Friday Saturday); @DAY = qw(Sun Mon Tue Wed Thu Fri Sat); eval { require POSIX; require I18N::Langinfo; eval { @MONTH = map I18N::Langinfo::langinfo($_), I18N::Langinfo::MON_1(), I18N::Langinfo::MON_2(), I18N::Langinfo::MON_3(), I18N::Langinfo::MON_4(), I18N::Langinfo::MON_5(), I18N::Langinfo::MON_6(), I18N::Langinfo::MON_7(), I18N::Langinfo::MON_8(), I18N::Langinfo::MON_9(), I18N::Langinfo::MON_10(), I18N::Langinfo::MON_11(), I18N::Langinfo::MON_12(); }; eval { @MON = map I18N::Langinfo::langinfo($_), I18N::Langinfo::ABMON_1(), I18N::Langinfo::ABMON_2(), I18N::Langinfo::ABMON_3(), I18N::Langinfo::ABMON_4(), I18N::Langinfo::ABMON_5(), I18N::Langinfo::ABMON_6(), I18N::Langinfo::ABMON_7(), I18N::Langinfo::ABMON_8(), I18N::Langinfo::ABMON_9(), I18N::Langinfo::ABMON_10(), I18N::Langinfo::ABMON_11(), I18N::Langinfo::ABMON_12(); }; eval { @WEEKDAY = map I18N::Langinfo::langinfo($_), I18N::Langinfo::DAY_1(), I18N::Langinfo::DAY_2(), I18N::Langinfo::DAY_3(), I18N::Langinfo::DAY_4(), I18N::Langinfo::DAY_5(), I18N::Langinfo::DAY_6(), I18N::Langinfo::DAY_7(); }; eval { @DAY = map I18N::Langinfo::langinfo($_), I18N::Langinfo::ABDAY_1(), I18N::Langinfo::ABDAY_2(), I18N::Langinfo::ABDAY_3(), I18N::Langinfo::ABDAY_4(), I18N::Langinfo::ABDAY_5(), I18N::Langinfo::ABDAY_6(), I18N::Langinfo::ABDAY_7(); }; }; # target, pattern, values, name @match = ( # 'a' : abbreviated weekday name [$DAY[0], '\A%a\z', [$DAY[0]], $DAY[0]], [$DAY[1], '\A%a\z', [$DAY[1]], $DAY[1]], [$DAY[2], '\A%a\z', [$DAY[2]], $DAY[2]], [$DAY[3], '\A%a\z', [$DAY[3]], $DAY[3]], [$DAY[4], '\A%a\z', [$DAY[4]], $DAY[4]], [$DAY[5], '\A%a\z', [$DAY[5]], $DAY[5]], [$DAY[6], '\A%a\z', [$DAY[6]], $DAY[6]], ["blah$DAY[1]blah", 'blah%ablah', ["blah$DAY[1]blah", $DAY[1]], 'M=Mon blahs'], ['*&^@#(','\A%a\z', undef, '"a" garbage'], # 'A' : full weekday name [$WEEKDAY[0], '\A%A\z', [$WEEKDAY[0]], $WEEKDAY[0]], [$WEEKDAY[1], '\A%A\z', [$WEEKDAY[1]], $WEEKDAY[1]], [$WEEKDAY[2], '\A%A\z', [$WEEKDAY[2]], $WEEKDAY[2]], [$WEEKDAY[3], '\A%A\z', [$WEEKDAY[3]], $WEEKDAY[3]], [$WEEKDAY[4], '\A%A\z', [$WEEKDAY[4]], $WEEKDAY[4]], [$WEEKDAY[5], '\A%A\z', [$WEEKDAY[5]], $WEEKDAY[5]], [$WEEKDAY[6], '\A%A\z', [$WEEKDAY[6]], $WEEKDAY[6]], ["blah$WEEKDAY[1]blah", 'blah%Ablah', ["blah$WEEKDAY[1]blah", $WEEKDAY[1]], 'M=Monday blahs'], ['*&^@#(', '\A%A\z', undef, '"A" garbage'], # 'b' : abbreviated month name [$MON[ 0], '\A%b\z', [$MON[ 0]], $MON[ 0]], [$MON[ 1], '\A%b\z', [$MON[ 1]], $MON[ 1]], [$MON[ 2], '\A%b\z', [$MON[ 2]], $MON[ 2]], [$MON[ 3], '\A%b\z', [$MON[ 3]], $MON[ 3]], [$MON[ 4], '\A%b\z', [$MON[ 4]], $MON[ 4]], [$MON[ 5], '\A%b\z', [$MON[ 5]], $MON[ 5]], [$MON[ 6], '\A%b\z', [$MON[ 6]], $MON[ 6]], [$MON[ 7], '\A%b\z', [$MON[ 7]], $MON[ 7]], [$MON[ 8], '\A%b\z', [$MON[ 8]], $MON[ 8]], [$MON[ 9], '\A%b\z', [$MON[ 9]], $MON[ 9]], [$MON[10], '\A%b\z', [$MON[10]], $MON[10]], [$MON[11], '\A%b\z', [$MON[11]], $MON[11]], # 'B' : full month name [$MONTH[ 0], '\A%B\z', [$MONTH[ 0]], $MONTH[ 0]], [$MONTH[ 1], '\A%B\z', [$MONTH[ 1]], $MONTH[ 1]], [$MONTH[ 2], '\A%B\z', [$MONTH[ 2]], $MONTH[ 2]], [$MONTH[ 3], '\A%B\z', [$MONTH[ 3]], $MONTH[ 3]], [$MONTH[ 4], '\A%B\z', [$MONTH[ 4]], $MONTH[ 4]], [$MONTH[ 5], '\A%B\z', [$MONTH[ 5]], $MONTH[ 5]], [$MONTH[ 6], '\A%B\z', [$MONTH[ 6]], $MONTH[ 6]], [$MONTH[ 7], '\A%B\z', [$MONTH[ 7]], $MONTH[ 7]], [$MONTH[ 8], '\A%B\z', [$MONTH[ 8]], $MONTH[ 8]], [$MONTH[ 9], '\A%B\z', [$MONTH[ 9]], $MONTH[ 9]], [$MONTH[10], '\A%B\z', [$MONTH[10]], $MONTH[10]], [$MONTH[11], '\A%B\z', [$MONTH[11]], $MONTH[11]], # 'c' : locale-specific format # Not sure how to test this. # 'C' : century ['abcd00', '%C', ['00'], 'Century 00'], ['10' , '\A%C\z', ['10'], 'Century 10'], ['a18', 'a(%C)', ['18'], 'Century 18'], ['(19)', '\(%C\)', ['(19)', 19], 'Century 19'], ['abcd20', '%C\z', ['20'], 'Century 20'], ['a2100', 'a%C', ['a21','21'], 'Century 21'], # 'd' : Day number ['01', '\A%d\z', ['01'], 'Day 01'], ['09', '\A%d\z', ['09'], 'Day 09'], ['10', '\A%d\z', ['10'], 'Day 10'], ['21', '\A%d\z', ['21'], 'Day 21'], ['30', '\A%d\z', ['30'], 'Day 30'], ['31', '\A%d\z', ['31'], 'Day 31'], ['00', '\A%d\z', undef, 'Day 00'], ['32', '\A%d\z', undef, 'Day 32'], ['99', '\A%d\z', undef, 'Day 99'], [' 8', '\A%d\z', undef, 'Day 8'], ['8', '\A%d\z', undef, 'Day 8'], # '_d' : Day number ['01', '\A%_d\z', ['01'], '_d Day 01'], ['09', '\A%_d\z', ['09'], '_d Day 09'], ['10', '\A%_d\z', ['10'], '_d Day 10'], ['21', '\A%_d\z', ['21'], '_d Day 21'], ['30', '\A%_d\z', ['30'], '_d Day 30'], ['31', '\A%_d\z', ['31'], '_d Day 31'], ['00', '\A%_d\z', undef, '_d Day 00'], ['32', '\A%_d\z', undef, '_d Day 32'], ['99', '\A%_d\z', undef, '_d Day 99'], [' 8', '\A%_d\z', undef, '_d Day 8'], ['8', '\A%_d\z', ['8'], '_d Day 8'], ['0', '\A%_d\z', undef, '_d Day 0'], # 'D' : m/d/y ['01/02/03', '%D', ['01/02/03'], '%D 01/02/03'], ['00/02/03', '%D', undef, '%D 00/02/03'], ['13/02/03', '%D', undef, '%D 13/02/03'], ['03/31/03', '%D', ['03/31/03'], '%D 03/31/03'], ['03/32/03', '%D', undef, '%D 03/31/03'], # 'e' : Day number, leading space [' 1', '%e', [' 1'], 'eDay 1'], [' 9', '%e', [' 9'], 'eDay 9'], ['10', '%e', ['10'], 'eDay 10'], ['21', '%e', ['21'], 'eDay 21'], ['30', '%e', ['30'], 'eDay 30'], ['31', '%e', ['31'], 'eDay 31'], [' 0', '%e', undef, 'eDay 0'], ['32', '%e', undef, 'eDay 32'], ['99', '%e', undef, 'eDay 99'], ['08', '%e', undef, 'eDay 08'], # 'h' : same as %b [$MON[ 0], '\A%h\z', [$MON[ 0]], 'hJan'], [$MON[ 1], '\A%h\z', [$MON[ 1]], 'hFeb'], [$MON[ 2], '\A%h\z', [$MON[ 2]], 'hMar'], [$MON[ 3], '\A%h\z', [$MON[ 3]], 'hApr'], [$MON[ 4], '\A%h\z', [$MON[ 4]], 'hMay'], [$MON[ 5], '\A%h\z', [$MON[ 5]], 'hJun'], [$MON[ 6], '\A%h\z', [$MON[ 6]], 'hJul'], [$MON[ 7], '\A%h\z', [$MON[ 7]], 'hAug'], [$MON[ 8], '\A%h\z', [$MON[ 8]], 'hSep'], [$MON[ 9], '\A%h\z', [$MON[ 9]], 'hOct'], [$MON[10], '\A%h\z', [$MON[10]], 'hNov'], [$MON[11], '\A%h\z', [$MON[11]], 'hDec'], # 'H' : hour, 00-23 ['00', '%H', ['00'], 'hour24 00'], ['01', '%H', ['01'], 'hour24 01'], ['10', '%H', ['10'], 'hour24 10'], ['13', '%H', ['13'], 'hour24 13'], ['20', '%H', ['20'], 'hour24 20'], ['23', '%H', ['23'], 'hour24 23'], [' 0', '%H', undef, 'hour24 0'], [' 1', '%H', undef, 'hour24 1'], ['24', '%H', undef, 'hour24 24'], # '_H' : hour, 0-23 ['00', '%_H', ['00'], '_H hour24 00'], ['01', '%_H', ['01'], '_H hour24 01'], ['10', '%_H', ['10'], '_H hour24 10'], ['13', '%_H', ['13'], '_H hour24 13'], ['20', '%_H', ['20'], '_H hour24 20'], ['23', '%_H', ['23'], '_H hour24 23'], [' 0', '\A%_H\z', undef, '_H hour24 0'], [' 1', '\A%_H\z', undef, '_H hour24 1'], ['0', '\A%_H\z', ['0'], '_H hour24 0'], ['1', '\A%_H\z', ['1'], '_H hour24 1'], ['24', '\A%_H\z', undef, '_H hour24 24'], # 'I' : hour, 01-12 ['01', '%I', ['01'], 'hour12 01'], ['10', '%I', ['10'], 'hour12 10'], ['12', '%I', ['12'], 'hour12 12'], ['13', '%I', undef, 'hour12 13'], ['00', '%I', undef, 'hour12 00'], [' 0', '%I', undef, 'hour12 0'], [' 1', '%I', undef, 'hour12 1'], # '_I' : hour, 1-12 ['01', '%_I', ['01'], '_I hour12 01'], ['10', '%_I', ['10'], '_I hour12 10'], ['12', '%_I', ['12'], '_I hour12 12'], ['13', '\A%_I\z', undef, '_I hour12 13'], ['00', '%_I', undef, '_I hour12 00'], [' 0', '\A%_I\z', undef, '_I hour12 0'], [' 1', '\A%_I\z', undef, '_I hour12 1'], ['0', '\A%_I\z', undef, '_I hour12 0'], ['1', '\A%_I\z', ['1'], '_I hour12 1'], # 'j' : day of year, 001-366 ['001', '%j', ['001'], 'doy 001'], ['101', '%j', ['101'], 'doy 101'], ['201', '%j', ['201'], 'doy 201'], ['301', '%j', ['301'], 'doy 301'], ['366', '%j', ['366'], 'doy 366'], ['000', '%j', undef, 'doy 000'], ['367', '%j', undef, 'doy 367'], [' 1', '%j', undef, 'doy 1'], [ '27', '%j', undef, 'doy 27' ], # 'm' : month number, 01-12 ['01', '%m', ['01'], 'month num 01'], ['10', '%m', ['10'], 'month num 10'], ['12', '%m', ['12'], 'month num 12'], ['13', '%m', undef, 'month num 13'], ['00', '%m', undef, 'month num 00'], [' 0', '%m', undef, 'month num 0'], [' 1', '%m', undef, 'month num 1'], # '_m' : month number, 1-12 ['01', '%_m', ['01'], '_m month num 01'], ['10', '%_m', ['10'], '_m month num 10'], ['12', '%_m', ['12'], '_m month num 12'], ['13', '\A%_m\z', undef, '_m month num 13'], ['00', '%_m', undef, '_m month num 00'], [' 0', '\A%_m\z', undef, '_m month num 0'], [' 1', '\A%_m\z', undef, '_m month num 1'], ['0', '\A%_m\z', undef, '_m month num 0'], ['1', '\A%_m\z', ['1'], '_m month num 1'], # 'M' : minute number, 00-59 ['00', '%M', ['00'], 'minute 00'], ['01', '%M', ['01'], 'minute 01'], ['10', '%M', ['10'], 'minute 10'], ['20', '%M', ['20'], 'minute 20'], ['30', '%M', ['30'], 'minute 30'], ['40', '%M', ['40'], 'minute 40'], ['50', '%M', ['50'], 'minute 50'], ['59', '%M', ['59'], 'minute 59'], ['60', '%M', undef, 'minute 60'], [' 0', '%M', undef, 'minute 0'], [ '1', '%M', undef, 'minute 1' ], # '_M' : minute number, 0-59 ['00', '%_M', ['00'], 'minute 00'], ['01', '%_M', ['01'], 'minute 01'], ['10', '%_M', ['10'], 'minute 10'], ['20', '%_M', ['20'], 'minute 20'], ['30', '%_M', ['30'], 'minute 30'], ['40', '%_M', ['40'], 'minute 40'], ['50', '%_M', ['50'], 'minute 50'], ['59', '%_M', ['59'], 'minute 59'], ['60', '\A%_M\z', undef, 'minute 60'], [' 0', '\A%_M\z', undef, 'minute 0'], [' 1', '\A%_M\z', undef, 'minute 1'], ['0', '\A%_M\z', ['0'], 'minute 0' ], ['1', '\A%_M\z', ['1'], 'minute 1' ], # Not sure how to test 'p' or 'r'. # 'R' : hour24:minute ['00:00', '%R', ['00:00'], 'h24:minute 00:00'], ['01:00', '%R', ['01:00'], 'h24:minute 01:00'], ['10:00', '%R', ['10:00'], 'h24:minute 10:00'], ['13:00', '%R', ['13:00'], 'h24:minute 13:00'], ['20:00', '%R', ['20:00'], 'h24:minute 20:00'], ['23:00', '%R', ['23:00'], 'h24:minute 23:00'], [' 0:00', '%R', undef, 'h24:minute 0:00'], [' 1:00', '%R', undef, 'h24:minute 1:00'], ['24:00', '%R', undef, 'h24:minute 24:00'], ['02:00', '%R', ['02:00'], 'h24:minute 02:00'], ['02:01', '%R', ['02:01'], 'h24:minute 02:01'], ['02:10', '%R', ['02:10'], 'h24:minute 02:10'], ['02:20', '%R', ['02:20'], 'h24:minute 02:20'], ['02:30', '%R', ['02:30'], 'h24:minute 02:30'], ['02:40', '%R', ['02:40'], 'h24:minute 02:40'], ['02:50', '%R', ['02:50'], 'h24:minute 02:50'], ['02:59', '%R', ['02:59'], 'h24:minute 02:59'], ['02:60', '%R', undef, 'h24:minute 02:60'], ['02: 0', '%R', undef, 'h24:minute 02: 0'], ['02:1' , '%R', undef, 'h24:minute 02:1' ], # 'S' : second, 00-61 ['00', '%S', ['00'], 'second 00'], ['01', '%S', ['01'], 'second 01'], ['10', '%S', ['10'], 'second 10'], ['20', '%S', ['20'], 'second 20'], ['30', '%S', ['30'], 'second 30'], ['40', '%S', ['40'], 'second 40'], ['50', '%S', ['50'], 'second 50'], ['59', '%S', ['59'], 'second 59'], ['60', '%S', ['60'], 'second 60'], ['61', '%S', ['61'], 'second 61'], ['62', '%S', undef, 'second 62'], [' 0', '%S', undef, 'second 0'], [ '1', '%S', undef, 'second 1' ], # 'T' : H24:M:S ['00:00:00', '%T', ['00:00:00'], 'h24:min:sec 00:00:00'], ['01:00:00', '%T', ['01:00:00'], 'h24:min:sec 01:00:00'], ['10:00:00', '%T', ['10:00:00'], 'h24:min:sec 10:00:00'], ['13:00:00', '%T', ['13:00:00'], 'h24:min:sec 13:00:00'], ['20:00:00', '%T', ['20:00:00'], 'h24:min:sec 20:00:00'], ['23:00:00', '%T', ['23:00:00'], 'h24:min:sec 23:00:00'], [' 0:00:00', '%T', undef, 'h24:min:sec 0:00:00'], [' 1:00:00', '%T', undef, 'h24:min:sec 1:00:00'], ['24:00:00', '%T', undef, 'h24:min:sec 24:00:00'], ['02:00:00', '%T', ['02:00:00'], 'h24:min:sec 02:00:00'], ['02:01:00', '%T', ['02:01:00'], 'h24:min:sec 02:01:00'], ['02:10:00', '%T', ['02:10:00'], 'h24:min:sec 02:10:00'], ['02:20:00', '%T', ['02:20:00'], 'h24:min:sec 02:20:00'], ['02:30:00', '%T', ['02:30:00'], 'h24:min:sec 02:30:00'], ['02:40:00', '%T', ['02:40:00'], 'h24:min:sec 02:40:00'], ['02:50:00', '%T', ['02:50:00'], 'h24:min:sec 02:50:00'], ['02:59:00', '%T', ['02:59:00'], 'h24:min:sec 02:59:00'], ['02:60:00', '%T', undef, 'h24:min:sec 02:60:00'], ['02: 0:00', '%T', undef, 'h24:min:sec 02: 0:00'], ['02:1:00' , '%T', undef, 'h24:min:sec 02:1:00' ], ['13:45:00', '%T', ['13:45:00'], 'h24:min:sec 13:45:00'], ['13:45:01', '%T', ['13:45:01'], 'h24:min:sec 13:45:01'], ['13:45:10', '%T', ['13:45:10'], 'h24:min:sec 13:45:10'], ['13:45:20', '%T', ['13:45:20'], 'h24:min:sec 13:45:20'], ['13:45:30', '%T', ['13:45:30'], 'h24:min:sec 13:45:30'], ['13:45:40', '%T', ['13:45:40'], 'h24:min:sec 13:45:40'], ['13:45:50', '%T', ['13:45:50'], 'h24:min:sec 13:45:50'], ['13:45:59', '%T', ['13:45:59'], 'h24:min:sec 13:45:59'], ['13:45:60', '%T', ['13:45:60'], 'h24:min:sec 13:45:60'], ['13:45:61', '%T', ['13:45:61'], 'h24:min:sec 13:45:61'], ['13:45:62', '%T', undef, 'h24:min:sec 13:45:62'], ['13:45: 0', '%T', undef, 'h24:min:sec 13:45: 0'], ['13:45:1', '%T', undef, 'h24:min:sec 13:45:1' ], # 'u' : Weekday number, 1-7 ['0', '%u', undef, 'wkd1-7 0'], ['1', '%u', ['1'], 'wkd1-7 1'], ['2', '%u', ['2'], 'wkd1-7 2'], ['3', '%u', ['3'], 'wkd1-7 3'], ['4', '%u', ['4'], 'wkd1-7 4'], ['5', '%u', ['5'], 'wkd1-7 5'], ['6', '%u', ['6'], 'wkd1-7 6'], ['7', '%u', ['7'], 'wkd1-7 7'], ['8', '%u', undef, 'wkd1-7 8'], # 'U' : week number, 00-53 ['00', '%U', ['00'], 'week num U 00'], ['01', '%U', ['01'], 'week num U 01'], ['10', '%U', ['10'], 'week num U 10'], ['20', '%U', ['20'], 'week num U 20'], ['30', '%U', ['30'], 'week num U 30'], ['40', '%U', ['40'], 'week num U 40'], ['50', '%U', ['50'], 'week num U 50'], ['51', '%U', ['51'], 'week num U 51'], ['52', '%U', ['52'], 'week num U 52'], ['53', '%U', ['53'], 'week num U 53'], ['54', '%U', undef, 'week num U 54'], [' 0', '%U', undef, 'week num U 0'], [ '1', '%U', undef, 'week num U 1' ], # 'V' : week number, 01-53 ['00', '%V', undef, 'week num V 00'], ['01', '%V', ['01'], 'week num V 01'], ['10', '%V', ['10'], 'week num V 10'], ['20', '%V', ['20'], 'week num V 20'], ['30', '%V', ['30'], 'week num V 30'], ['40', '%V', ['40'], 'week num V 40'], ['50', '%V', ['50'], 'week num V 50'], ['51', '%V', ['51'], 'week num V 51'], ['52', '%V', ['52'], 'week num V 52'], ['53', '%V', ['53'], 'week num V 53'], ['54', '%V', undef, 'week num V 54'], [' 0', '%V', undef, 'week num V 0'], [ '1', '%V', undef, 'week num V 1' ], # 'w' : Weekday number, 1-7 ['', '%w', undef, 'wkd0-6 ""'], ['0', '%w', ['0'], 'wkd0-6 0'], ['1', '%w', ['1'], 'wkd0-6 1'], ['2', '%w', ['2'], 'wkd0-6 2'], ['3', '%w', ['3'], 'wkd0-6 3'], ['4', '%w', ['4'], 'wkd0-6 4'], ['5', '%w', ['5'], 'wkd0-6 5'], ['6', '%w', ['6'], 'wkd0-6 6'], ['7', '%w', undef, 'wkd0-6 7'], # 'W' : week number, 00-53 ['00', '%W', ['00'], 'week num W 00'], ['01', '%W', ['01'], 'week num W 01'], ['10', '%W', ['10'], 'week num W 10'], ['20', '%W', ['20'], 'week num W 20'], ['30', '%W', ['30'], 'week num W 30'], ['40', '%W', ['40'], 'week num W 40'], ['50', '%W', ['50'], 'week num W 50'], ['51', '%W', ['51'], 'week num W 51'], ['52', '%W', ['52'], 'week num W 52'], ['53', '%W', ['53'], 'week num W 53'], ['54', '%W', undef, 'week num W 54'], [' 0', '%W', undef, 'week num W 0'], [ '1', '%W', undef, 'week num W 1' ], # Not sure how to test 'x' or 'X' # 'y' : 2-digit year number ['00', '%y', ['00'], '2-digit year 00'], ['01', '%y', ['01'], '2-digit year 01'], ['90', '%y', ['90'], '2-digit year 90'], ['99', '%y', ['99'], '2-digit year 99'], ['3', '%y', undef, '2-digit year 3'], # 'Y' : 4-digit year number ['0000', '%Y', ['0000'], '4-digit year 0000'], ['1801', '%Y', ['1801'], '4-digit year 1801'], ['1990', '%Y', ['1990'], '4-digit year 1990'], ['2099', '%Y', ['2099'], '4-digit year 2099'], ['30', '%Y', undef, '4-digit year 30'], # TODO: add some mix&match tests here. ); # How many matches will succeed? my $to_succeed = scalar grep $_->[2], @match; # Run two tests per match, plus two additional per expected success $num_tests = 2 * scalar(@match) + 2 * $to_succeed; # Plus one for the 'use_ok' call $num_tests += 1; } use Test::More tests => $num_tests; use_ok('Regexp::Common', 'time'); foreach my $match (@match) { my ($text, $pattern, $matchvars, $testname) = @$match; my $did_succeed; my $should_succeed = defined $matchvars; my @captures; # Regexp captures # FIRST: check whether it succeeded or failed as expected. # 'keep' option is OFF; should be no captures. @captures = $text =~ /$RE{time}{strftime}{-pat=>$pattern}/; $did_succeed = @captures > 0; # TEST 1: simple matching my $ought = $should_succeed? 'match' : 'fail'; my $actual = $did_succeed == $should_succeed? "${ought}ed" : "did not $ought"; ok ( ($should_succeed && $did_succeed) || (!$should_succeed && !$did_succeed), "$testname - $actual as expected (nokeep)."); # TEST 2: Shouldn't capture anything if ($should_succeed) { SKIP: { skip "$testname - can't check captures since match unsuccessful", 1 if !$did_succeed; skip "$testname - user-controlled captures", 1 if $pattern =~ /\(/; is_deeply(\@captures, [1], "$testname - didn't unduly capture"); } } # SECOND: use 'keep' option to check captures. @captures = $text =~ /$RE{time}{strftime}{-pat=>$pattern}{-keep}/; $did_succeed = @captures > 0; # TEST 3: matching with 'keep' ok ( ($should_succeed && $did_succeed) || (!$should_succeed && !$did_succeed), "$testname - $actual as expected (keep)."); # TEST 4: capture variables should be set. if ($should_succeed) { SKIP: { skip "$testname - can't check captures since match unsuccessful", 1 if !$did_succeed; is_deeply(\@captures, $matchvars, "$testname - correct capture variables"); } } }