line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
|
2
|
|
|
|
|
|
|
use warnings; |
3
|
4
|
|
|
4
|
|
482348
|
use strict; |
|
4
|
|
|
|
|
36
|
|
|
4
|
|
|
|
|
122
|
|
4
|
4
|
|
|
4
|
|
18
|
|
|
4
|
|
|
|
|
7
|
|
|
4
|
|
|
|
|
76
|
|
5
|
|
|
|
|
|
|
use constant DEBUG => 0; |
6
|
4
|
|
|
4
|
|
16
|
our $VERSION = '0.091'; |
|
4
|
|
|
|
|
7
|
|
|
4
|
|
|
|
|
527
|
|
7
|
|
|
|
|
|
|
|
8
|
|
|
|
|
|
|
=encoding UTF-8 |
9
|
|
|
|
|
|
|
|
10
|
|
|
|
|
|
|
=head1 NAME |
11
|
|
|
|
|
|
|
|
12
|
|
|
|
|
|
|
DateTimeX::Easy - Parse a date/time string using the best method available |
13
|
|
|
|
|
|
|
|
14
|
|
|
|
|
|
|
=head1 SYNOPSIS |
15
|
|
|
|
|
|
|
|
16
|
|
|
|
|
|
|
# Make DateTimeX object for "now": |
17
|
|
|
|
|
|
|
my $dt = DateTimeX::Easy->new("today"); |
18
|
|
|
|
|
|
|
|
19
|
|
|
|
|
|
|
# Same thing: |
20
|
|
|
|
|
|
|
my $dt = DateTimeX::Easy->new("now"); |
21
|
|
|
|
|
|
|
|
22
|
|
|
|
|
|
|
# Uses ::F::Natural's coolness (similar in capability to Date::Manip) |
23
|
|
|
|
|
|
|
my $dt = DateTimeX::Easy->new("last monday"); |
24
|
|
|
|
|
|
|
|
25
|
|
|
|
|
|
|
# ... but in 1969: |
26
|
|
|
|
|
|
|
my $dt = DateTimeX::Easy->new("last monday", year => 1969); |
27
|
|
|
|
|
|
|
|
28
|
|
|
|
|
|
|
# ... at the 100th nanosecond: |
29
|
|
|
|
|
|
|
my $dt = DateTimeX::Easy->new("last monday", year => 1969, nanosecond => 100); |
30
|
|
|
|
|
|
|
|
31
|
|
|
|
|
|
|
# ... in US/Eastern: (This will NOT do a timezone conversion) |
32
|
|
|
|
|
|
|
my $dt = DateTimeX::Easy->new("last monday", year => 1969, nanosecond => 100, timezone => "US/Eastern"); |
33
|
|
|
|
|
|
|
|
34
|
|
|
|
|
|
|
# This WILL do a proper timezone conversion: |
35
|
|
|
|
|
|
|
my $dt = DateTimeX::Easy->new("last monday", year => 1969, nanosecond => 100, timezone => "US/Pacific"); |
36
|
|
|
|
|
|
|
$dt->set_time_zone("US/Eastern"); |
37
|
|
|
|
|
|
|
|
38
|
|
|
|
|
|
|
# Custom DateTimeX ability: |
39
|
|
|
|
|
|
|
my $dt = DateTimeX::Easy->new("last second of last month"); |
40
|
|
|
|
|
|
|
$dt = DateTimeX::Easy->new("last second of first month of last year"); |
41
|
|
|
|
|
|
|
$dt = DateTimeX::Easy->new("last second of first month of 2000"); |
42
|
|
|
|
|
|
|
|
43
|
|
|
|
|
|
|
=head1 DESCRIPTION |
44
|
|
|
|
|
|
|
|
45
|
|
|
|
|
|
|
DateTimeX::Easy makes DateTime object creation quick and easy. It uses a |
46
|
|
|
|
|
|
|
variety of DateTime::Format packages to do the bulk of the parsing, with some |
47
|
|
|
|
|
|
|
custom tweaks to smooth out the rough edges (mainly concerning timezone |
48
|
|
|
|
|
|
|
detection and selection). |
49
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
=head1 PARSING |
51
|
|
|
|
|
|
|
|
52
|
|
|
|
|
|
|
Currently, DateTimeX::Easy will attempt to parse input in the following order: |
53
|
|
|
|
|
|
|
|
54
|
|
|
|
|
|
|
=over |
55
|
|
|
|
|
|
|
|
56
|
|
|
|
|
|
|
=item DateTime - Is the input a DateTime object? |
57
|
|
|
|
|
|
|
|
58
|
|
|
|
|
|
|
=item ICal - Was DT::F::ICal able to parse the input? |
59
|
|
|
|
|
|
|
|
60
|
|
|
|
|
|
|
=item DateParse - Was DT::F::DateParse able to parse the input? |
61
|
|
|
|
|
|
|
|
62
|
|
|
|
|
|
|
A caveat, I actually use a modified version of DateParse in order to avoid |
63
|
|
|
|
|
|
|
DateParse's default timezone selection. |
64
|
|
|
|
|
|
|
|
65
|
|
|
|
|
|
|
=item Natural - Was DT::F::Natural able to parse the input? |
66
|
|
|
|
|
|
|
|
67
|
|
|
|
|
|
|
Since this module barfs pretty loudly on strange input, we use a silent |
68
|
|
|
|
|
|
|
$SIG{__WARN__} to hide errors. |
69
|
|
|
|
|
|
|
|
70
|
|
|
|
|
|
|
=item Flexible - Was DT::F::Flexible able to parse the input? |
71
|
|
|
|
|
|
|
|
72
|
|
|
|
|
|
|
This step also looks at the string to see if there is any timezone information |
73
|
|
|
|
|
|
|
at the end. |
74
|
|
|
|
|
|
|
|
75
|
|
|
|
|
|
|
=item DateManip - Was DT::F::DateManip able to parse the input? |
76
|
|
|
|
|
|
|
|
77
|
|
|
|
|
|
|
DateManip isn't very nice with preserving the input timezone, but it's here as |
78
|
|
|
|
|
|
|
a last resort. |
79
|
|
|
|
|
|
|
|
80
|
|
|
|
|
|
|
=back |
81
|
|
|
|
|
|
|
|
82
|
|
|
|
|
|
|
=head1 "last second of first month of year of 2005" |
83
|
|
|
|
|
|
|
|
84
|
|
|
|
|
|
|
DateTimeX::Easy also provides additional parsing and transformation for input |
85
|
|
|
|
|
|
|
like: |
86
|
|
|
|
|
|
|
|
87
|
|
|
|
|
|
|
"first day of last month" |
88
|
|
|
|
|
|
|
"last day of last month" |
89
|
|
|
|
|
|
|
"last day of this month" |
90
|
|
|
|
|
|
|
"last day of next month" |
91
|
|
|
|
|
|
|
"last second of first month of last year" |
92
|
|
|
|
|
|
|
"ending day of month of 2007-10-02" |
93
|
|
|
|
|
|
|
"last second of first month of year of 2005" |
94
|
|
|
|
|
|
|
"last second of last month of year of 2005" |
95
|
|
|
|
|
|
|
"beginning day of month of 2007-10-02" |
96
|
|
|
|
|
|
|
"last month of year of 2007" |
97
|
|
|
|
|
|
|
|
98
|
|
|
|
|
|
|
It will look at each sequence of "<first|last> of <period>" and do ->add, |
99
|
|
|
|
|
|
|
->subtract, and ->truncate operations on the parsed DateTime object |
100
|
|
|
|
|
|
|
|
101
|
|
|
|
|
|
|
Also, It's best to be as explicit as possible; the following will work: |
102
|
|
|
|
|
|
|
|
103
|
|
|
|
|
|
|
"last month of 2007" |
104
|
|
|
|
|
|
|
"last second of last month of 2005" |
105
|
|
|
|
|
|
|
"beginning day of 2007-10-02" |
106
|
|
|
|
|
|
|
|
107
|
|
|
|
|
|
|
This won't, though: |
108
|
|
|
|
|
|
|
|
109
|
|
|
|
|
|
|
"last day of 2007" |
110
|
|
|
|
|
|
|
|
111
|
|
|
|
|
|
|
You'll have to do this instead: |
112
|
|
|
|
|
|
|
|
113
|
|
|
|
|
|
|
"last day of year of 2007" |
114
|
|
|
|
|
|
|
|
115
|
|
|
|
|
|
|
The reason is that the date portion is opaque to the parser. It doesn't know |
116
|
|
|
|
|
|
|
whether it has "2007" or "2007-10" or "now" as the last input. To fix this, you |
117
|
|
|
|
|
|
|
can give a hint to the parser, like "<period> of <date/time>" (as in "year of |
118
|
|
|
|
|
|
|
2007" above). |
119
|
|
|
|
|
|
|
|
120
|
|
|
|
|
|
|
WARNING: This feature is still somewhat new, so there may be bugs lurking |
121
|
|
|
|
|
|
|
about. Please forward failing tests/scenarios. |
122
|
|
|
|
|
|
|
|
123
|
|
|
|
|
|
|
=head1 METHODS |
124
|
|
|
|
|
|
|
|
125
|
|
|
|
|
|
|
=head2 DateTimeX::Easy->new( ... ) |
126
|
|
|
|
|
|
|
|
127
|
|
|
|
|
|
|
=head2 DateTimeX::Easy->parse( ... ) |
128
|
|
|
|
|
|
|
|
129
|
|
|
|
|
|
|
=head2 DateTimeX::Easy->parse_date( ... ) |
130
|
|
|
|
|
|
|
|
131
|
|
|
|
|
|
|
=head2 DateTimeX::Easy->parse_datetime( ... ) |
132
|
|
|
|
|
|
|
|
133
|
|
|
|
|
|
|
=head2 DateTimeX::Easy->date( ... ) |
134
|
|
|
|
|
|
|
|
135
|
|
|
|
|
|
|
=head2 DateTimeX::Easy->datetime( ... ) |
136
|
|
|
|
|
|
|
|
137
|
|
|
|
|
|
|
=head2 DateTimeX::Easy->new_date( ... ) |
138
|
|
|
|
|
|
|
|
139
|
|
|
|
|
|
|
=head2 DateTimeX::Easy->new_datetime( ... ) |
140
|
|
|
|
|
|
|
|
141
|
|
|
|
|
|
|
Parse the given date/time specification using ::F::Flexible or ::F::Natural and use the result to create a L<DateTime> object. Returns a L<DateTime> object. |
142
|
|
|
|
|
|
|
|
143
|
|
|
|
|
|
|
You can pass the following in: |
144
|
|
|
|
|
|
|
|
145
|
|
|
|
|
|
|
parse # The string or DateTime object to parse. |
146
|
|
|
|
|
|
|
|
147
|
|
|
|
|
|
|
year # A year to override the result of parsing |
148
|
|
|
|
|
|
|
month # A month to override the result of parsing |
149
|
|
|
|
|
|
|
day # A day to override the result of parsing |
150
|
|
|
|
|
|
|
hour # A hour to override the result of parsing |
151
|
|
|
|
|
|
|
minute # A minute to override the result of parsing |
152
|
|
|
|
|
|
|
second # A second to override the result of parsing |
153
|
|
|
|
|
|
|
|
154
|
|
|
|
|
|
|
truncate # A truncation parameter (e.g. year, day, month, week, etc.) |
155
|
|
|
|
|
|
|
|
156
|
|
|
|
|
|
|
time_zone # - Can be: |
157
|
|
|
|
|
|
|
timezone # * A timezone (e.g. US/Pacific, UTC, etc.) |
158
|
|
|
|
|
|
|
tz # * A DateTime special timezone (e.g. floating, local) |
159
|
|
|
|
|
|
|
# |
160
|
|
|
|
|
|
|
# - If neither "tz", "timezone", nor "time_zone" is set, then it'll use whatever is parsed. |
161
|
|
|
|
|
|
|
# - If no timezone is parsed, then the default is floating. |
162
|
|
|
|
|
|
|
# - If the given timezone is different from the parsed timezone, |
163
|
|
|
|
|
|
|
# then a time conversion will take place (unless "soft_time_zone_conversion" is set). |
164
|
|
|
|
|
|
|
# - Either "time_zone", "timezone", "tz" will work (in that order), with "time_zone" having highest precedence |
165
|
|
|
|
|
|
|
# - See below for examples! |
166
|
|
|
|
|
|
|
|
167
|
|
|
|
|
|
|
soft_time_zone_conversion # Set this flag to 1 if you don't want the time to change when a given timezone is |
168
|
|
|
|
|
|
|
# different from a parsed timezone. For example, "10:00 UTC" soft converted to |
169
|
|
|
|
|
|
|
# PST8PDT would be "10:00 PST8PDT". |
170
|
|
|
|
|
|
|
|
171
|
|
|
|
|
|
|
time_zone_if_floating # The value of this option should be a valid timezone. If this option is set, then a DateTime object |
172
|
|
|
|
|
|
|
# with a floating timezone has it's timezone set to the value. |
173
|
|
|
|
|
|
|
default_time_zone # Same as "time_zone_if_floating" |
174
|
|
|
|
|
|
|
|
175
|
|
|
|
|
|
|
ambiguous # Set this flag to 0 if you want to disallow ambiguous input like: |
176
|
|
|
|
|
|
|
# "last day of 2007" or "first minute of April" |
177
|
|
|
|
|
|
|
# This will require you to specify them as "last day of year of 2007" and "first minute of month of April" |
178
|
|
|
|
|
|
|
# instead. This flag is 1 (false) by default. |
179
|
|
|
|
|
|
|
|
180
|
|
|
|
|
|
|
... and anything else that you want to pass to the DateTime->new constructor |
181
|
|
|
|
|
|
|
|
182
|
|
|
|
|
|
|
If C<truncate> is specified, then DateTime->truncate will be run after object creation. |
183
|
|
|
|
|
|
|
|
184
|
|
|
|
|
|
|
Furthermore, you can simply pass the value for "parse" as the first positional argument of the DateTimeX::Easy call, e.g.: |
185
|
|
|
|
|
|
|
|
186
|
|
|
|
|
|
|
# This: |
187
|
|
|
|
|
|
|
DateTimeX::Easy->new("today", year => 2008, truncate => "hour"); |
188
|
|
|
|
|
|
|
|
189
|
|
|
|
|
|
|
# ... is the same as this: |
190
|
|
|
|
|
|
|
DateTimeX::Easy->new(parse => "today", year => 2008, truncate => "hour"); |
191
|
|
|
|
|
|
|
|
192
|
|
|
|
|
|
|
Timezone processing can be a little complicated. Here are some examples: |
193
|
|
|
|
|
|
|
|
194
|
|
|
|
|
|
|
DateTimeX::Easy->parse("today"); # Will use a floating timezone |
195
|
|
|
|
|
|
|
|
196
|
|
|
|
|
|
|
DateTimeX::Easy->parse("2007-07-01 10:32:10"); # Will ALSO use a floating timezone |
197
|
|
|
|
|
|
|
|
198
|
|
|
|
|
|
|
DateTimeX::Easy->parse("2007-07-01 10:32:10 US/Eastern"); # Will use US/Eastern as a timezone |
199
|
|
|
|
|
|
|
|
200
|
|
|
|
|
|
|
DateTimeX::Easy->parse("2007-07-01 10:32:10"); # Will use the floating timezone |
201
|
|
|
|
|
|
|
|
202
|
|
|
|
|
|
|
DateTimeX::Easy->parse("2007-07-01 10:32:10", time_zone_if_floating => "local"); # Will use the local timezone |
203
|
|
|
|
|
|
|
|
204
|
|
|
|
|
|
|
DateTimeX::Easy->parse("2007-07-01 10:32:10 UTC", time_zone => "US/Pacific"); # Will convert from UTC to US/Pacific |
205
|
|
|
|
|
|
|
|
206
|
|
|
|
|
|
|
my $dt = DateTime->now->set_time_zone("US/Eastern"); |
207
|
|
|
|
|
|
|
DateTimeX::Easy->parse($dt); # Will use US/Eastern as the timezone |
208
|
|
|
|
|
|
|
|
209
|
|
|
|
|
|
|
DateTimeX::Easy->parse($dt, time_zone => "floating"); # Will use a floating timezone |
210
|
|
|
|
|
|
|
|
211
|
|
|
|
|
|
|
DateTimeX::Easy->parse($dt, time_zone => "US/Pacific", soft_time_zone_conversion => 1); |
212
|
|
|
|
|
|
|
# Will use US/Pacific as the timezone with NO conversion |
213
|
|
|
|
|
|
|
# For example, "22:00 US/Eastern" will become "22:00 PST8PDT" |
214
|
|
|
|
|
|
|
|
215
|
|
|
|
|
|
|
DateTimeX::Easy->parse($dt)->set_time_zone("US/Pacific"); # Will use US/Pacific as the timezone WITH conversion |
216
|
|
|
|
|
|
|
# For example, "22:00 US/Eastern" will become "19:00 PST8PDT" |
217
|
|
|
|
|
|
|
|
218
|
|
|
|
|
|
|
DateTimeX::Easy->parse($dt, time_zone => "US/Pacific"); # Will ALSO use US/Pacific as the timezone WITH conversion |
219
|
|
|
|
|
|
|
|
220
|
|
|
|
|
|
|
=head1 EXPORT |
221
|
|
|
|
|
|
|
|
222
|
|
|
|
|
|
|
=head2 parse( ... ) |
223
|
|
|
|
|
|
|
|
224
|
|
|
|
|
|
|
=head2 parse_date( ... ) |
225
|
|
|
|
|
|
|
|
226
|
|
|
|
|
|
|
=head2 parse_datetime( ... ) |
227
|
|
|
|
|
|
|
|
228
|
|
|
|
|
|
|
=head2 date( ... ) |
229
|
|
|
|
|
|
|
|
230
|
|
|
|
|
|
|
=head2 datetime( ... ) |
231
|
|
|
|
|
|
|
|
232
|
|
|
|
|
|
|
=head2 new_date( ... ) |
233
|
|
|
|
|
|
|
|
234
|
|
|
|
|
|
|
=head2 new_datetime( ... ) |
235
|
|
|
|
|
|
|
|
236
|
|
|
|
|
|
|
Same syntax as above. See above for more information. |
237
|
|
|
|
|
|
|
|
238
|
|
|
|
|
|
|
=head1 MOTIVATION |
239
|
|
|
|
|
|
|
|
240
|
|
|
|
|
|
|
Although I really like using DateTime for date/time handling, I was often |
241
|
|
|
|
|
|
|
frustrated by its inability to parse even the simplest of date/time strings. |
242
|
|
|
|
|
|
|
There does exist a wide variety of DateTime::Format::* modules, but they all |
243
|
|
|
|
|
|
|
have different interfaces and different capabilities. Coming from a |
244
|
|
|
|
|
|
|
Date::Manip background, I wanted something that gave me the power of ParseDate |
245
|
|
|
|
|
|
|
while still returning a DateTime object. Most importantly, I wanted explicit |
246
|
|
|
|
|
|
|
control of the timezone setting at every step of the way. DateTimeX::Easy is |
247
|
|
|
|
|
|
|
the result. |
248
|
|
|
|
|
|
|
|
249
|
|
|
|
|
|
|
=head1 THANKS |
250
|
|
|
|
|
|
|
|
251
|
|
|
|
|
|
|
Dave Rolsky and crew for writing L<DateTime> |
252
|
|
|
|
|
|
|
|
253
|
|
|
|
|
|
|
=head1 SEE ALSO |
254
|
|
|
|
|
|
|
|
255
|
|
|
|
|
|
|
L<DateTime> |
256
|
|
|
|
|
|
|
|
257
|
|
|
|
|
|
|
L<DateTime::Format::Natural> |
258
|
|
|
|
|
|
|
|
259
|
|
|
|
|
|
|
L<DateTime::Format::Flexible> |
260
|
|
|
|
|
|
|
|
261
|
|
|
|
|
|
|
L<DateTime::Format::DateManip> |
262
|
|
|
|
|
|
|
|
263
|
|
|
|
|
|
|
L<DateTime::Format::ParseDate> |
264
|
|
|
|
|
|
|
|
265
|
|
|
|
|
|
|
L<DateTime::Format::ICal> |
266
|
|
|
|
|
|
|
|
267
|
|
|
|
|
|
|
L<Date::Manip> |
268
|
|
|
|
|
|
|
|
269
|
|
|
|
|
|
|
=head1 AUTHOR |
270
|
|
|
|
|
|
|
|
271
|
|
|
|
|
|
|
Robert Krimen <rokr@cpan.org> |
272
|
|
|
|
|
|
|
|
273
|
|
|
|
|
|
|
=head1 COPYRIGHT AND LICENSE |
274
|
|
|
|
|
|
|
|
275
|
|
|
|
|
|
|
This software is copyright (c) 2022 by Robert Krimen and others, see the git log. |
276
|
|
|
|
|
|
|
|
277
|
|
|
|
|
|
|
This is free software; you can redistribute it and/or modify it under |
278
|
|
|
|
|
|
|
the same terms as the Perl 5 programming language system itself. |
279
|
|
|
|
|
|
|
|
280
|
|
|
|
|
|
|
=cut |
281
|
|
|
|
|
|
|
|
282
|
|
|
|
|
|
|
use base qw/Exporter/; |
283
|
4
|
|
|
4
|
|
26
|
our @EXPORT_OK |
|
4
|
|
|
|
|
8
|
|
|
4
|
|
|
|
|
439
|
|
284
|
|
|
|
|
|
|
= qw/datetime parse parse_datetime parse_date new_datetime new_date date/; |
285
|
|
|
|
|
|
|
|
286
|
|
|
|
|
|
|
use DateTime; |
287
|
4
|
|
|
4
|
|
3083
|
use DateTime::Format::Natural; |
|
4
|
|
|
|
|
1841534
|
|
|
4
|
|
|
|
|
180
|
|
288
|
4
|
|
|
4
|
|
2208
|
use DateTime::Format::Flexible; |
|
4
|
|
|
|
|
150190
|
|
|
4
|
|
|
|
|
227
|
|
289
|
4
|
|
|
4
|
|
2169
|
|
|
4
|
|
|
|
|
899962
|
|
|
4
|
|
|
|
|
55
|
|
290
|
|
|
|
|
|
|
# use DateTime::Format::DateParse; # Unfortunately, not as useful to use because of that default "local" time zone business. |
291
|
|
|
|
|
|
|
use DateTimeX::Easy::DateParse; # Using this instead, hrm. |
292
|
4
|
|
|
4
|
|
2033
|
use Scalar::Util qw/blessed/; |
|
4
|
|
|
|
|
14
|
|
|
4
|
|
|
|
|
134
|
|
293
|
4
|
|
|
4
|
|
23
|
use Carp; |
|
4
|
|
|
|
|
11
|
|
|
4
|
|
|
|
|
175
|
|
294
|
4
|
|
|
4
|
|
21
|
|
|
4
|
|
|
|
|
8
|
|
|
4
|
|
|
|
|
6891
|
|
295
|
|
|
|
|
|
|
my $have_ICal; |
296
|
|
|
|
|
|
|
eval { |
297
|
|
|
|
|
|
|
require DateTime::Format::ICal; |
298
|
|
|
|
|
|
|
$have_ICal = 1; |
299
|
|
|
|
|
|
|
}; |
300
|
|
|
|
|
|
|
|
301
|
|
|
|
|
|
|
my $have_DateManip; |
302
|
|
|
|
|
|
|
eval { |
303
|
|
|
|
|
|
|
require DateTime::Format::DateManip; |
304
|
|
|
|
|
|
|
$have_DateManip = 1; |
305
|
|
|
|
|
|
|
}; |
306
|
|
|
|
|
|
|
my $natural_parser = DateTime::Format::Natural->new; |
307
|
|
|
|
|
|
|
|
308
|
|
|
|
|
|
|
my %_truncate_range = qw/ |
309
|
|
|
|
|
|
|
month year |
310
|
|
|
|
|
|
|
day month |
311
|
|
|
|
|
|
|
hour day |
312
|
|
|
|
|
|
|
minute hour |
313
|
|
|
|
|
|
|
second minute |
314
|
|
|
|
|
|
|
nanosecond second |
315
|
|
|
|
|
|
|
/; |
316
|
|
|
|
|
|
|
my %_delta_range = ( |
317
|
|
|
|
|
|
|
month => [qw/years months/], |
318
|
|
|
|
|
|
|
day => [qw/months days/], |
319
|
|
|
|
|
|
|
hour => [qw/days hours/], |
320
|
|
|
|
|
|
|
minute => [qw/hours minutes/], |
321
|
|
|
|
|
|
|
second => [qw/minutes seconds/], |
322
|
|
|
|
|
|
|
); |
323
|
|
|
|
|
|
|
my %_first_or_last = qw/ |
324
|
|
|
|
|
|
|
first first |
325
|
|
|
|
|
|
|
last last |
326
|
|
|
|
|
|
|
begin first |
327
|
|
|
|
|
|
|
beginning first |
328
|
|
|
|
|
|
|
start first |
329
|
|
|
|
|
|
|
end last |
330
|
|
|
|
|
|
|
ending last |
331
|
|
|
|
|
|
|
/; |
332
|
|
|
|
|
|
|
|
333
|
|
|
|
|
|
|
my @_parser_order = qw/ |
334
|
|
|
|
|
|
|
Flexible |
335
|
|
|
|
|
|
|
DateParse |
336
|
|
|
|
|
|
|
Natural |
337
|
|
|
|
|
|
|
/; |
338
|
|
|
|
|
|
|
unshift @_parser_order, qw/ICal/ if $have_ICal; |
339
|
|
|
|
|
|
|
push @_parser_order, qw/DateManip/ if $have_DateManip; |
340
|
|
|
|
|
|
|
my %_parser_source = ( |
341
|
|
|
|
|
|
|
ICal => sub { |
342
|
|
|
|
|
|
|
return DateTime::Format::ICal->parse_datetime(shift); |
343
|
|
|
|
|
|
|
}, |
344
|
|
|
|
|
|
|
|
345
|
|
|
|
|
|
|
DateParse => sub { |
346
|
|
|
|
|
|
|
return DateTimeX::Easy::DateParse->parse_datetime(shift); |
347
|
|
|
|
|
|
|
}, |
348
|
|
|
|
|
|
|
|
349
|
|
|
|
|
|
|
Natural => sub { |
350
|
|
|
|
|
|
|
local $SIG{__WARN__} = sub { |
351
|
|
|
|
|
|
|
}; # Make sure ::Natural/Date::Calc stay quiet... don't really like this, oh well... |
352
|
|
|
|
|
|
|
my $dt = $natural_parser->parse_datetime(shift); |
353
|
|
|
|
|
|
|
return unless $natural_parser->success; |
354
|
|
|
|
|
|
|
return $dt; |
355
|
|
|
|
|
|
|
}, |
356
|
|
|
|
|
|
|
|
357
|
|
|
|
|
|
|
Flexible => sub { |
358
|
|
|
|
|
|
|
my $parse = shift; |
359
|
|
|
|
|
|
|
my $time_zone; |
360
|
|
|
|
|
|
|
|
361
|
|
|
|
|
|
|
# First, try to extract out any timezone information |
362
|
|
|
|
|
|
|
{ |
363
|
|
|
|
|
|
|
################################################## |
364
|
|
|
|
|
|
|
# 2008-09-16 13:23:57 Eastern Daylight (?:Time)? # |
365
|
|
|
|
|
|
|
################################################## |
366
|
|
|
|
|
|
|
if ($parse |
367
|
|
|
|
|
|
|
=~ s/\s+(?:(Eastern|Central|Mountain|Pacific)\s+(?:Daylight|Standard)(?:\s+Time)?).*$// |
368
|
|
|
|
|
|
|
) |
369
|
|
|
|
|
|
|
{ |
370
|
|
|
|
|
|
|
$time_zone = "US/$1"; |
371
|
|
|
|
|
|
|
} |
372
|
|
|
|
|
|
|
################################## |
373
|
|
|
|
|
|
|
# 2008-09-16 13:23:57 US/Eastern # |
374
|
|
|
|
|
|
|
################################## |
375
|
|
|
|
|
|
|
elsif ($parse =~ s/\s+([A-Za-z][A-Za-z0-9\/\._]*)\s*$//) |
376
|
|
|
|
|
|
|
{ # Look for a timezone-like string at the end of $parse |
377
|
|
|
|
|
|
|
$time_zone = $1; |
378
|
|
|
|
|
|
|
$parse = "$parse $time_zone" and undef $time_zone |
379
|
|
|
|
|
|
|
if $time_zone |
380
|
|
|
|
|
|
|
&& $time_zone =~ m/^[ap]\.?m\.?$/i |
381
|
|
|
|
|
|
|
; # Put back AM/PM if we accidentally slurped it out |
382
|
|
|
|
|
|
|
} |
383
|
|
|
|
|
|
|
######################################################### |
384
|
|
|
|
|
|
|
# 2008-09-16 13:23:57 Eastern Daylight Time (GMT+05:00) # |
385
|
|
|
|
|
|
|
######################################################### |
386
|
|
|
|
|
|
|
elsif ($parse |
387
|
|
|
|
|
|
|
=~ s/(?:\s+[A-Z]\w+)*\s+\(?(?:GMT|UTC)?([-+]\d{2}:\d{2})\)?\s*$// |
388
|
|
|
|
|
|
|
) |
389
|
|
|
|
|
|
|
{ |
390
|
|
|
|
|
|
|
$time_zone = $1; |
391
|
|
|
|
|
|
|
} |
392
|
|
|
|
|
|
|
|
393
|
|
|
|
|
|
|
# Flexible can't seem to parse (GMT+0:500) |
394
|
|
|
|
|
|
|
# elsif ($parse =~ s/(?:\s+[A-Z]\w+)*(\s+\(GMT[-+]\d{2}:\d{2}\)\s*)$//) { |
395
|
|
|
|
|
|
|
# $parse = "$parse $1"; |
396
|
|
|
|
|
|
|
# } |
397
|
|
|
|
|
|
|
############################# |
398
|
|
|
|
|
|
|
# 2008-09-16 13:23:57 +0500 # |
399
|
|
|
|
|
|
|
############################# |
400
|
|
|
|
|
|
|
elsif ($parse =~ s/\s+([-+]\d{3,})\s*$//) { |
401
|
|
|
|
|
|
|
$time_zone = $1; |
402
|
|
|
|
|
|
|
} |
403
|
|
|
|
|
|
|
} |
404
|
|
|
|
|
|
|
return unless my $dt = DateTime::Format::Flexible->build($parse); |
405
|
|
|
|
|
|
|
if ($time_zone) { |
406
|
|
|
|
|
|
|
$dt->set_time_zone("floating"); |
407
|
|
|
|
|
|
|
$dt->set_time_zone($time_zone); |
408
|
|
|
|
|
|
|
} |
409
|
|
|
|
|
|
|
return $dt; |
410
|
|
|
|
|
|
|
}, |
411
|
|
|
|
|
|
|
|
412
|
|
|
|
|
|
|
DateManip => sub { |
413
|
|
|
|
|
|
|
return DateTime::Format::DateManip->parse_datetime(shift); |
414
|
|
|
|
|
|
|
}, |
415
|
|
|
|
|
|
|
); |
416
|
|
|
|
|
|
|
|
417
|
|
|
|
|
|
|
shift if $_[0] && $_[0] eq __PACKAGE__; |
418
|
|
|
|
|
|
|
|
419
|
61
|
100
|
66
|
61
|
1
|
85162
|
my $parse; |
420
|
|
|
|
|
|
|
$parse = shift if @_ % 2; |
421
|
61
|
|
|
|
|
127
|
|
422
|
61
|
100
|
|
|
|
234
|
my %in = @_; |
423
|
|
|
|
|
|
|
$parse = delete $in{parse} if exists $in{parse}; |
424
|
61
|
|
|
|
|
174
|
my $truncate = delete $in{truncate}; |
425
|
61
|
100
|
|
|
|
198
|
my $soft_time_zone_conversion = delete $in{soft_time_zone_conversion}; |
426
|
61
|
|
|
|
|
130
|
my $time_zone_if_floating = delete $in{default_time_zone}; |
427
|
61
|
|
|
|
|
125
|
$time_zone_if_floating = delete $in{time_zone_if_floating} |
428
|
61
|
|
|
|
|
121
|
if exists $in{time_zone_if_floating}; |
429
|
|
|
|
|
|
|
my $parser_order = delete $in{parser_order}; |
430
|
61
|
100
|
|
|
|
167
|
my $parser_exclude = delete $in{parser_exclude}; |
431
|
61
|
|
|
|
|
108
|
my $ambiguous = 1; |
432
|
61
|
|
|
|
|
110
|
$ambiguous = delete $in{ambiguous} if exists $in{ambiguous}; |
433
|
61
|
|
|
|
|
419
|
|
434
|
61
|
100
|
|
|
|
165
|
my ($time_zone); |
435
|
|
|
|
|
|
|
$time_zone = delete $in{tz} if exists $in{tz}; |
436
|
61
|
|
|
|
|
97
|
$time_zone = delete $in{timezone} if exists $in{timezone}; |
437
|
61
|
50
|
|
|
|
164
|
$time_zone = delete $in{time_zone} |
438
|
61
|
100
|
|
|
|
175
|
if exists $in{time_zone} |
439
|
|
|
|
|
|
|
; # "time_zone" takes precedence over "timezone" |
440
|
|
|
|
|
|
|
|
441
|
61
|
100
|
|
|
|
145
|
my @delta; |
442
|
|
|
|
|
|
|
|
443
|
61
|
|
|
|
|
92
|
my $original_parse = $parse; |
444
|
|
|
|
|
|
|
my $parse_dt; |
445
|
61
|
|
|
|
|
89
|
if ($parse) { |
446
|
61
|
|
|
|
|
82
|
if (blessed $parse && $parse->isa("DateTime")) |
447
|
61
|
50
|
|
|
|
138
|
{ # We have a DateTime object as $parse |
448
|
61
|
100
|
66
|
|
|
341
|
$parse_dt = $parse; |
449
|
|
|
|
|
|
|
} |
450
|
6
|
|
|
|
|
9
|
else { |
451
|
|
|
|
|
|
|
|
452
|
|
|
|
|
|
|
if (1) { |
453
|
|
|
|
|
|
|
my $got_ambiguous; |
454
|
55
|
|
|
|
|
84
|
my ($last_delta); |
455
|
55
|
|
|
|
|
92
|
while ($parse |
456
|
|
|
|
|
|
|
=~ s/^\s*(start|first|last|(?:begin|end)(?:ning)?)\s+(year|month|day|hour|minute|second)\s+of\s+//i |
457
|
55
|
|
|
|
|
352
|
) |
458
|
|
|
|
|
|
|
{ |
459
|
|
|
|
|
|
|
my $first_or_last = $1; |
460
|
|
|
|
|
|
|
$first_or_last = $_first_or_last{ lc $first_or_last }; |
461
|
8
|
|
|
|
|
24
|
my $period = $2; |
462
|
8
|
|
|
|
|
36
|
$last_delta->{add} = ["${period}s" => 1] if $last_delta; |
463
|
8
|
|
|
|
|
18
|
push @delta, |
464
|
8
|
50
|
|
|
|
39
|
$last_delta = my $delta = { period => $period }; |
465
|
8
|
|
|
|
|
30
|
if ($first_or_last ne "first") { |
466
|
|
|
|
|
|
|
$delta->{last} = 1; |
467
|
8
|
100
|
|
|
|
27
|
$delta->{subtract} = ["${period}s" => 1]; |
468
|
6
|
|
|
|
|
14
|
} |
469
|
6
|
|
|
|
|
33
|
else { |
470
|
|
|
|
|
|
|
$delta->{first} = 1; |
471
|
|
|
|
|
|
|
} |
472
|
2
|
|
|
|
|
8
|
} |
473
|
|
|
|
|
|
|
my $last_parse = $parse; |
474
|
|
|
|
|
|
|
my $period; |
475
|
55
|
|
|
|
|
103
|
if ($parse |
476
|
55
|
|
|
|
|
84
|
=~ s/^\s*(start|this|next|first|last|(?:begin|end)(?:ning)?)\s+(year|month|day|hour|minute|second)(?:\s+of\s+)?// |
477
|
55
|
50
|
|
|
|
366
|
) |
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
478
|
|
|
|
|
|
|
{ |
479
|
|
|
|
|
|
|
$period = $2; |
480
|
|
|
|
|
|
|
$last_delta->{add} = ["${period}s" => 1] |
481
|
0
|
|
|
|
|
0
|
if $last_delta && $last_delta->{last}; |
482
|
|
|
|
|
|
|
push @delta, { truncate => $period }; |
483
|
0
|
0
|
0
|
|
|
0
|
$parse = $last_parse unless $parse; |
484
|
0
|
|
|
|
|
0
|
} |
485
|
0
|
0
|
|
|
|
0
|
elsif ($parse |
486
|
|
|
|
|
|
|
=~ s/^\s*(year|month|day|hour|minute|second)\s+of\s+//i) |
487
|
|
|
|
|
|
|
{ |
488
|
|
|
|
|
|
|
$period = $1; |
489
|
|
|
|
|
|
|
$last_delta->{add} = ["${period}s" => 1] |
490
|
4
|
|
|
|
|
7
|
if $last_delta && $last_delta->{last}; |
491
|
|
|
|
|
|
|
push @delta, { truncate => $period }; |
492
|
4
|
100
|
66
|
|
|
26
|
} |
493
|
4
|
|
|
|
|
15
|
elsif (@delta) { |
494
|
|
|
|
|
|
|
$got_ambiguous = 1; |
495
|
|
|
|
|
|
|
$period = $last_delta->{period}; |
496
|
4
|
|
|
|
|
9
|
my $truncate = $_truncate_range{$period}; |
497
|
4
|
|
|
|
|
10
|
push @delta, my $delta = { truncate => $truncate }; |
498
|
4
|
|
|
|
|
10
|
my $delta_range = $_delta_range{$period}; |
499
|
4
|
|
|
|
|
15
|
if ($delta_range) { |
500
|
4
|
|
|
|
|
10
|
my ($add, $subtract) = @$delta_range; |
501
|
4
|
50
|
|
|
|
11
|
if ($last_delta->{last}) { |
502
|
4
|
|
|
|
|
14
|
$last_delta->{add} = ["${add}" => 1]; |
503
|
4
|
100
|
|
|
|
10
|
} |
504
|
3
|
|
|
|
|
12
|
} |
505
|
|
|
|
|
|
|
} |
506
|
|
|
|
|
|
|
|
507
|
|
|
|
|
|
|
croak |
508
|
|
|
|
|
|
|
"Can't parse \"$original_parse\" since it's too ambiguous" |
509
|
|
|
|
|
|
|
if $got_ambiguous && !$ambiguous; |
510
|
55
|
100
|
100
|
|
|
205
|
} |
511
|
|
|
|
|
|
|
|
512
|
|
|
|
|
|
|
my @parser_order |
513
|
|
|
|
|
|
|
= $parser_order |
514
|
|
|
|
|
|
|
? ( |
515
|
54
|
0
|
|
|
|
217
|
ref $parser_order eq "ARRAY" |
|
|
50
|
|
|
|
|
|
516
|
|
|
|
|
|
|
? @$parser_order |
517
|
|
|
|
|
|
|
: ($parser_order)) |
518
|
|
|
|
|
|
|
: @_parser_order; |
519
|
|
|
|
|
|
|
my (%parser_exclude); |
520
|
|
|
|
|
|
|
%parser_exclude |
521
|
54
|
|
|
|
|
87
|
= map { $_ => 1 } |
522
|
|
|
|
|
|
|
( |
523
|
54
|
0
|
|
|
|
117
|
ref $parser_exclude eq "ARRAY" |
|
0
|
50
|
|
|
|
0
|
|
524
|
|
|
|
|
|
|
? @$parser_exclude |
525
|
|
|
|
|
|
|
: ($parser_exclude)) |
526
|
|
|
|
|
|
|
if $parser_exclude; |
527
|
|
|
|
|
|
|
my %parser_source = %_parser_source; |
528
|
|
|
|
|
|
|
if (DEBUG) { |
529
|
54
|
|
|
|
|
261
|
warn "Parse $parse\n"; |
530
|
54
|
|
|
|
|
91
|
} |
531
|
|
|
|
|
|
|
|
532
|
|
|
|
|
|
|
# TODO Kinda hackish |
533
|
|
|
|
|
|
|
if ($parse =~ m/^[1-9]\d{3}$/) |
534
|
|
|
|
|
|
|
{ # If it's a four digit year... yeah, arbitrary |
535
|
54
|
100
|
|
|
|
175
|
$parse_dt = DateTime->new(year => $parse); |
536
|
|
|
|
|
|
|
} |
537
|
3
|
|
|
|
|
15
|
while (!$parse_dt && @parser_order) { |
538
|
|
|
|
|
|
|
my $parser = shift @parser_order; |
539
|
54
|
|
66
|
|
|
1125
|
next if $parser_exclude{$parser}; |
540
|
116
|
|
|
|
|
11478
|
|
541
|
116
|
50
|
|
|
|
282
|
# warn "Try $parser:\n" if DEBUG; |
542
|
|
|
|
|
|
|
my $parser_code = $parser_source{$parser}; |
543
|
|
|
|
|
|
|
eval { $parse_dt = $parser_code->($parse); }; |
544
|
116
|
|
|
|
|
180
|
if (DEBUG) { |
545
|
116
|
|
|
|
|
209
|
if ($@) { |
|
116
|
|
|
|
|
382
|
|
546
|
116
|
|
|
|
|
49803
|
warn "FAIL $parser: $@\n"; |
547
|
|
|
|
|
|
|
} |
548
|
|
|
|
|
|
|
elsif ($parse_dt) { |
549
|
|
|
|
|
|
|
warn "PASS $parser: $parse_dt\n"; |
550
|
|
|
|
|
|
|
} |
551
|
|
|
|
|
|
|
else { |
552
|
|
|
|
|
|
|
warn "FAIL $parser\n"; |
553
|
|
|
|
|
|
|
} |
554
|
|
|
|
|
|
|
} |
555
|
|
|
|
|
|
|
undef $parse_dt if $@; |
556
|
|
|
|
|
|
|
} |
557
|
116
|
100
|
|
|
|
540
|
} |
558
|
|
|
|
|
|
|
return unless $parse_dt; |
559
|
|
|
|
|
|
|
} |
560
|
60
|
50
|
|
|
|
439
|
|
561
|
|
|
|
|
|
|
my %DateTime; |
562
|
|
|
|
|
|
|
$DateTime{time_zone} = "floating"; |
563
|
60
|
|
|
|
|
310
|
if ($parse_dt) { |
564
|
60
|
|
|
|
|
158
|
$DateTime{$_} = $parse_dt->$_ |
565
|
60
|
50
|
|
|
|
158
|
for qw/year month day hour minute second nanosecond time_zone/; |
566
|
|
|
|
|
|
|
} |
567
|
60
|
|
|
|
|
489
|
@DateTime{ keys %in } = values %in; |
568
|
|
|
|
|
|
|
|
569
|
60
|
|
|
|
|
2290
|
return unless my $dt = DateTime->new(%DateTime); |
570
|
|
|
|
|
|
|
|
571
|
60
|
50
|
|
|
|
241
|
if ($time_zone) { |
572
|
|
|
|
|
|
|
if ($soft_time_zone_conversion) { |
573
|
60
|
100
|
66
|
|
|
19240
|
$dt->set_time_zone("floating"); |
|
|
100
|
|
|
|
|
|
574
|
13
|
100
|
|
|
|
68
|
} |
575
|
1
|
|
|
|
|
5
|
$dt->set_time_zone($time_zone); |
576
|
|
|
|
|
|
|
} |
577
|
13
|
|
|
|
|
219
|
elsif ($time_zone_if_floating && $dt->time_zone->is_floating) { |
578
|
|
|
|
|
|
|
$dt->set_time_zone($time_zone_if_floating); |
579
|
|
|
|
|
|
|
} |
580
|
1
|
|
|
|
|
13
|
|
581
|
|
|
|
|
|
|
if ($truncate) { |
582
|
|
|
|
|
|
|
$truncate = $truncate->[1] if ref $truncate eq "ARRAY"; |
583
|
60
|
100
|
|
|
|
5837
|
$truncate = (values %$truncate)[0] if ref $truncate eq "HASH"; |
|
|
100
|
|
|
|
|
|
584
|
1
|
50
|
|
|
|
4
|
$dt->truncate(to => $truncate); |
585
|
1
|
50
|
|
|
|
3
|
} |
586
|
1
|
|
|
|
|
6
|
elsif (@delta) { |
587
|
|
|
|
|
|
|
if (DEBUG) { |
588
|
|
|
|
|
|
|
require YAML; |
589
|
7
|
|
|
|
|
14
|
warn "$original_parse => $parse => $dt"; |
590
|
|
|
|
|
|
|
} |
591
|
|
|
|
|
|
|
for my $delta (reverse @delta) { |
592
|
|
|
|
|
|
|
warn YAML::Dump($delta) if DEBUG; |
593
|
7
|
|
|
|
|
15
|
if ($delta->{truncate}) { |
594
|
14
|
|
|
|
|
1635
|
$dt->truncate(to => $delta->{truncate}); |
595
|
14
|
100
|
|
|
|
31
|
} |
596
|
7
|
|
|
|
|
32
|
else { |
597
|
|
|
|
|
|
|
$dt->add(@{ $delta->{add} }) if $delta->{add}; |
598
|
|
|
|
|
|
|
$dt->subtract(@{ $delta->{subtract} }) if $delta->{subtract}; |
599
|
7
|
100
|
|
|
|
22
|
} |
|
5
|
|
|
|
|
26
|
|
600
|
7
|
100
|
|
|
|
5196
|
} |
|
5
|
|
|
|
|
22
|
|
601
|
|
|
|
|
|
|
} |
602
|
|
|
|
|
|
|
|
603
|
|
|
|
|
|
|
return $dt; |
604
|
|
|
|
|
|
|
} |
605
|
60
|
|
|
|
|
5808
|
*parse = \&new; |
606
|
|
|
|
|
|
|
*parse_date = \&new; |
607
|
|
|
|
|
|
|
*parse_datetime = \&new; |
608
|
|
|
|
|
|
|
*date = \&new; |
609
|
|
|
|
|
|
|
*datetime = \&new; |
610
|
|
|
|
|
|
|
*new_date = \&new; |
611
|
|
|
|
|
|
|
*new_datetime = \&new; |
612
|
|
|
|
|
|
|
|
613
|
|
|
|
|
|
|
1; # End of DateTimeX::Easy |
614
|
|
|
|
|
|
|
|