File Coverage

blib/lib/DateTime/Format/Flexible.pm
Criterion Covered Total %
statement 183 198 92.4
branch 86 118 72.8
condition 8 17 47.0
subroutine 22 24 91.6
pod 2 2 100.0
total 301 359 83.8


line stmt bran cond sub pod time code
1             package DateTime::Format::Flexible;
2 22     22   6069538 use strict;
  22         234  
  22         634  
3 22     22   131 use warnings;
  22         52  
  22         934  
4              
5             our $VERSION = '0.32';
6              
7 22     22   152 use base 'DateTime::Format::Builder';
  22         43  
  22         12277  
8              
9 22     22   8611708 use DateTime::Format::Flexible::lang;
  22         101  
  22         733  
10 22     22   170 use DateTime::Infinite;
  22         66  
  22         793  
11              
12 22     22   137 use Carp 'croak';
  22         54  
  22         16307  
13              
14             my $DELIM = qr{(?:\\|\/|-|'|\.|\s)};
15             my $HMSDELIM = qr{(?:\.|:)};
16             my $YEAR = qr{(\d{1,4})};
17             my $MON = qr{([0-1]?\d)};
18             my $DAY = qr{([0-3]?\d)};
19             my $HOUR = qr{([0-2]?\d)};
20             my $HM = qr{([0-2]?\d)$HMSDELIM([0-5]?\d)};
21             my $HMS = qr{([0-2]?\d)$HMSDELIM([0-5]?\d)$HMSDELIM([0-5]?\d)};
22             my $HMSNS = qr{T?([0-2]?\d)$HMSDELIM([0-5]?\d)$HMSDELIM([0-5]?\d)$HMSDELIM(\d+)T?};
23             my $AMPM = qr{(a\.?m?|p\.?m?)\.?}i;
24              
25             my $MMDDYYYY = qr{(\d{1,2})${DELIM}(\d{1,2})${DELIM}(\d{1,4})};
26             my $YYYYMMDD = qr{(\d{4})${DELIM}${MON}${DELIM}${DAY}};
27             my $YYMMDD = qr{(\d\d)${DELIM}?([0-1]\d)${DELIM}?([0-3]\d)};
28             my $MMYY = qr{(\d{1,2})${DELIM}(\d{1,2})}; # YEAR must be > 31 unless MMYY
29             my $MMDD = qr{(\d{1,2})$DELIM(\d{1,2})};
30             my $XMMXDD = qr{X([0-1]?\d)X${DELIM}?([0-3]?\d)};
31             my $DDXMMX = qr{(\d{1,2})${DELIM}?X(\d{1,2})X};
32             my $DDXMMXYYYY = qr{(\d{1,2})${DELIM}X(\d{1,2})X$DELIM(\d{1,4})};
33             my $MMYYYY = qr{(\d{1,2})$DELIM(\d{4})};
34             my $XMMXYYYY = qr{X(\d{1,2})X${DELIM}(\d{4})};
35             my $XMMXDDYYYY = qr{X(\d{1,2})X${DELIM}?(\d{1,2})${DELIM}?(\d{1,4})};
36              
37             my $HMSMD = [ qw( hour minute second month day ) ];
38             my $HMSMDY = [ qw( hour minute second month day year ) ];
39             my $HMSYMD = [ qw( hour minute second year month day ) ];
40             my $HMSNSMDY = [ qw( hour minute second nanosecond month day year ) ];
41             my $HMSDM = [ qw( hour minute second day month ) ];
42             my $HMMDY = [ qw( hour minute month day year ) ];
43             my $HMMD = [ qw( hour minute month day ) ];
44             my $HMAPMMDD = [ qw( hour minute ampm month day ) ];
45             my $HMAPMMDDYYYY = [ qw( hour minute ampm month day year ) ];
46             my $DM = [ qw( day month ) ];
47             my $DMY = [ qw( day month year ) ];
48             my $DMHM = [ qw( day month hour minute ) ];
49             my $DMHMS = [ qw( day month hour minute second ) ];
50             my $DMHMSAP = [ qw( day month hour minute second ampm ) ];
51             my $DMYHM = [ qw( day month year hour minute ) ];
52             my $DMYHMS = [ qw( day month year hour minute second ) ];
53             my $DMYHMSNS = [ qw( day month year hour minute second nanosecond ) ];
54             my $DMYHMSAP = [ qw( day month year hour minute second ampm ) ];
55              
56             my $M = [ qw( month ) ];
57             my $MD = [ qw( month day ) ];
58             my $MY = [ qw( month year ) ];
59             my $MDY = [ qw( month day year ) ];
60             my $MDHMS = [ qw( month day hour minute second ) ];
61             my $MDHMSAP = [ qw( month day hour minute second ampm ) ];
62             my $MYHMS = [ qw( month year hour minute second ) ];
63             my $MYHMSAP = [ qw( month year hour minute second ampm ) ];
64             my $MDYHM = [ qw( month day year hour minute second ) ];
65             my $MDYHMS = [ qw( month day year hour minute second ) ];
66             my $MDYHMAP = [ qw( month day year hour minute ampm ) ];
67             my $MDYHMSAP = [ qw( month day year hour minute second ampm ) ];
68             my $MDHMSY = [ qw( month day hour minute second year ) ];
69             my $MDHMSNSY = [ qw( month day hour minute second nanosecond year ) ];
70              
71              
72             my $Y = [ qw( year ) ];
73             my $YM = [ qw( year month ) ];
74             my $YMD = [ qw( year month day ) ];
75             my $YMDH = [ qw( year month day hour ) ];
76             my $YHMS = [ qw( year hour minute second ) ];
77             my $YMDHM = [ qw( year month day hour minute ) ];
78             my $YMHMS = [ qw( year month hour minute second ) ];
79             my $YMDHAP = [ qw( year month day hour ampm ) ];
80             my $YMDHMS = [ qw( year month day hour minute second ) ];
81             my $YMDHMAP = [ qw( year month day hour minute ampm ) ];
82             my $YMHMSAP = [ qw( year month hour minute second ampm ) ];
83             my $YMDHMSAP = [ qw( year month day hour minute second ampm ) ];
84             my $YMDHMSNS = [ qw( year month day hour minute second nanosecond ) ];
85             my $YMDHMSNSAP = [ qw( year month day hour minute second nanosecond ampm ) ];
86              
87 22     22   230 use DateTime;
  22         74  
  22         590  
88 22     22   142 use DateTime::TimeZone;
  22         83  
  22         770  
89 22     22   139 use DateTime::Format::Builder 0.74;
  22         527  
  22         195  
90              
91             my $base_dt;
92             sub base
93             {
94 17829     17829 1 37370 my ( $self , $dt ) = @_;
95 17829 100       33939 $base_dt = $dt if ( $dt );
96 17829   66     73691 return $base_dt || DateTime->now;
97             }
98              
99             my $formats =
100             [
101             [ preprocess => \&_fix_alpha ] ,
102             { length => [18..22] , params => $YMDHMSAP , regex => qr{\A(\d{4})$DELIM(\d{2})$DELIM(\d{2})\s$HMS\s?$AMPM\z} , postprocess => \&_fix_ampm } ,
103              
104             # 2011-06-16-17.43.30.000000
105             { length => [26] , params => $YMDHMSNS , regex => qr{\A(\d{4})$DELIM(\d{2})$DELIM(\d{2})${DELIM}$HMSNS\z} } ,
106              
107             ########################################################
108             ##### Month/Day/Year
109             # M/DD/Y, MM/D/Y, M/D/Y, MM/DD/Y, M/D/YY, M/DD/YY, MM/D/Y, MM/SS/YY,
110             # M/D/YYYY, M/DD/YYYY, MM/D/YYYY, MM/DD/YYYY
111              
112             { length => [5..10], params => $MDY, regex => qr{\A${MON}${DELIM}${DAY}${DELIM}${YEAR}\z}, postprocess => [ \&_fix_year, \&_fix_zero_month ] },
113             { length => [12..14], params => $MDY, regex => qr{\AX${MON}X${DELIM}n${DAY}n${DELIM}${YEAR}\z} },
114             { length => [11..19], params => $MDYHMS, regex => qr{\A${MON}${DELIM}${DAY}${DELIM}${YEAR}\s$HMS\z}, postprocess => [ \&_fix_year, \&_fix_zero_month ] },
115             { length => [11..20], params => $MDYHMAP, regex => qr{\A${MON}${DELIM}${DAY}${DELIM}${YEAR}\s$HM\s?$AMPM\z}, postprocess => [ \&_fix_ampm , \&_fix_year, \&_fix_zero_month ] } ,
116             { length => [14..22], params => $MDYHMSAP, regex => qr{\A${MON}${DELIM}${DAY}${DELIM}${YEAR}\s$HMS\s?$AMPM\z}, postprocess => [ \&_fix_ampm , \&_fix_year, \&_fix_zero_month ] } ,
117              
118             # 02/28/2014 14:30 (missing seconds)
119             { length => [14..16], params => $MDYHM, regex => qr{\A$MMDDYYYY\s$HM\z}, postprocess => [\&_set_default_seconds, \&_fix_zero_month] } ,
120              
121             ########################################################
122             ##### Year/Month/Day
123             # YYYY/M/D, YYYY/M/DD, YYYY/MM/D, YYYY/MM/DD
124             # YYYY/MM/DD HH:MM:SS
125             # YYYY-MM HH:MM:SS
126             { length => [6,7], params => $YM, regex => qr{\A(\d{4})$DELIM$MON\z} },
127             { length => [12..16], params => $YMHMS, regex => qr{\A(\d{4})$DELIM$MON\s$HMS\z} },
128             { length => [14..19], params => $YMHMSAP, regex => qr{\A(\d{4})$DELIM$MON\s$HMS\s?$AMPM\z} , postprocess => \&_fix_ampm },
129             { length => [8..10], params => $YMD, regex => qr{\A$YYYYMMDD\z} },
130             { length => [10..12], params => $YMDH, regex => qr{\A${YYYYMMDD}\s${HOUR}z} },
131             { length => [13..15], params => $YMDHAP, regex => qr{\A${YYYYMMDD}\s${HOUR}\s?${AMPM}\z} , postprocess => \&_fix_ampm },
132             { length => [11..16], params => $YMDHM, regex => qr{\A$YYYYMMDD\s$HM\z} },
133             { length => [14..19], params => $YMDHMAP, regex => qr{\A$YYYYMMDD\s$HM\s?$AMPM\z}, postprocess => \&_fix_ampm },
134             { length => [14..19], params => $YMDHMS, regex => qr{\A$YYYYMMDD\s$HMS\z} },
135             { length => [17..21], params => $YMDHMSAP, regex => qr{\A$YYYYMMDD\s$HMS\s?$AMPM\z}, postprocess => \&_fix_ampm },
136             # 950404 00:22:12 => 1995-04-04T00:22:12
137             { length => [15], params => $YMDHMS, regex => qr{\A$YYMMDD\s$HMS\z}, postprocess => \&_fix_year },
138             { length => [19], params => $YMDHMSNS, regex => qr{\A$YYMMDD\s$HMSNS\z}, postprocess => \&_fix_year },
139              
140              
141             ########################################################
142             ##### YYYY-MM-DDTHH:MM:SS
143             # this is what comes out of the database
144             { length => 19, params => $YMDHMS, regex => qr{\A(\d{4})$DELIM(\d{2})$DELIM(\d{2})T(\d{2}):(\d{2}):(\d{2})\z} },
145              
146             { length => 16, params => $YMDHMS, regex => qr{\A(\d{4})(\d{2})(\d{2})(\d{2}):(\d{2}):(\d{2})\z} },
147             { length => 13, params => $YMDHM , regex => qr{\A(\d{4})(\d{2})(\d{2})(\d{2}):(\d{2})\z} },
148             { length => 8 , params => $YMD , regex => qr{\A(\d{4})(\d{2})(\d{2})\z} },
149              
150             { length => 10 , params => $YMD , regex => qr{\AY(\d{2})Y$DELIM(\d{2})$DELIM(\d{2})\z} , postprocess => \&_fix_year } ,
151             # 96-06-1800:00:00
152             { length => 18 , params => $YMDHMS , regex => qr{\AY(\d{2})Y$DELIM(\d{2})$DELIM(\d{2})$HMS\z} , postprocess => \&_fix_year } ,
153             # 96-06-1800:00
154             { length => 15 , params => $YMDHM , regex => qr{\AY(\d{2})Y$DELIM(\d{2})$DELIM(\d{2})$HM\z} , postprocess => \&_fix_year } ,
155             # 9931201 at 05:30:25 pM GMT
156              
157             # 1993120105:30:25.05 am
158             { length => 22 , params => $YMDHMSNSAP ,
159             regex => qr{\A(\d{4})(\d{2})(\d{2})${HMSNS}\s${AMPM}\z} ,
160             postprocess => \&_fix_ampm },
161              
162             # 1993120105:30:25 am
163             { length => 19 , params => $YMDHMSAP ,
164             regex => qr{\A(\d{4})(\d{2})(\d{2})${HMS}\s${AMPM}\z} ,
165             postprocess => \&_fix_ampm },
166              
167             ########################################################
168             ##### Month/Year
169             ##### year must be 4 digits unless it is > 31
170             ##### or MMYY is true
171             # M/YYYY, MM/YYYY
172             { length => [6,7], params => $MY, regex => qr{\A$MMYYYY\z}, postprocess => \&_fix_zero_month },
173             { length => [3..5], params => $MY, regex => qr{\A$MMYY\z},
174             postprocess => [sub {
175             my %args = @_;
176             if ( exists $args{args} )
177             {
178             my %original_args = @{$args{args}};
179             return 1 if ( $original_args{MMYY} );
180             }
181             return 1 if ( $args{parsed}{year} > 31 );
182             return 0;
183             }, \&_fix_year] },
184             ########################################################
185             ##### Month/Day
186             # M/D, M/DD, MM/D, MM/DD
187             { length => [3..5], params => $MD, regex => qr{\A$MMDD\z},
188             postprocess => sub { my %args = @_; $args{parsed}{year} = __PACKAGE__->base->year } },
189              
190             { length => [9..14], params => $MDHMS, regex => qr{\A$MMDD\s$HMS\z},
191             postprocess => sub { my %args = @_; $args{parsed}{year} = __PACKAGE__->base->year } },
192             { length => [12..17], params => $MDHMSAP, regex => qr{\A$MMDD\s$HMS\s?$AMPM\z},
193             postprocess => [sub { my %args = @_; $args{parsed}{year} = __PACKAGE__->base->year },\&_fix_ampm] },
194              
195             ########################################################
196             ##### Dates with at in their name: 12-10-65 at 5:30:25
197             # the language plugins should wrap the time like this: T5:30:25T
198             # 2005-06-12 T3Tp (15)
199             { length => [16,17], params => $MDYHMS, regex => qr{\A${MON}${DAY}${YEAR}T${HMS}T\z}, postprocess => [ \&_fix_year, \&_fix_zero_month ] } ,
200             { length => [17,18,20], params => $MDYHMS, regex => qr{\A${MON}${DELIM}${DAY}${DELIM}${YEAR}\s?T${HMS}T\z}, postprocess => [ \&_fix_year, \&_fix_zero_month ] } ,
201             { length => [17..20], params => $DMYHM, regex => qr{\A${DAY}${DELIM}X${MON}X${DELIM}${YEAR}\sT${HM}T\z}, postprocess => [ \&_fix_year, \&_fix_zero_month ] } ,
202             { length => [20], params => $MDYHMS, regex => qr{\AX${MON}X${DELIM}${DAY}${DELIM}${YEAR}\s?T${HMS}T\z}, postprocess => \&_fix_year } ,
203             { length => [21], params => $MDYHMAP, regex => qr{\A${MON}${DELIM}${DAY}${DELIM}${YEAR}\s?T${HM}T\s${AMPM}\z}, postprocess => [ \&_fix_ampm, \&_fix_zero_month ] } ,
204             { length => [20,21], params => $YMDHMAP, regex => qr{\A${YYYYMMDD}\s?T${HM}T\s${AMPM}\z}, postprocess => \&_fix_ampm } ,
205             { length => [21,22], params => $YMDHMSAP, regex => qr{\A${YEAR}${MON}${DAY}\s?T${HMS}T\s${AMPM}\z}, postprocess => \&_fix_ampm } ,
206             { length => [15], params => $YMDHAP, regex => qr{\A${YEAR}${DELIM}${MON}${DELIM}${DAY}\s?T${HOUR}T\s?${AMPM}\z}, postprocess => \&_fix_ampm } ,
207             { length => [16..18], params => $YMDHM, regex => qr{\A${YEAR}${DELIM}${MON}${DELIM}${DAY}\s?T${HM}T\z}, postprocess => \&_fix_year } ,
208             { length => [21], params => $YMDHMS, regex => qr{\A${YEAR}${DELIM}${MON}${DELIM}${DAY}\s?T${HMS}T\z}, postprocess => \&_fix_year } ,
209             { length => [16], params => $MDYHMS, regex => qr{\A${MON}${DAY}(\d\d)\s?T${HMS}T\z}, postprocess => [ \&_fix_year, \&_fix_zero_month ] } ,
210             { length => [16], params => $YMDHAP, regex => qr{\A${YEAR}${DELIM}${MON}${DELIM}${DAY}\s?T${HOUR}T${AMPM}\z}, postprocess => \&_fix_ampm } ,
211              
212             { length => [15,16], params => $MDHMS, regex => qr{\A${MON}${DELIM}${DAY}\s?T${HMS}T\z},
213             postprocess => sub { my %args = @_; $args{parsed}{year} = __PACKAGE__->base->year } } ,
214             { length => [17,18], params => $MDHMS, regex => qr{\AX${MON}X${DELIM}${DAY}\s?T${HMS}T\z},
215             postprocess => sub { my %args = @_; $args{parsed}{year} = __PACKAGE__->base->year } } ,
216              
217             ########################################################
218             # YYYY HH:MM:SS
219             { length => [13], params => $YHMS, regex => qr{\A$YEAR\s$HMS\z} } ,
220              
221             ########################################################
222             # time first
223             # (5:30 12-10)
224             { length => [8..11], params => $HMMD, regex => qr{\A${HM}\s${MMDD}\z}, postprocess => \&_set_default_year },
225             # 5:30:25:05/1/1/65
226             # 12:30:25:05/10/10/65
227             { length => [17..20], params => $HMSNSMDY, regex => qr{\A${HMSNS}${DELIM}${MMDDYYYY}\z}, postprocess => \&_fix_year },
228             # 5:30:25 12101965
229             { length => [14..16], params => $HMSMDY, regex => qr{\A${HMS}${DELIM}${MON}${DAY}${YEAR}\z}, postprocess => \&_fix_year },
230             { length => [14..19], params => $HMSMDY, regex => qr{\A${HMS}${DELIM}${MMDDYYYY}\z}, postprocess => \&_fix_year },
231              
232             { length => [14..19], params => $HMSYMD, regex => qr{\A${HMS}${DELIM}${YYYYMMDD}\z}, postprocess => \&_fix_year },
233              
234             # 5:30 pm 121065 => 2065-12-01T17:30:00
235             { length => [14,18], params => $HMAPMMDDYYYY, regex => qr{\A${HM}\s${AMPM}\s${MON}${DAY}${YEAR}},postprocess => [\&_fix_ampm, \&_fix_year] },
236             { length => [16,19], params => $HMAPMMDDYYYY, regex => qr{\A${HM}\s${AMPM}\s${MMDDYYYY}},postprocess => [\&_fix_ampm, \&_fix_year] },
237              
238              
239             ########################################################
240             ##### Alpha months
241             # _fix_alpha changes month name to "XMX"
242             # 18-XMX, X1X-18, 08-XMX-99, XMY-08-1999, 1999-X1Y-08, 1999-X10X-08
243              
244             # DD-mon, D-mon, D-mon-YY, DD-mon-YY, D-mon-YYYY, DD-mon-YYYY, D-mon-Y, DD-mon-Y
245             { length => [5..7], params => $DM, regex => qr{\A${DDXMMX}\z},
246             postprocess => sub { my %args = @_; $args{parsed}{year} = __PACKAGE__->base->year } },
247             { length => [9..15], params => $DMHM, regex => qr{\A${DDXMMX}\s${HM}\z},
248             postprocess => sub { my %args = @_; $args{parsed}{year} = __PACKAGE__->base->year } },
249             { length => [9..18], params => $DMHMS, regex => qr{\A${DDXMMX}\s${HMS}\z},
250             postprocess => sub { my %args = @_; $args{parsed}{year} = __PACKAGE__->base->year } },
251             { length => [11..21], params => $DMHMSAP, regex => qr{\A${DDXMMX}\s${HMS}\s?$AMPM\z},
252             postprocess => [sub { my %args = @_; $args{parsed}{year} = __PACKAGE__->base->year }, \&_fix_ampm] } ,
253              
254             { length => [7..12], params => $DMY, regex => qr{\A${DDXMMXYYYY}\z}, postprocess => \&_fix_year },
255             { length => [12..18], params => $DMYHM, regex => qr{\A${DDXMMXYYYY}\s${HM}\z}, postprocess => \&_fix_year },
256             { length => [12..21], params => $DMYHMS, regex => qr{\A${DDXMMXYYYY}\s${HMS}\z}, postprocess => \&_fix_year },
257             { length => [16..25], params => $DMYHMSNS, regex => qr{\A${DDXMMXYYYY}\s${HMSNS}\z}, postprocess => \&_fix_year },
258             { length => [14..24], params => $DMYHMSAP, regex => qr{\A${DDXMMXYYYY}\s${HMS}\s?$AMPM\z}, postprocess => [ \&_fix_year , \&_fix_ampm ] },
259             { length => [9..15] , params => $HMSMD, regex => qr{\A${HMS}${XMMXDD}\z}, postprocess => \&_set_default_year },
260              
261             # Fri Dec 2 22:56:03.500 GMT+0 1994
262             { length => [24], params => $MDHMSNSY, regex => qr{\A${XMMXDD}\s${HMSNS}\s${YEAR}\z}, },
263              
264             { length => [9..15] , params => $HMSDM, regex => qr{\A${HMS}${DELIM}?${DDXMMX}\z}, postprocess => \&_set_default_year },
265             { length => [11..17], params => $HMSMDY, regex => qr{\A${HMS}${XMMXDDYYYY}\z}, postprocess => \&_fix_year },
266             { length => [6..11], params => $HMMD, regex => qr{\A${HM}${XMMXDD}\z}, postprocess => \&_set_default_year },
267              
268             # mon
269             { length => [3,4], params => $M, regex => qr{\AX${MON}X\z},
270             postprocess => sub { my %args = @_;$args{parsed}{year} = __PACKAGE__->base->year;$args{parsed}{day} = 1; } },
271              
272             # mon-D , mon-DD, mon-YYYY, mon-D-Y, mon-DD-Y, mon-D-YY, mon-DD-YY
273             # mon-D-YYYY, mon-DD-YYYY
274             { length => [8,9], params => $MY, regex => qr{\A${XMMXYYYY}\z} },
275             { length => [14..18], params => $MYHMS, regex => qr{\A${XMMXYYYY}\s${HMS}\z} },
276             { length => [16..21], params => $MYHMSAP, regex => qr{\A${XMMXYYYY}\s${HMS}\s?$AMPM\z}, postprocess => \&_fix_ampm },
277              
278             { length => [5..7], params => $MD, regex => qr{\A$XMMXDD\z},
279             postprocess => sub { my %args = @_; _set_year( @_ ) } },
280             { length => [10..18], params => $MDHMS, regex => qr{\A$XMMXDD\s$HMS\z},
281             postprocess => sub { my %args = @_; $args{parsed}{year} = __PACKAGE__->base->year } },
282             { length => [12..21], params => $MDHMSAP, regex => qr{\A$XMMXDD\s$HMS\s?$AMPM\z} ,
283             postprocess => [sub { my %args = @_; $args{parsed}{year} = __PACKAGE__->base->year }, \&_fix_ampm] },
284              
285             { length => [7..12], params => $MDY, regex => qr{\A$XMMXDDYYYY\z}, postprocess => \&_fix_year },
286             { length => [12..21], params => $MDYHMS, regex => qr{\A$XMMXDDYYYY\s$HMS\z}, postprocess => \&_fix_year },
287             { length => [14..17], params => $MDYHM, regex => qr{\A$XMMXDDYYYY\s$HM\z},
288             postprocess => sub { my %args = @_; $args{parsed}{second} = 0; _fix_year(%args) } },
289             { length => [14..24], params => $MDYHMSAP, regex => qr{\A$XMMXDDYYYY\s$HMS\s?$AMPM\z}, postprocess => [ \&_fix_year , \&_fix_ampm ] },
290              
291             # YYYY-mon-D, YYYY-mon-DD, YYYY-mon
292             { length => [8,9], params => $YM, regex => qr{\A(\d{4})${DELIM}X(\d{1,2})X\z} },
293             { length => [13..18], params => $YMHMS, regex => qr{\A(\d{4})${DELIM}X(\d{1,2})X\s$HMS\z} },
294             { length => [15..21], params => $YMHMSAP, regex => qr{\A(\d{4})${DELIM}X(\d{1,2})X\s$HMS\s?$AMPM\z} , postprocess => \&_fix_ampm },
295             { length => [9..12], params => $YMD, regex => qr{\A(\d{4})${DELIM}X(\d{1,2})X$DELIM(\d{1,2})\z} },
296             { length => [15..21], params => $YMDHMS, regex => qr{\A(\d{4})${DELIM}X(\d{1,2})X$DELIM(\d{1,2})\s$HMS\z} },
297             { length => [18..24], params => $YMDHMSAP, regex => qr{\A(\d{4})${DELIM}X(\d{1,2})X$DELIM(\d{1,2})\s$HMS\s?$AMPM\z} , postprocess => \&_fix_ampm },
298             # month D, Y | month D, YY | month D, YYYY | month DD, Y | month DD, YY
299             # month DD, YYYY
300             { length => [9..13], params => $MDY, regex => qr{\AX(\d{1,2})X\s(\d{1,2}),\s(\d{1,4})\z} },
301             { length => [5..22], params => $MDYHMS, regex => qr{\AX(\d{1,2})X\s(\d{1,2}),\s(\d{1,4})\s$HMS\z} },
302             { length => [7..25], params => $MDYHMSAP, regex => qr{\AX(\d{1,2})X\s(\d{1,2}),\s(\d{1,4})\s$HMS\s?$AMPM\z} , postprocess => \&_fix_ampm },
303              
304             # D month, Y | D month, YY | D month, YYYY | DD month, Y | DD month, YY
305             # DD month, YYYY
306             # nDDn XMMX
307             { length => [8..13], params => $DMY, regex => qr{\A(\d{1,2})\sX(\d{1,2})X,?\s(\d{1,4})\z} },
308             { length => [13..21], params => $DMYHMS, regex => qr{\A(\d{1,2})\sX(\d{1,2})X,?\s(\d{1,4})\s$HMS\z} },
309             { length => [16..27], params => $DMYHMSAP, regex => qr{\A(\d{1,2})\sX(\d{1,2})X,?\s(\d{1,4})\s$HMS\s?$AMPM\z}, postprocess => \&_fix_ampm },
310             { length => [7..9], params => $DM, regex => qr{\An(\d{1,2})n\sX(\d{1,2})X\z}, postprocess => \&_set_default_year },
311              
312             # Dec 03 20:53:10 2009
313             { length => [16..21], params => $MDHMSY , regex => qr{\AX(\d{1,2})X\s(\d{1,2})\s$HMS\s(\d{4})\z} } ,
314             { length => [10..18], params => $HMMDY , regex => qr{\A$HM\sX${MON}X\s$DAY\s$YEAR\z} },
315             # 8:00 pm Dec 10th => 8:00pm X12X n10n
316             { length => [14..19] , params => $HMAPMMDD , regex => qr{\A$HM\s?$AMPM\sX${MON}X\sn${DAY}n\z} ,
317             postprocess => [sub { my %args = @_; $args{parsed}{year} = __PACKAGE__->base->year }, \&_fix_ampm] },
318             # 5:30 DeC 1
319             { length => [11], params => $HMMD, regex => qr{\A${HM}\sX${MON}X\s${DAY}\z}m, postprocess => \&_set_default_year },
320              
321             ########################################################
322             ##### Bare Numbers
323             # 20060518T051326, 20060518T0513, 20060518T05, 20060518, 200608
324             # 20060518 12:34:56
325             { length => [16..20], params => $YMDHMSAP, regex => qr{\A(\d{4})(\d{2})(\d{2})\s$HMS\s?$AMPM\z} , postprocess => \&_fix_ampm },
326             { length => [14..17], params => $YMDHMS, regex => qr{\A(\d{4})(\d{2})(\d{2})\s$HMS\z} },
327             # 19960618000000 => 1996-06-18T00:00:00
328             { length => 14, params => $YMDHMS, regex => qr{\A(\d{4})(\d{2})(\d{2})(\d{2})(\d{2})(\d{2})\z} },
329             { length => 15, strptime => '%Y%m%dT%H%M%S' } ,
330             { length => 13, strptime => '%Y%m%dT%H%M' } ,
331             { length => 11, strptime => '%Y%m%dT%H' } ,
332             { length => 8, strptime => '%Y%m%d' } ,
333             { length => 6, strptime => '%Y%m' } ,
334             { length => 4, strptime => '%Y' } ,
335              
336             ########################################################
337             ##### bare times
338             # HH:MM:SS
339             { length => [5..10],
340             params => [ qw( hour minute second ) ] ,
341             regex => qr{\AT?${HMS}T?\z} ,
342             postprocess => sub {
343             my %args = @_;
344             $args{parsed}{year} = __PACKAGE__->base->year;
345             $args{parsed}{month} = __PACKAGE__->base->month;
346             $args{parsed}{day} = __PACKAGE__->base->day;
347             }
348             },
349             # HH:MM:SS AM
350             { length => [7..13],
351             params => [ qw( hour minute second ampm ) ] ,
352             regex => qr{\AT?${HMS}T?\s?$AMPM\z} ,
353             postprocess => [sub {
354             my %args = @_;
355             $args{parsed}{year} = __PACKAGE__->base->year;
356             $args{parsed}{month} = __PACKAGE__->base->month;
357             $args{parsed}{day} = __PACKAGE__->base->day;
358             }, \&_fix_ampm]
359             },
360              
361             # HH:MM
362             { length => [3..7],
363             params => [ qw( hour minute ) ] ,
364             regex => qr{\AT?${HM}T?\z} ,
365             postprocess => sub {
366             my %args = @_;
367             $args{parsed}{year} = __PACKAGE__->base->year;
368             $args{parsed}{month} = __PACKAGE__->base->month;
369             $args{parsed}{day} = __PACKAGE__->base->day;
370             }
371             },
372             # HH:MM am
373             { length => [5..10],
374             params => [ qw( hour minute ampm ) ] ,
375             regex => qr{\A$HM\s?$AMPM\z} ,
376             postprocess => [sub {
377             my %args = @_;
378             $args{parsed}{year} = __PACKAGE__->base->year;
379             $args{parsed}{month} = __PACKAGE__->base->month;
380             $args{parsed}{day} = __PACKAGE__->base->day;
381             }, \&_fix_ampm ]
382             } ,
383              
384             # HH am
385             { length => [2..5],
386             params => [ qw( hour ampm ) ] ,
387             regex => qr{\A$HOUR\s?$AMPM\z} ,
388             postprocess => [sub {
389             my %args = @_;
390             $args{parsed}{year} = __PACKAGE__->base->year;
391             $args{parsed}{month} = __PACKAGE__->base->month;
392             $args{parsed}{day} = __PACKAGE__->base->day;
393             }, \&_fix_ampm ]
394             } ,
395              
396             ########################################################
397             # Day of year
398             # 1999345 => 1999, 345th day of year
399             { length => [5,7], params => [ qw( year doy ) ] ,
400             regex => qr{\A$YEAR(?:$DELIM)?(\d{3})\z} ,
401             postprocess => [ \&_fix_year , \&_fix_day_of_year ] } ,
402             { length => [10..18], params => [ qw( year doy hour minute second ) ] ,
403             regex => qr{\A$YEAR(?:$DELIM)?(\d{3})\s$HMS\z} ,
404             postprocess => [ \&_fix_year , \&_fix_day_of_year ] } ,
405             { length => [12..21], params => [ qw( year doy hour minute second ampm ) ] ,
406             regex => qr{\A$YEAR(?:$DELIM)?(\d{3})\s$HMS\s?$AMPM\z} ,
407             postprocess => [ \&_fix_year , \&_fix_day_of_year , \&_fix_ampm ]} ,
408              
409             # this is the format for Websphere mq
410             # http://publib.boulder.ibm.com/infocenter/wmqv6/v6r0/index.jsp?topic=/com.ibm.mq.csqzak.doc/js01396.htm
411             # hundreths are not a valid parameter to DateTime->new, so we turn them into nanoseconds
412             { length => [16], params => $YMDHMSNS , regex => qr{\A(\d{4})(\d{2})(\d{2})(\d{2})(\d{2})(\d{2})(\d{2})\z} ,
413             postprocess => sub {
414             my %args = @_;
415             my $t = sprintf( '%s0' , $args{parsed}{nanosecond} ) * 1_000_000;
416             $args{parsed}{nanosecond} = $t;
417             }
418             },
419              
420             {
421             params => [],
422             length => [8],
423             regex => qr{\Ainfinity\z},
424             constructor => sub {
425             return DateTime::Infinite::Future->new;
426             },
427             },
428             {
429             params => [],
430             length => [9],
431             regex => qr{\A\-infinity\z},
432             constructor => sub {
433             return DateTime::Infinite::Past->new;
434             },
435             },
436              
437             # nanoseconds. no length here, we do not know how many digits they will use for nanoseconds
438             { params => [ qw( year month day hour minute second nanosecond ) ] , regex => qr{\A$YYYYMMDD(?:\s|T)T?${HMS}${HMSDELIM}(\d+)T?\z} } ,
439              
440             # epochtime
441             {
442             params => [] , # we specifically set the params below
443             regex => qr{\A\d+\.?\d+?\z} ,
444             postprocess => sub {
445             my %args = @_;
446             my $dt = DateTime->from_epoch( epoch => $args{input} );
447             $args{parsed}{year} = $dt->year;
448             $args{parsed}{month} = $dt->month;
449             $args{parsed}{day} = $dt->day;
450             $args{parsed}{hour} = $dt->hour;
451             $args{parsed}{minute} = $dt->minute;
452             $args{parsed}{second} = $dt->second;
453             $args{parsed}{nanosecond} = $dt->nanosecond;
454             return 1;
455             }
456             },
457             ];
458              
459             DateTime::Format::Builder->create_class( parsers => { parse_datetime => $formats } );
460              
461             sub build
462             {
463 0     0 1 0 my $self = shift;
464 0         0 return $self->parse_datetime( @_ );
465             }
466              
467             sub _fix_day_of_year
468             {
469 57     57   479 my %args = @_;
470              
471 57         109 my $doy = $args{parsed}{doy};
472 57         137 delete $args{parsed}{doy};
473              
474             my $dt = DateTime->from_day_of_year(
475             year => $args{parsed}{year} ,
476 57         206 day_of_year => $doy
477             );
478 57         19574 $args{parsed}{month} = $dt->month;
479 57         349 $args{parsed}{day} = $dt->day;
480              
481 57         451 return 1;
482             }
483              
484             sub _fix_alpha
485             {
486 6356     6356   8765228 my %args = @_;
487 6356         16795 my ($date, $p) = @args{qw( input parsed )};
488 6356 100       17996 my %extra_args = @{$args{args}} if exists $args{args};
  308         778  
489              
490 6356 100       14467 if ( exists $extra_args{strip} )
491             {
492 140 100       474 my @strips = ref( $extra_args{strip} ) eq 'ARRAY' ? @{$extra_args{strip}} : ($extra_args{strip});
  54         150  
493 140         296 foreach my $strip ( @strips )
494             {
495 193 100       443 if ( ref( $strip ) eq 'Regexp' )
496             {
497 192         1177 $date =~ s{$strip}{}mx;
498             }
499             else
500             {
501 1         252 croak( "parameter strip requires a regular expression" );
502             }
503             }
504             }
505              
506 6355 100       12662 if ( exists $extra_args{base} )
507             {
508 2         7 __PACKAGE__->base( $extra_args{base} );
509             }
510              
511 6355         15036 ( $date , $p ) = _parse_timezone( $date , $p , \%extra_args );
512              
513 6355         15443 $date = _clean_whitespace( $date );
514              
515             my $lang = DateTime::Format::Flexible::lang->new(
516             lang => $extra_args{lang},
517 6355         23258 base => __PACKAGE__->base,
518             );
519              
520 6355         13652 my $stripped = $date;
521 6355         70298 $stripped =~ s{$DELIM|$HMSDELIM}{}gm;
522              
523 6355 100       22905 if ( $stripped =~ m{(\D)} )
524             {
525 3808 50       10983 printf( "# before lang: %s\n", $date ) if $ENV{DFF_DEBUG};
526 3808         11104 ( $date , $p ) = $lang->_cleanup( $date , $p );
527 3808 50       10157 printf( "# after lang: %s\n", $date ) if $ENV{DFF_DEBUG};
528             }
529             else
530             {
531 2547 50       5991 printf( "# ignoring languages, no non numbers (%s)\n", $stripped ) if $ENV{DFF_DEBUG};
532             }
533              
534 6355         73888 $date =~ s{($DELIM)+}{$1}mxg; # make multiple delimeters into one
535             # remove any leading delimeters unless it is -infinity
536 6355 50       30457 $date =~ s{\A$DELIM+}{}mx if ( not $date eq '-infinity' );
537 6355         37849 $date =~ s{$DELIM+\z}{}mx; # remove any trailing delimeters
538 6355         14652 $date =~ s{\,+}{}gmx; # remove commas
539              
540             # if we have two digits at the beginning of our date that are greater than 31,
541             # we have a possible two digit year
542 6355 100       30766 if ( my ( $possible_year , $remaining ) = $date =~ m{\A(\d\d)($DELIM.+)}mx )
543             {
544 1592 100       5199 if ( $possible_year > 31 )
545             {
546 8         35 $date =~ s{\A(\d\d)}{Y$1Y}mx;
547             }
548             }
549              
550             # try and detect DD-MM-YYYY
551 6355 100       15856 if ( $extra_args{european} )
552             {
553 21 100       259 if ( my ( $m , $d , $y ) = $date =~ m{\A$MMDDYYYY}mx )
554             {
555 11         197 $date =~ s{\A$MMDDYYYY}{$2-$1-$3}mx;
556             }
557             }
558              
559 6355 50 0     12918 printf( "# date: (%s) length: (%s) timezone: [%s] \n" , $date , length( $date ) , $p->{time_zone}||q{none} ) if $ENV{DFF_DEBUG};
560 6355         49506 return $date;
561             }
562              
563             sub _parse_timezone
564             {
565 6355     6355   12464 my ( $date , $p , $extra_args ) = @_;
566              
567 6355         9825 while ( my ( $abbrev , $tz ) = each( %{ $extra_args->{tz_map} } ) )
  6402         22545  
568             {
569 57 100       317 if ( $date =~ m{$abbrev} )
570             {
571 10         63 $date =~ s{\Q$abbrev\E}{};
572 10         31 $p->{time_zone} = $tz;
573 10         45 return ( $date , $p );
574             }
575             }
576              
577             # search for GMT/UTC inside the string
578             # must be surrounded by spaces
579             # 5:30 pm GMT 121065
580             # Tue Feb 28 14:30:00 UTC 2014
581             # Fri Dec 2 22:56:03 GMT+0 1994
582              
583 6345 100       22032 if ( my ( $tz ) = $date =~ m{\s(GMT(?:\+0)?|UTC)\s}mx )
584             {
585 3         28 $date =~ s{\Q$tz\E}{};
586 3         10 $p->{time_zone} = 'UTC';
587 3         9 return ( $date , $p );
588             }
589              
590             # remove any trailing 'Z' => UTC
591 6342 100       15227 if ( $date =~ m{Z\z}mx )
592             {
593 10         51 $date =~ s{Z\z}{}mx;
594 10         32 $p->{time_zone} = 'UTC';
595 10         42 return ( $date , $p );
596             }
597              
598             # set any trailing string timezones. they cannot start with a digit
599 6332 100       51073 if ( my ( $tz ) = $date =~ m{.+\s+(\D[^\s]+)\z} )
600             {
601 2249 50       6753 printf( "# possible timezone (%s)\n", $tz) if $ENV{DFF_DEBUG};
602 2249         4038 my $orig_tz = $tz;
603 2249 50       5780 if ( exists $extra_args->{tz_map}->{$tz} )
604             {
605 0         0 $tz = $extra_args->{tz_map}->{$tz};
606             }
607 2249 100       9798 if ( DateTime::TimeZone->is_valid_name( $tz ) )
608             {
609 681 50       873259 printf( "# timezone matched\n" ) if $ENV{DFF_DEBUG};
610 681         8845 $date =~ s{\Q$orig_tz\E}{};
611 681         2154 $p->{time_zone} = $tz;
612 681         2763 return ( $date , $p );
613             }
614             }
615              
616             # set any trailing offset timezones
617 5651 100       422692 if ( my ( $tz ) = $date =~ m{(
618             (?:\s+)?\+\d{2,4} # ' +04', '+04'
619             |\s+\-\d{4} # ' -0400'
620             |(?:\s+)?[-+]\d{2}:\d{2} # '-04:00', '+04:00'
621             )\.?\z}mx )
622             {
623 24 50       87 printf( "# possible timezone (%s) in (%s)\n", $tz, $date) if $ENV{DFF_DEBUG};
624 24         47 my $original_tz = $tz;
625 24         55 $tz =~ s{:}{};
626             # some timezones are 2 digit hours, add the minutes part
627 24         54 $tz = _clean_whitespace( $tz );
628 24 100       80 $tz .= '00' if ( length( $tz ) == 3 );
629 24 50       55 if ( _is_valid_tz_offset( $tz ) )
630             {
631 24 50       60 printf( "# timezone matched (%s)\n" , $tz ) if $ENV{DFF_DEBUG};
632 24         280 $date =~ s{\Q$original_tz\E\.?\z}{};
633 24         73 $p->{time_zone} = $tz;
634 24         94 return ( $date , $p );
635             }
636             }
637              
638 5627 100 100     31918 if ( length( $date ) > 15 and ($date =~ m{\dT\d} or $date =~ m{\d\s\d}))
      100        
639             {
640             # this pattern conflicts with 5-08, 01-02-03, 08-Jan-99, 2006-Dec-08
641             # so we need to check the length and make sure it is long enough to be
642             # a full iso datetime, and that is has a 'T' or ' ' (space) surrounded by digits
643 2616 100       13964 if ( my ( $tz ) = $date =~ m{(
644             (?:\s+)?[-+]\d{2,4} # '-0800', '-08', ' -08'
645             )\.?\z}mx )
646             {
647 20 50       61 printf( "# possible timezone (%s) in (%s)\n", $tz, $date) if $ENV{DFF_DEBUG};
648 20         36 my $original_tz = $tz;
649 20         37 $tz =~ s{:}{};
650             # some timezones are 2 digit hours, add the minutes part
651 20         46 $tz = _clean_whitespace( $tz );
652 20 100       64 $tz .= '00' if ( length( $tz ) == 3 );
653 20 100       45 if ( _is_valid_tz_offset( $tz ) )
654             {
655 18         163 $date =~ s{\Q$original_tz\E\.?\z}{};
656 18         56 $p->{time_zone} = $tz;
657 18         70 return ( $date , $p );
658             }
659             }
660             }
661              
662             # search for positive/negative 4 digit timezones that are inside the string
663             # must be surrounded by spaces
664             # Mon Apr 05 17:25:35 +0000 2010
665 5609 100       15148 if ( my ( $tz ) = $date =~ m{\s(
666             [-+]\d{4} # Mon Apr 05 17:25:35 +0000 2010
667             |[-+]\d{2}:\d{2} # Mon Apr 05 17:25:35 +00:00 2010
668             )\s}mx )
669             {
670 6         12 my $original_tz = $tz;
671 6         20 $tz =~ s{:}{};
672 6 50       18 if ( _is_valid_tz_offset( $tz ) )
673             {
674 6         88 $date =~ s{\Q$original_tz\E}{};
675 6         21 $p->{time_zone} = $tz;
676 6         24 return ( $date , $p );
677             }
678             }
679              
680 5603         16904 return ( $date , $p );
681             }
682              
683             sub _is_valid_tz_offset
684             {
685 50     50   110 my ($offset) = @_;
686              
687             # https://en.wikipedia.org/wiki/List_of_UTC_time_offsets
688 50         814 my $valid = {
689             '-1200' => 1,
690             '-1100' => 1,
691             '-1000' => 1,
692             '-0930' => 1,
693             '-0900' => 1,
694             '-0800' => 1,
695             '-0700' => 1,
696             '-0600' => 1,
697             '-0500' => 1,
698             '-0400' => 1,
699             '-0330' => 1,
700             '-0300' => 1,
701             '-0200' => 1,
702             '-0100' => 1,
703             '-0000' => 1,
704             '+0000' => 1,
705             '+0100' => 1,
706             '+0200' => 1,
707             '+0300' => 1,
708             '+0330' => 1,
709             '+0400' => 1,
710             '+0430' => 1,
711             '+0500' => 1,
712             '+0530' => 1,
713             '+0545' => 1,
714             '+0600' => 1,
715             '+0630' => 1,
716             '+0700' => 1,
717             '+0800' => 1,
718             '+0845' => 1,
719             '+0900' => 1,
720             '+0930' => 1,
721             '+1000' => 1,
722             '+1030' => 1,
723             '+1100' => 1,
724             '+1200' => 1,
725             '+1245' => 1,
726             '+1300' => 1,
727             '+1400' => 1,
728             };
729 50         335 return exists $valid->{$offset};
730             }
731              
732             sub _do_math
733             {
734 0     0   0 my ( $string ) = @_;
735 0 0       0 if ( $string =~ m{ago}mx )
736             {
737 0         0 my $base_dt = __PACKAGE__->base;
738 0 0       0 if ( my ( $amount , $unit ) = $string =~ m{(\d+)\s([^\s]+)}mx )
739             {
740 0 0       0 $unit .= 's' if ( $unit !~ m{s\z} ); # make sure the unit ends in 's'
741 0         0 return $base_dt->subtract( $unit => $amount );
742             }
743             }
744 0         0 return $string;
745             }
746              
747             sub _clean_whitespace
748             {
749 6399     6399   11272 my ( $string ) = @_;
750 6399         13786 $string =~ s{\A\s+}{}mx; # trim front
751 6399         13499 $string =~ s{\s+\z}{}mx; # trim back
752              
753 6399         20331 $string =~ s{\s+}{ }gmx; # remove extra whitespace from the middle
754 6399         11911 $string =~ s{"}{}gmx;
755 6399         11796 return $string;
756             }
757              
758             sub _fix_ampm
759             {
760 1452     1452   227994 my %args = @_;
761              
762 1452 50       4737 return if not defined $args{parsed}{ampm};
763              
764 1452 50       3710 printf( "# have ampm [%s]\n", $args{parsed}{ampm} ) if $ENV{DFF_DEBUG};
765              
766 1452         3250 my $ampm = $args{parsed}{ampm};
767 1452         3333 delete $args{parsed}{ampm};
768              
769 1452 100       7583 if ( $ampm =~ m{a\.?m?\.?}mix )
    50          
770             {
771 707 50       1885 printf( "# found am hour=[%s]\n", $args{parsed}{hour} ) if $ENV{DFF_DEBUG};
772 707 100       2875 if( $args{parsed}{hour} == 12 )
773             {
774 354         762 $args{parsed}{hour} = 0;
775             }
776 707         2472 return 1;
777             }
778             elsif ( $ampm =~ m{p\.?m?\.?}mix )
779             {
780 745 50       2178 printf( "# found pm hour=[%s]\n", $args{parsed}{hour} ) if $ENV{DFF_DEBUG};
781 745         2157 $args{parsed}{hour} += 12;
782 745 100       2380 if ( $args{parsed}{hour} == 24 )
783             {
784 351         959 $args{parsed}{hour} = 12;
785             }
786 745         2652 return 1;
787             }
788 0         0 return 1;
789             }
790              
791             sub _fix_zero_month
792             {
793 807     807   7224 my %args = @_;
794              
795 807 50       2047 return 1 if not exists $args{parsed}{month};
796 807 50       1790 return 1 if not defined $args{parsed}{month};
797              
798 807 100       1952 if ($args{parsed}{month} == 0)
799             {
800             # they probably meant october
801 13 50       27 print( "# month => 0 => 10\n") if $ENV{DFF_DEBUG};
802 13         22 $args{parsed}{month} = 10;
803             }
804              
805 807         1851 return 1;
806             }
807              
808             sub _set_default_seconds
809             {
810 2     2   279 my %args = @_;
811 2         5 $args{parsed}{second} = 0;
812 2         5 return 1;
813             }
814              
815             sub _set_default_year
816             {
817 15     15   7183 my %args = @_;
818 15         45 $args{parsed}{year} = __PACKAGE__->base->year;
819 15         4369 return 1;
820             }
821              
822             sub _set_year
823             {
824 18     18   50 my %args = @_;
825 18 50       58 my %constructor_args = $args{args} ? @{$args{args}} : ();
  0         0  
826 18 50       55 return 1 if defined $args{parsed}{year}; # year is already set
827              
828 18 50       45 if ( $constructor_args{prefer_future} )
829             {
830 0 0 0     0 if ( $args{parsed}{month} < __PACKAGE__->base->month or
      0        
831             ( $args{parsed}{month} eq __PACKAGE__->base->month and
832             $args{parsed}{day} < __PACKAGE__->base->day ) )
833             {
834 0         0 $args{parsed}{year} = __PACKAGE__->base->clone->add( years => 1 )->year;
835 0         0 return 1;
836             }
837             }
838 18         55 $args{parsed}{year} = __PACKAGE__->base->year;
839 18         2972 return 1;
840             }
841              
842             sub _fix_year
843             {
844 2800     2800   813859 my %args = @_;
845 2800 100       11395 return 1 if( length( $args{parsed}{year} ) == 4 );
846 693         2402 my $now = DateTime->now;
847 693         171696 $args{parsed}{year} = __PACKAGE__->_pick_year( $args{parsed}{year} , $now );
848 693         3812 return 1;
849             }
850              
851             sub _pick_year
852             {
853 699     699   4360 my ( $self , $year , $dt ) = @_;
854              
855 699 100       1958 if( $year > 69 )
856             {
857 139 100       432 if( $dt->strftime( '%y' ) > 69 )
858             {
859 1         32 $year = $dt->strftime( '%C' ) . sprintf( '%02s' , $year );
860             }
861             else
862             {
863 138         5043 $year = $dt->subtract( years => 100 )->strftime( '%C' ) .
864             sprintf( '%02s' , $year );
865             }
866             }
867             else
868             {
869 560 100       1626 if( $dt->strftime( '%y' ) > 69 )
870             {
871 1         33 $year = $dt->add( years => 100 )->strftime( '%C' ) .
872             sprintf( '%02s' , $year );
873             }
874             else
875             {
876 559         19719 $year = $dt->strftime( '%C' ) . sprintf( '%02s' , $year );
877             }
878             }
879 699         159678 return $year;
880             }
881              
882             1;
883              
884             __END__
885              
886             =encoding utf-8
887              
888             =head1 NAME
889              
890             DateTime::Format::Flexible - DateTime::Format::Flexible - Flexibly parse strings and turn them into DateTime objects.
891              
892             =head1 SYNOPSIS
893              
894             use DateTime::Format::Flexible;
895             my $dt = DateTime::Format::Flexible->parse_datetime(
896             'January 8, 1999'
897             );
898             # $dt = a DateTime object set at 1999-01-08T00:00:00
899              
900             =head1 DESCRIPTION
901              
902             If you have ever had to use a program that made you type in the
903             date a certain way and thought "Why can't the computer just figure
904             out what date I wanted?", this module is for you.
905              
906             F<DateTime::Format::Flexible> attempts to take any string you give
907             it and parse it into a DateTime object.
908              
909             =head1 USAGE
910              
911             This module uses F<DateTime::Format::Builder> under the covers.
912              
913             =head2 parse_datetime
914              
915             Give it a string and it attempts to parse it and return a DateTime
916             object.
917              
918             If it cannot it will throw an exception.
919              
920             my $dt = DateTime::Format::Flexible->parse_datetime( $date );
921              
922             my $dt = DateTime::Format::Flexible->parse_datetime(
923             $date,
924             strip => [qr{\.\z}], # optional, remove a trailing period
925             tz_map => {EDT => 'America/New_York'}, # optional, map the EDT timezone to America/New_York
926             lang => ['es'], # optional, only parse using spanish
927             european => 1, # optional, catch some cases of DD-MM-YY
928             );
929              
930             =over 4
931              
932             =item * C<base> (optional)
933              
934             Does the same thing as the method C<base>. Sets a base datetime for
935             incomplete dates. Requires a valid DateTime object as an argument.
936              
937             example:
938              
939             my $base_dt = DateTime->new( year => 2005, month => 2, day => 1 );
940             my $dt = DateTime::Format::Flexible->parse_datetime(
941             '18 Mar',
942             base => $base_dt,
943             );
944             # $dt is now 2005-03-18T00:00:00
945              
946             =item * C<strip> (optional)
947              
948             Remove a substring from the string you are trying to parse.
949             You can pass multiple regexes in an arrayref.
950              
951             example:
952              
953             my $dt = DateTime::Format::Flexible->parse_datetime(
954             '2011-04-26 00:00:00 (registry time)',
955             strip => [qr{\(registry time\)\z}],
956             );
957             # $dt is now 2011-04-26T00:00:00
958              
959             This is helpful if you have a load of dates you want to normalize
960             and you know of some weird formatting beforehand.
961              
962             =item * C<tz_map> (optional)
963              
964             Map a given timezone to another recognized timezone
965             Values are given as a hashref.
966              
967             example:
968              
969             my $dt = DateTime::Format::Flexible->parse_datetime(
970             '25-Jun-2009 EDT',
971             tz_map => {EDT => 'America/New_York'},
972             );
973             # $dt is now 2009-06-25T00:00:00 with a timezone of America/New_York
974              
975             This is helpful if you have a load of dates that have timezones that
976             are not recognized by F<DateTime::Timezone>.
977              
978             =item * C<lang> (optional)
979              
980             Specify the language map plugins to use.
981              
982             When DateTime::Format::Flexible parses a date with a string in it,
983             it will search for a way to convert that string to a number. By
984             default it will search through all the language plugins to search
985             for a match.
986              
987             NOTE: as of 0.22, it will only do this search if it detects a string
988             in the given date.
989              
990             Setting C<lang> this lets you limit the scope of the search.
991              
992             example:
993              
994             my $dt = DateTime::Format::Flexible->parse_datetime(
995             'Wed, Jun 10, 2009',
996             lang => ['en'],
997             );
998             # $dt is now 2009-06-10T00:00:00
999              
1000             Currently supported languages are english (en), spanish (es) and
1001             german (de). Contributions, corrections, requests and examples
1002             are VERY welcome.
1003              
1004             See the F<DateTime::Format::Flexible::lang::en>,
1005             F<DateTime::Format::Flexible::lang::es>, and
1006             F<DateTime::Format::Flexible::lang::de>
1007             for examples of the plugins.
1008              
1009             =item * C<european> (optional)
1010              
1011             If european is set to a true value, an attempt will be made to parse
1012             as a DD-MM-YYYY date instead of the default MM-DD-YYYY. There is a
1013             chance that this will not do the right thing due to ambiguity.
1014              
1015             example:
1016              
1017             my $dt = DateTime::Format::Flexible->parse_datetime(
1018             '16/06/2010' , european => 1,
1019             );
1020             # $dt is now 2010-06-16T00:00:00
1021              
1022             =item * C<MMYY> (optional)
1023              
1024             By default, this module will parse 12/10 as December 10th of the
1025             current year (MM/DD).
1026              
1027             If you want it to parse this as MM/YY instead, you can enable the
1028             C<MMYY> option.
1029              
1030             example:
1031              
1032             my $dt = DateTime::Format::Flexible->parse_datetime('12/10');
1033             # $dt is now [current year]-12-10T00:00:00
1034              
1035             my $dt = DateTime::Format::Flexible->parse_datetime(
1036             '12/10', MMYY => 1,
1037             );
1038             # $dt is now 2010-12-01T00:00:00
1039              
1040             This is useful if you know you are going to be parsing a credit card
1041             expiration date.
1042              
1043             =back
1044              
1045             =head2 base
1046              
1047             gets/sets the base DateTime for incomplete dates. Requires a valid
1048             DateTime object as an argument when setting. This defaults to
1049             DateTime->now.
1050              
1051             example:
1052              
1053             DateTime::Format::Flexible->base( DateTime->new(
1054             year => 2009, month => 6, day => 22
1055             ));
1056             my $dt = DateTime::Format::Flexible->parse_datetime( '23:59' );
1057             # $dt is now 2009-06-22T23:59:00
1058              
1059             =head2 build
1060              
1061             an alias for parse_datetime
1062              
1063             =head2 Example formats
1064              
1065             A small list of supported formats:
1066              
1067             =over 4
1068              
1069             =item YYYYMMDDTHHMMSS
1070              
1071             =item YYYYMMDDTHHMM
1072              
1073             =item YYYYMMDDTHH
1074              
1075             =item YYYYMMDD
1076              
1077             =item YYYYMM
1078              
1079             =item MM-DD-YYYY
1080              
1081             =item MM-D-YYYY
1082              
1083             =item MM-DD-YY
1084              
1085             =item M-DD-YY
1086              
1087             =item YYYY/DD/MM
1088              
1089             =item YYYY/M/DD
1090              
1091             =item YYYY/MM/D
1092              
1093             =item M-D
1094              
1095             =item MM-D
1096              
1097             =item M-D-Y
1098              
1099             =item Month D, YYYY
1100              
1101             =item Mon D, YYYY
1102              
1103             =item Mon D, YYYY HH:MM:SS
1104              
1105             =item ... thousands more
1106              
1107             =back
1108              
1109             there are 9000+ variations that are detected correctly in the test
1110             files (see t/data/* for most of them). If you can think of any that
1111             I do not cover, please let me know.
1112              
1113             =head1 NOTES
1114              
1115             As of version 0.11 you will get a DateTime::Infinite::Future object
1116             if the passed in date is 'infinity' and a DateTime::Infinite::Past
1117             object if the passed in date is '-infinity'. If you are expecting
1118             these types of strings, you might want to check for
1119             'is_infinite()' from the object returned.
1120              
1121             example:
1122              
1123             my $dt = DateTime::Format::Flexible->parse_datetime( 'infinity' );
1124             if ( $dt->is_infinite )
1125             {
1126             # you have a Infinite object.
1127             }
1128              
1129             =head1 BUGS/LIMITATIONS
1130              
1131             You cannot use a 1 or 2 digit year as the first field unless the
1132             year is > 31:
1133              
1134             YY-MM-DD # not supported if YY is <= 31
1135             Y-MM-DD # not supported
1136              
1137             It gets confused with MM-DD-YY
1138              
1139             =head1 AUTHOR
1140              
1141             Tom Heady <cpan@punch.net>
1142              
1143             =head1 COPYRIGHT & LICENSE
1144              
1145             Copyright 2007-2018 Tom Heady.
1146              
1147             This program is free software; you can redistribute it and/or
1148             modify it under the terms of either:
1149              
1150             =over 4
1151              
1152             =item * the GNU General Public License as published by the Free
1153             Software Foundation; either version 1, or (at your option) any
1154             later version, or
1155              
1156             =item * the Artistic License.
1157              
1158             =back
1159              
1160             =head1 SEE ALSO
1161              
1162             F<DateTime::Format::Builder>, F<DateTime::Timezone>, F<DateTime::Format::Natural>
1163              
1164             =cut