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