← Index
NYTProf Performance Profile   « line view »
For ../dm5dm6_ex3
  Run on Mon Feb 23 08:36:56 2015
Reported on Mon Feb 23 08:37:02 2015

Filename/home/sulbeck/local/lib/perl5/5.20.1/Date/Manip/Date.pm
StatementsExecuted 547839 statements in 458ms
Subroutines
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
24361168.2ms138msDate::Manip::Date::::_parse_timeDate::Manip::Date::_parse_time
24331159.4ms675msDate::Manip::Date::::parseDate::Manip::Date::parse
2673212152.7ms52.7msDate::Manip::Date::::CORE:substDate::Manip::Date::CORE:subst (opcode)
24361139.6ms85.1msDate::Manip::Date::::_parse_date_commonDate::Manip::Date::_parse_date_common
2195024136.6ms36.6msDate::Manip::Date::::CORE:regcompDate::Manip::Date::CORE:regcomp (opcode)
24301132.2ms127msDate::Manip::Date::::setDate::Manip::Date::set
146226126.4ms26.4msDate::Manip::Date::::CORE:matchDate::Manip::Date::CORE:match (opcode)
24361125.4ms120msDate::Manip::Date::::_parse_dateDate::Manip::Date::_parse_date
24301123.5ms205msDate::Manip::Date::::_parse_checkDate::Manip::Date::_parse_check
24361123.1ms33.1msDate::Manip::Date::::_parse_dowDate::Manip::Date::_parse_dow
24361111.1ms50.0msDate::Manip::Date::::_parse_datetime_iso8601Date::Manip::Date::_parse_datetime_iso8601
4872219.33ms9.33msDate::Manip::Date::::_def_timeDate::Manip::Date::_def_time
2430119.23ms26.6msDate::Manip::Date::::_def_dateDate::Manip::Date::_def_date
2434228.86ms8.86msDate::Manip::Date::::_initDate::Manip::Date::_init
2436118.64ms17.8msDate::Manip::Date::::_parse_datetime_otherDate::Manip::Date::_parse_datetime_other
1118.53ms8.73msDate::Manip::Date::::BEGIN@27Date::Manip::Date::BEGIN@27
2436117.16ms10.8msDate::Manip::Date::::_timeDate::Manip::Date::_time
1115.91ms11.6msDate::Manip::Date::::BEGIN@26Date::Manip::Date::BEGIN@26
2440513.56ms27.1msDate::Manip::Date::::_iso8601_rxDate::Manip::Date::_iso8601_rx (recurses: max depth 1, inclusive time 18.4ms)
111890µs8.18msDate::Manip::Date::::BEGIN@14Date::Manip::Date::BEGIN@14
771316µs10.7msDate::Manip::Date::::_other_rxDate::Manip::Date::_other_rx
611150µs2.93msDate::Manip::Date::::_parse_tzDate::Manip::Date::_parse_tz
111102µs103µsDate::Manip::Date::::BEGIN@20Date::Manip::Date::BEGIN@20
11196µs97µsDate::Manip::Date::::BEGIN@21Date::Manip::Date::BEGIN@21
11183µs215µsDate::Manip::Date::::BEGIN@431Date::Manip::Date::BEGIN@431
61166µs5.16msDate::Manip::Date::::_parse_deltaDate::Manip::Date::_parse_delta
61136µs2.10msDate::Manip::Date::::_parse_date_otherDate::Manip::Date::_parse_date_other
11119µs19µsDate::Manip::Date::::BEGIN@625Date::Manip::Date::BEGIN@625
11116µs16µsDate::Manip::Date::::BEGIN@4186Date::Manip::Date::BEGIN@4186
61113µs13µsDate::Manip::Date::::_parse_holidaysDate::Manip::Date::_parse_holidays
1515112µs12µsDate::Manip::Date::::CORE:qrDate::Manip::Date::CORE:qr (opcode)
1117µs9µsDate::Manip::Date::::BEGIN@1258Date::Manip::Date::BEGIN@1258
1117µs8µsDate::Manip::Date::::BEGIN@3089Date::Manip::Date::BEGIN@3089
1116µs10µsDate::Manip::Date::::BEGIN@18Date::Manip::Date::BEGIN@18
1116µs7µsDate::Manip::Date::::BEGIN@3500Date::Manip::Date::BEGIN@3500
1116µs6µsDate::Manip::Date::::BEGIN@2467Date::Manip::Date::BEGIN@2467
1115µs7µsDate::Manip::Date::::BEGIN@1288Date::Manip::Date::BEGIN@1288
1115µs78µsDate::Manip::Date::::BEGIN@22Date::Manip::Date::BEGIN@22
1115µs16µsDate::Manip::Date::::BEGIN@23Date::Manip::Date::BEGIN@23
1114µs5µsDate::Manip::Date::::BEGIN@3510Date::Manip::Date::BEGIN@3510
1114µs10µsDate::Manip::Date::::BEGIN@19Date::Manip::Date::BEGIN@19
1112µs2µsDate::Manip::Date::::ENDDate::Manip::Date::END
0000s0sDate::Manip::Date::::__calc_date_dateDate::Manip::Date::__calc_date_date
0000s0sDate::Manip::Date::::__calc_date_deltaDate::Manip::Date::__calc_date_delta
0000s0sDate::Manip::Date::::__calc_date_delta_approxDate::Manip::Date::__calc_date_delta_approx
0000s0sDate::Manip::Date::::__calc_date_delta_exactDate::Manip::Date::__calc_date_delta_exact
0000s0sDate::Manip::Date::::__calc_date_delta_inverseDate::Manip::Date::__calc_date_delta_inverse
0000s0sDate::Manip::Date::::__is_business_dayDate::Manip::Date::__is_business_day
0000s0sDate::Manip::Date::::__nearest_business_dayDate::Manip::Date::__nearest_business_day
0000s0sDate::Manip::Date::::__next_prevDate::Manip::Date::__next_prev
0000s0sDate::Manip::Date::::__nextprev_business_dayDate::Manip::Date::__nextprev_business_day
0000s0sDate::Manip::Date::::_calc_date_check_dstDate::Manip::Date::_calc_date_check_dst
0000s0sDate::Manip::Date::::_calc_date_dateDate::Manip::Date::_calc_date_date
0000s0sDate::Manip::Date::::_calc_date_deltaDate::Manip::Date::_calc_date_delta
0000s0sDate::Manip::Date::::_cmp_dateDate::Manip::Date::_cmp_date
0000s0sDate::Manip::Date::::_def_date_dowDate::Manip::Date::_def_date_dow
0000s0sDate::Manip::Date::::_def_date_doyDate::Manip::Date::_def_date_doy
0000s0sDate::Manip::Date::::_event_objsDate::Manip::Date::_event_objs
0000s0sDate::Manip::Date::::_events_yearDate::Manip::Date::_events_year
0000s0sDate::Manip::Date::::_format_regexpDate::Manip::Date::_format_regexp
0000s0sDate::Manip::Date::::_holiday_objsDate::Manip::Date::_holiday_objs
0000s0sDate::Manip::Date::::_holidaysDate::Manip::Date::_holidays
0000s0sDate::Manip::Date::::_holidays_yearDate::Manip::Date::_holidays_year
0000s0sDate::Manip::Date::::_init_argsDate::Manip::Date::_init_args
0000s0sDate::Manip::Date::::_parse_date_iso8601Date::Manip::Date::_parse_date_iso8601
0000s0sDate::Manip::Date::::calcDate::Manip::Date::calc
0000s0sDate::Manip::Date::::cmpDate::Manip::Date::cmp
0000s0sDate::Manip::Date::::completeDate::Manip::Date::complete
0000s0sDate::Manip::Date::::convertDate::Manip::Date::convert
0000s0sDate::Manip::Date::::holidayDate::Manip::Date::holiday
0000s0sDate::Manip::Date::::inputDate::Manip::Date::input
0000s0sDate::Manip::Date::::is_business_dayDate::Manip::Date::is_business_day
0000s0sDate::Manip::Date::::is_dateDate::Manip::Date::is_date
0000s0sDate::Manip::Date::::list_eventsDate::Manip::Date::list_events
0000s0sDate::Manip::Date::::list_holidaysDate::Manip::Date::list_holidays
0000s0sDate::Manip::Date::::nearest_business_dayDate::Manip::Date::nearest_business_day
0000s0sDate::Manip::Date::::nextDate::Manip::Date::next
0000s0sDate::Manip::Date::::next_business_dayDate::Manip::Date::next_business_day
0000s0sDate::Manip::Date::::parse_dateDate::Manip::Date::parse_date
0000s0sDate::Manip::Date::::parse_formatDate::Manip::Date::parse_format
0000s0sDate::Manip::Date::::parse_timeDate::Manip::Date::parse_time
0000s0sDate::Manip::Date::::prevDate::Manip::Date::prev
0000s0sDate::Manip::Date::::prev_business_dayDate::Manip::Date::prev_business_day
0000s0sDate::Manip::Date::::printfDate::Manip::Date::printf
0000s0sDate::Manip::Date::::secs_since_1970_GMTDate::Manip::Date::secs_since_1970_GMT
0000s0sDate::Manip::Date::::valueDate::Manip::Date::value
0000s0sDate::Manip::Date::::week_of_yearDate::Manip::Date::week_of_year
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments
Time
on line
Calls Time
in subs
Code
1package Date::Manip::Date;
2# Copyright (c) 1995-2015 Sullivan Beck. All rights reserved.
3# This program is free software; you can redistribute it and/or modify it
4# under the same terms as Perl itself.
5
6########################################################################
7# Any routine that starts with an underscore (_) is NOT intended for
8# public use. They are for internal use in the the Date::Manip
9# modules and are subject to change without warning or notice.
10#
11# ABSOLUTELY NO USER SUPPORT IS OFFERED FOR THESE ROUTINES!
12########################################################################
13
14275µs18.18ms
# spent 8.18ms (890µs+7.29) within Date::Manip::Date::BEGIN@14 which was called: # once (890µs+7.29ms) by main::RUNTIME at line 14
use Date::Manip::Obj;
# spent 8.18ms making 1 call to Date::Manip::Date::BEGIN@14
1515µs@ISA = ('Date::Manip::Obj');
16
1716µsrequire 5.010000;
18213µs215µs
# spent 10µs (6+4) within Date::Manip::Date::BEGIN@18 which was called: # once (6µs+4µs) by main::RUNTIME at line 18
use warnings;
# spent 10µs making 1 call to Date::Manip::Date::BEGIN@18 # spent 4µs making 1 call to warnings::import
19211µs217µs
# spent 10µs (4+7) within Date::Manip::Date::BEGIN@19 which was called: # once (4µs+7µs) by main::RUNTIME at line 19
use strict;
# spent 10µs making 1 call to Date::Manip::Date::BEGIN@19 # spent 7µs making 1 call to strict::import
202109µs2104µs
# spent 103µs (102+1) within Date::Manip::Date::BEGIN@20 which was called: # once (102µs+1µs) by main::RUNTIME at line 20
use integer;
# spent 103µs making 1 call to Date::Manip::Date::BEGIN@20 # spent 1µs making 1 call to integer::import
212104µs298µs
# spent 97µs (96+1) within Date::Manip::Date::BEGIN@21 which was called: # once (96µs+1µs) by main::RUNTIME at line 21
use utf8;
# spent 97µs making 1 call to Date::Manip::Date::BEGIN@21 # spent 1µs making 1 call to utf8::import
22217µs2150µs
# spent 78µs (5+73) within Date::Manip::Date::BEGIN@22 which was called: # once (5µs+73µs) by main::RUNTIME at line 22
use IO::File;
# spent 78µs making 1 call to Date::Manip::Date::BEGIN@22 # spent 73µs making 1 call to Exporter::import
23224µs227µs
# spent 16µs (5+11) within Date::Manip::Date::BEGIN@23 which was called: # once (5µs+11µs) by main::RUNTIME at line 23
use Storable qw(dclone);
# spent 16µs making 1 call to Date::Manip::Date::BEGIN@23 # spent 11µs making 1 call to Exporter::import
24#use re 'debug';
25
26265µs111.6ms
# spent 11.6ms (5.91+5.71) within Date::Manip::Date::BEGIN@26 which was called: # once (5.91ms+5.71ms) by main::RUNTIME at line 26
use Date::Manip::Base;
# spent 11.6ms making 1 call to Date::Manip::Date::BEGIN@26
272772µs18.73ms
# spent 8.73ms (8.53+201µs) within Date::Manip::Date::BEGIN@27 which was called: # once (8.53ms+201µs) by main::RUNTIME at line 27
use Date::Manip::TZ;
# spent 8.73ms making 1 call to Date::Manip::Date::BEGIN@27
28
291100nsour $VERSION;
301300ns$VERSION='6.49';
3113µs
# spent 2µs within Date::Manip::Date::END which was called: # once (2µs+0s) by main::RUNTIME at line 0 of ../dm5dm6_ex3
END { undef $VERSION; }
32
33########################################################################
34# BASE METHODS
35########################################################################
36
37sub is_date {
38 return 1;
39}
40
41# Call this every time a new date is put in to make sure everything is
42# correctly initialized.
43#
44
# spent 8.86ms within Date::Manip::Date::_init which was called 2434 times, avg 4µs/call: # 2433 times (8.85ms+0s) by Date::Manip::Date::parse at line 103, avg 4µs/call # once (8µs+0s) by Date::Manip::Obj::new at line 162 of Date/Manip/Obj.pm
sub _init {
452434301µs my($self) = @_;
46
472434574µs $$self{'err'} = '';
48
4924349.23ms $$self{'data'} =
50 {
51 'set' => 0, # 1 if the date has been set
52 # 2 if the date is in the process of being set
53
54 # The date as input
55 'in' => '', # the string that was parsed (if any)
56 'zin' => '', # the timezone that was parsed (if any)
57
58 # The date in the parsed timezone
59 'date' => [], # the parsed date split
60 'def' => [0,0,0,0,0,0],
61
62 # 1 for each field that came from
63 # defaults rather than parsed
64 # '' for an implied field
65 'tz' => '', # the timezone of the date
66 'isdst' => '', # 1 if the date is in DST.
67 'offset' => [], # The offset from GMT
68 'abb' => '', # The timezone abbreviation.
69 'f' => {}, # fields used in printing a date
70
71 # The date in GMT
72 'gmt' => [], # the date converted to GMT
73
74 # The date in local timezone
75 'loc' => [], # the date converted to local timezone
76 };
77}
78
79sub _init_args {
80 my($self) = @_;
81
82 my @args = @{ $$self{'args'} };
83 if (@args) {
84 if ($#args == 0) {
85 $self->parse($args[0]);
86 } else {
87 warn "WARNING: [new] invalid arguments: @args\n";
88 }
89 }
90}
91
92sub input {
93 my($self) = @_;
94 return $$self{'data'}{'in'};
95}
96
97########################################################################
98# DATE PARSING
99########################################################################
100
101
# spent 675ms (59.4+616) within Date::Manip::Date::parse which was called 2433 times, avg 277µs/call: # 2433 times (59.4ms+616ms) by main::RUNTIME at line 39 of ../dm5dm6_ex3, avg 277µs/call
sub parse {
1022433711µs my($self,$instring,@opts) = @_;
10324334.30ms24338.85ms $self->_init();
# spent 8.85ms making 2433 calls to Date::Manip::Date::_init, avg 4µs/call
1042433313µs my $noupdate = 0;
105
1062433225µs if (! $instring) {
107 $$self{'err'} = '[parse] Empty date string';
108 return 1;
109 }
110
1112433835µs my %opts = map { $_,1 } @opts;
112
1132433439µs my $dmt = $$self{'tz'};
1142433296µs my $dmb = $$dmt{'base'};
115
1162433255µs my($done,$y,$m,$d,$h,$mn,$s,$tzstring,$zone,$abb,$off,$dow,$got_time,
117 $default_time,$firsterr);
118
119 ENCODING:
12024331.78ms243320.2ms foreach my $string ($dmb->_encoding($instring)) {
# spent 20.2ms making 2433 calls to Date::Manip::Base::_encoding, avg 8µs/call
1212436261µs $got_time = 0;
1222436167µs $default_time = 0;
123
124 # Put parse in a simple loop for an easy exit.
1252436219µs PARSE:
126 {
1272436245µs my(@tmp,$tmp);
1282436458µs $$self{'err'} = '';
129
130 # Check the standard date format
131
13224361.66ms243610.4ms $tmp = $dmb->split('date',$string);
# spent 10.4ms making 2436 calls to Date::Manip::Base::split, avg 4µs/call
1332436268µs if (defined($tmp)) {
134 ($y,$m,$d,$h,$mn,$s) = @$tmp;
135 $got_time = 1;
136 last PARSE;
137 }
138
139 # Parse ISO 8601 dates now (which may have a timezone).
140
1412436787µs if (! exists $opts{'noiso8601'}) {
14224362.42ms243650.0ms ($done,@tmp) = $self->_parse_datetime_iso8601($string,\$noupdate);
# spent 50.0ms making 2436 calls to Date::Manip::Date::_parse_datetime_iso8601, avg 21µs/call
1432436400µs if ($done) {
144 ($y,$m,$d,$h,$mn,$s,$tzstring,$zone,$abb,$off) = @tmp;
145 $got_time = 1;
146 last PARSE;
147 }
148 }
149
150 # There's lots of ways that commas may be included. Remove
151 # them (unless it's preceded and followed by a digit in
152 # which case it's probably a fractional separator).
153
15424366.17ms24363.72ms $string =~ s/(?<!\d),/ /g;
# spent 3.72ms making 2436 calls to Date::Manip::Date::CORE:subst, avg 2µs/call
15524362.47ms2436495µs $string =~ s/,(?!\d)/ /g;
# spent 495µs making 2436 calls to Date::Manip::Date::CORE:subst, avg 203ns/call
156
157 # Some special full date/time formats ('now', 'epoch')
158
1592436590µs if (! exists $opts{'nospecial'}) {
16024362.13ms243617.8ms ($done,@tmp) = $self->_parse_datetime_other($string,\$noupdate);
# spent 17.8ms making 2436 calls to Date::Manip::Date::_parse_datetime_other, avg 7µs/call
1612436287µs if ($done) {
162 ($y,$m,$d,$h,$mn,$s,$tzstring,$zone,$abb,$off) = @tmp;
163 $got_time = 1;
164 last PARSE;
165 }
166 }
167
168 # Parse (and remove) the time (and an immediately following timezone).
169
17024364.75ms2436138ms ($got_time,@tmp) = $self->_parse_time('parse',$string,\$noupdate,%opts);
# spent 138ms making 2436 calls to Date::Manip::Date::_parse_time, avg 57µs/call
17124361.19ms if ($got_time) {
172 ($string,$h,$mn,$s,$tzstring,$zone,$abb,$off) = @tmp;
173 }
174
1752436209µs if (! $string) {
176 ($y,$m,$d) = $self->_def_date($y,$m,$d,\$noupdate);
177 last;
178 }
179
180 # Parse (and remove) the day of week. Also, handle the simple DoW
181 # formats.
182
1832436745µs if (! exists $opts{'nodow'}) {
18424363.35ms243633.1ms ($done,@tmp) = $self->_parse_dow($string,\$noupdate);
# spent 33.1ms making 2436 calls to Date::Manip::Date::_parse_dow, avg 14µs/call
1852436554µs if (@tmp) {
1862401439µs if ($done) {
187 ($y,$m,$d) = @tmp;
188 $default_time = 1;
189 last PARSE;
190 } else {
1912401591µs ($string,$dow) = @tmp;
192 }
193 }
194 }
1952436215µs $dow = 0 if (! $dow);
196
197 # At this point, the string might contain the following dates:
198 #
199 # OTHER
200 # OTHER ZONE / ZONE OTHER
201 # DELTA
202 # DELTA ZONE / ZONE DELTA
203 # HOLIDAY
204 # HOLIDAY ZONE / ZONE HOLIDAY
205 #
206 # ZONE is only allowed if it wasn't parsed with the time
207
208 # Unfortunately, there are some conflicts between zones and
209 # some other formats, so try parsing the entire string as a date.
210
21124363.87ms2436120ms (@tmp) = $self->_parse_date($string,$dow,\$noupdate,%opts);
# spent 120ms making 2436 calls to Date::Manip::Date::_parse_date, avg 49µs/call
2122436250µs if (@tmp) {
2132430624µs ($y,$m,$d,$dow) = @tmp;
2142430195µs $default_time = 1;
21524301.19ms last PARSE;
216 }
217
218 # Parse any timezone
219
22061µs if (! $tzstring) {
22169µs62.93ms ($string,@tmp) = $self->_parse_tz($string,\$noupdate);
# spent 2.93ms making 6 calls to Date::Manip::Date::_parse_tz, avg 489µs/call
22261µs ($tzstring,$zone,$abb,$off) = @tmp if (@tmp);
22361µs last PARSE if (! $string);
224 }
225
226 # Try the remainder of the string as a date.
227
2286900ns if ($tzstring) {
229 (@tmp) = $self->_parse_date($string,$dow,\$noupdate,%opts);
230 if (@tmp) {
231 ($y,$m,$d,$dow) = @tmp;
232 $default_time = 1;
233 last PARSE;
234 }
235 }
236
237 # Parse deltas
238 #
239 # Occasionally, a delta is entered for a date (which is
240 # interpreted as the date relative to now). There can be some
241 # confusion between a date and a delta, but the most
242 # important conflicts are the ISO 8601 dates (many of which
243 # could be interpreted as a delta), but those have already
244 # been taken care of.
245 #
246 # We may have already gotten the time:
247 # 3 days ago at midnight UTC
248 # (we already stripped off the 'at midnight UTC' above).
249 #
250 # We also need to handle the sitution of a delta and a timezone.
251 # in 2 hours EST
252 # in 2 days EST
253 # but only if no time was entered.
254
25563µs if (! exists $opts{'nodelta'}) {
256
25769µs65.16ms ($done,@tmp) =
# spent 5.16ms making 6 calls to Date::Manip::Date::_parse_delta, avg 860µs/call
258 $self->_parse_delta($string,$dow,$got_time,$h,$mn,$s,\$noupdate);
25961µs if (@tmp) {
260 ($y,$m,$d,$h,$mn,$s) = @tmp;
261 $got_time = 1;
262 $dow = '';
263 }
26461µs last PARSE if ($done);
265 }
266
267 # Parse holidays
268
26963µs unless (exists $opts{'noholidays'}) {
27068µs613µs ($done,@tmp) =
# spent 13µs making 6 calls to Date::Manip::Date::_parse_holidays, avg 2µs/call
271 $self->_parse_holidays($string,\$noupdate);
2726600ns if (@tmp) {
273 ($y,$m,$d) = @tmp;
274 }
27561µs last PARSE if ($done);
276 }
277
27861µs $$self{'err'} = '[parse] Invalid date string';
27963µs last PARSE;
280 }
281
282 # We got an error parsing this encoding of the string. It could
283 # be that it is a genuine error, or it may be that we simply
284 # need to try a different encoding. If ALL encodings fail, we'll
285 # return the error from the first one.
286
2872436516µs if ($$self{'err'}) {
28862µs if (! $firsterr) {
289 $firsterr = $$self{'err'};
290 }
29161µs next ENCODING;
292 }
293
294 # If we didn't get an error, this is the string to use.
295
2962430789µs last ENCODING;
297 }
298
2992433330µs if ($$self{'err'}) {
3003900ns $$self{'err'} = $firsterr;
30135µs return 1;
302 }
303
304 # Make sure that a time is set
305
3062430244µs if (! $got_time) {
307 if ($default_time) {
308 if ($dmb->_config('defaulttime') eq 'midnight') {
309 ($h,$mn,$s) = (0,0,0);
310 } else {
311 ($h,$mn,$s) = $dmt->_now('time',$noupdate);
312 $noupdate = 1;
313 }
314 $got_time = 1;
315 } else {
316 ($h,$mn,$s) = $self->_def_time(undef,undef,undef,\$noupdate);
317 }
318 }
319
3202430639µs $$self{'data'}{'set'} = 2;
32124304.97ms2430205ms return $self->_parse_check('parse',$instring,
# spent 205ms making 2430 calls to Date::Manip::Date::_parse_check, avg 84µs/call
322 $y,$m,$d,$h,$mn,$s,$dow,$tzstring,$zone,$abb,$off);
323}
324
325sub parse_time {
326 my($self,$string,@opts) = @_;
327 my %opts = map { $_,1 } @opts;
328 my $noupdate = 0;
329
330 if (! $string) {
331 $$self{'err'} = '[parse_time] Empty time string';
332 return 1;
333 }
334
335 my($y,$m,$d,$h,$mn,$s);
336
337 if ($$self{'err'}) {
338 $self->_init();
339 }
340 if ($$self{'data'}{'set'}) {
341 ($y,$m,$d,$h,$mn,$s) = @{ $$self{'data'}{'date'} };
342 } else {
343 my $dmt = $$self{'tz'};
344 ($y,$m,$d,$h,$mn,$s) = $dmt->_now('now',$noupdate);
345 $noupdate = 1;
346 }
347 my($tzstring,$zone,$abb,$off);
348
349 ($h,$mn,$s,$tzstring,$zone,$abb,$off) =
350 $self->_parse_time('parse_time',$string,\$noupdate,%opts);
351
352 return 1 if ($$self{'err'});
353
354 $$self{'data'}{'set'} = 2;
355 return $self->_parse_check('parse_time','',
356 $y,$m,$d,$h,$mn,$s,'',$tzstring,$zone,$abb,$off);
357}
358
359sub parse_date {
360 my($self,$string,@opts) = @_;
361 my %opts = map { $_,1 } @opts;
362 my $noupdate = 0;
363
364 if (! $string) {
365 $$self{'err'} = '[parse_date] Empty date string';
366 return 1;
367 }
368
369 my $dmt = $$self{'tz'};
370 my $dmb = $$dmt{'base'};
371 my($y,$m,$d,$h,$mn,$s);
372
373 if ($$self{'err'}) {
374 $self->_init();
375 }
376 if ($$self{'data'}{'set'}) {
377 ($y,$m,$d,$h,$mn,$s) = @{ $$self{'data'}{'date'} };
378 } else {
379 ($h,$mn,$s) = (0,0,0);
380 }
381
382 # Put parse in a simple loop for an easy exit.
383 my($done,@tmp,$dow);
384 PARSE:
385 {
386
387 # Parse ISO 8601 dates now
388
389 unless (exists $opts{'noiso8601'}) {
390 ($done,@tmp) = $self->_parse_date_iso8601($string,\$noupdate);
391 if ($done) {
392 ($y,$m,$d) = @tmp;
393 last PARSE;
394 }
395 }
396
397 (@tmp) = $self->_parse_date($string,undef,\$noupdate,%opts);
398 if (@tmp) {
399 ($y,$m,$d,$dow) = @tmp;
400 last PARSE;
401 }
402
403 $$self{'err'} = '[parse_date] Invalid date string';
404 return 1;
405 }
406
407 return 1 if ($$self{'err'});
408
409 $y = $dmt->_fix_year($y);
410
411 $$self{'data'}{'set'} = 2;
412 return $self->_parse_check('parse_date','',$y,$m,$d,$h,$mn,$s,$dow);
413}
414
415
# spent 120ms (25.4+94.6) within Date::Manip::Date::_parse_date which was called 2436 times, avg 49µs/call: # 2436 times (25.4ms+94.6ms) by Date::Manip::Date::parse at line 211, avg 49µs/call
sub _parse_date {
4162436828µs my($self,$string,$dow,$noupdate,%opts) = @_;
417
418 # There's lots of ways that commas may be included. Remove
419 # them.
420 #
421 # Also remove some words we should ignore.
422
42324362.50ms2436484µs $string =~ s/,/ /g;
# spent 484µs making 2436 calls to Date::Manip::Date::CORE:subst, avg 199ns/call
424
4252436363µs my $dmt = $$self{'tz'};
4262436315µs my $dmb = $$dmt{'base'};
42724361.40ms118µs my $ign = (exists $$dmb{'data'}{'rx'}{'other'}{'ignore'} ?
# spent 18µs making 1 call to Date::Manip::Date::_other_rx
428 $$dmb{'data'}{'rx'}{'other'}{'ignore'} :
429 $self->_other_rx('ignore'));
43024367.83ms48723.73ms $string =~ s/$ign/ /g;
# spent 2.78ms making 2436 calls to Date::Manip::Date::CORE:subst, avg 1µs/call # spent 946µs making 2436 calls to Date::Manip::Date::CORE:regcomp, avg 388ns/call
43124385.54ms2437724µs
# spent 215µs (83+132) within Date::Manip::Date::BEGIN@431 which was called: # once (83µs+132µs) by main::RUNTIME at line 431
my $of = $+{'of'};
# spent 508µs making 2436 calls to Tie::Hash::NamedCapture::FETCH, avg 209ns/call # spent 215µs making 1 call to Date::Manip::Date::BEGIN@431
432
43324364.79ms24362.68ms $string =~ s/\s*$//;
# spent 2.68ms making 2436 calls to Date::Manip::Date::CORE:subst, avg 1µs/call
4342436189µs return () if (! $string);
435
4362436254µs my($done,$y,$m,$d,@tmp);
437
438 # Put parse in a simple loop for an easy exit.
439 PARSE:
440 {
441
442 # Parse (and remove) the day of week. Also, handle the simple DoW
443 # formats.
444
4454872738µs unless (exists $opts{'nodow'}) {
4462436336µs if (! defined($dow)) {
447 ($done,@tmp) = $self->_parse_dow($string,$noupdate);
448 if (@tmp) {
449 if ($done) {
450 ($y,$m,$d) = @tmp;
451 last PARSE;
452 } else {
453 ($string,$dow) = @tmp;
454 }
455 }
456 $dow = 0 if (! $dow);
457 }
458 }
459
460 # Parse common dates
461
4622436240µs unless (exists $opts{'nocommon'}) {
46324362.36ms243685.1ms (@tmp) = $self->_parse_date_common($string,$noupdate);
# spent 85.1ms making 2436 calls to Date::Manip::Date::_parse_date_common, avg 35µs/call
4642436310µs if (@tmp) {
4652430659µs ($y,$m,$d) = @tmp;
4662430871µs last PARSE;
467 }
468 }
469
470 # Parse less common dates
471
47262µs unless (exists $opts{'noother'}) {
47367µs62.10ms (@tmp) = $self->_parse_date_other($string,$dow,$of,$noupdate);
# spent 2.10ms making 6 calls to Date::Manip::Date::_parse_date_other, avg 351µs/call
47461µs if (@tmp) {
475 ($y,$m,$d,$dow) = @tmp;
476 last PARSE;
477 }
478 }
479
48069µs return ();
481 }
482
48324304.14ms return($y,$m,$d,$dow);
484}
485
486sub parse_format {
487 my($self,$format,$string) = @_;
488 $self->_init();
489 my $noupdate = 0;
490
491 if (! $string) {
492 $$self{'err'} = '[parse_format] Empty date string';
493 return 1;
494 }
495
496 my $dmt = $$self{'tz'};
497 my $dmb = $$dmt{'base'};
498
499 my($err,$re) = $self->_format_regexp($format);
500 return $err if ($err);
501 return 1 if ($string !~ $re);
502
503 my($y,$m,$d,$h,$mn,$s,
504 $mon_name,$mon_abb,$dow_name,$dow_abb,$dow_char,$dow_num,
505 $doy,$nth,$ampm,$epochs,$epocho,
506 $tzstring,$off,$abb,$zone,
507 $g,$w,$l,$u) =
508 @+{qw(y m d h mn s
509 mon_name mon_abb dow_name dow_abb dow_char dow_num doy
510 nth ampm epochs epocho tzstring off abb zone g w l u)};
511
512 while (1) {
513 # Get y/m/d/h/mn/s from:
514 # $epochs,$epocho
515
516 if (defined($epochs)) {
517 ($y,$m,$d,$h,$mn,$s) = @{ $dmb->secs_since_1970($epochs) };
518 my $z;
519 if ($zone) {
520 $z = $dmt->_zone($zone);
521 return 'Invalid zone' if (! $z);
522 } elsif ($abb || $off) {
523 $z = $dmt->zone($off,$abb);
524 return 'Invalid zone' if (! $z);
525 } else {
526 $z = $dmt->_now('tz',$noupdate);
527 $noupdate = 1;
528 }
529 my($err,$date) = $dmt->convert_from_gmt([$y,$m,$d,$h,$mn,$s],$z);
530 ($y,$m,$d,$h,$mn,$s) = @$date;
531 last;
532 }
533
534 if (defined($epocho)) {
535 ($y,$m,$d,$h,$mn,$s) = @{ $dmb->secs_since_1970($epocho) };
536 last;
537 }
538
539 # Get y/m/d from:
540 # $y,$m,$d,
541 # $mon_name,$mon_abb
542 # $doy,$nth
543 # $g/$w,$l/$u
544
545 if ($mon_name) {
546 $m = $$dmb{'data'}{'wordmatch'}{'month_name'}{lc($mon_name)};
547 } elsif ($mon_abb) {
548 $m = $$dmb{'data'}{'wordmatch'}{'month_abb'}{lc($mon_abb)};
549 }
550
551 if ($nth) {
552 $d = $$dmb{'data'}{'wordmatch'}{'nth'}{lc($nth)};
553 }
554
555 if ($doy) {
556 $y = $dmt->_now('y',$noupdate) if (! $y);
557 $noupdate = 1;
558 ($y,$m,$d) = @{ $dmb->day_of_year($y,$doy) };
559
560 } elsif ($g) {
561 $y = $dmt->_now('y',$noupdate) if (! $y);
562 $noupdate = 1;
563 ($y,$m,$d) = @{ $dmb->_week_of_year($g,$w,1) };
564
565 } elsif ($l) {
566 $y = $dmt->_now('y',$noupdate) if (! $y);
567 $noupdate = 1;
568 ($y,$m,$d) = @{ $dmb->_week_of_year($l,$u,7) };
569
570 } elsif ($m) {
571 ($y,$m,$d) = $self->_def_date($y,$m,$d,\$noupdate);
572 }
573
574 # Get h/mn/s from:
575 # $h,$mn,$s,$ampm
576
577 if (defined($h)) {
578 ($h,$mn,$s) = $self->_def_time($h,$mn,$s,\$noupdate);
579 }
580
581 if ($ampm) {
582 if ($$dmb{'data'}{'wordmatch'}{'ampm'}{lc($ampm)} == 2) {
583 # pm times
584 $h+=12 unless ($h==12);
585 } else {
586 # am times
587 $h=0 if ($h==12);
588 }
589 }
590
591 # Get dow from:
592 # $dow_name,$dow_abb,$dow_char,$dow_num
593
594 if ($dow_name) {
595 $dow_num = $$dmb{'data'}{'wordmatch'}{'day_name'}{lc($dow_name)};
596 } elsif ($dow_abb) {
597 $dow_num = $$dmb{'data'}{'wordmatch'}{'day_abb'}{lc($dow_abb)};
598 } elsif ($dow_char) {
599 $dow_num = $$dmb{'data'}{'wordmatch'}{'day_char'}{lc($dow_char)};
600 }
601
602 last;
603 }
604
605 if (! $m) {
606 ($y,$m,$d) = $dmt->_now('now',$noupdate);
607 $noupdate = 1;
608 }
609 if (! defined($h)) {
610 ($h,$mn,$s) = (0,0,0);
611 }
612
613 $$self{'data'}{'set'} = 2;
614 $err = $self->_parse_check('parse_format',$string,
615 $y,$m,$d,$h,$mn,$s,$dow_num,
616 $tzstring,$zone,$abb,$off);
617
618 if (wantarray) {
619 my %tmp = %{ dclone(\%+) };
620 return ($err,%tmp);
621 }
622 return $err;
623}
624
625
# spent 19µs within Date::Manip::Date::BEGIN@625 which was called: # once (19µs+0s) by main::RUNTIME at line 926
BEGIN {
62613µs my %y_form = map { $_,1 } qw( Y y s o G L );
62713µs my %m_form = map { $_,1 } qw( m f b h B j s o W U );
62812µs my %d_form = map { $_,1 } qw( j d e E s o W U );
62912µs my %h_form = map { $_,1 } qw( H I k i s o );
6301900ns my %mn_form = map { $_,1 } qw( M s o );
6311900ns my %s_form = map { $_,1 } qw( S s o );
632
63311µs my %dow_form = map { $_,1 } qw( v a A w );
6341700ns my %am_form = map { $_,1 } qw( p s o );
6351900ns my %z_form = map { $_,1 } qw( Z z N );
6361700ns my %mon_form = map { $_,1 } qw( b h B );
63715µs my %day_form = map { $_,1 } qw( v a A );
638
639 sub _format_regexp {
640 my($self,$format) = @_;
641 my $dmt = $$self{'tz'};
642 my $dmb = $$dmt{'base'};
643
644 if (exists $$dmb{'data'}{'format'}{$format}) {
645 return @{ $$dmb{'data'}{'format'}{$format} };
646 }
647
648 my $re;
649 my $err;
650 my($y,$m,$d,$h,$mn,$s) = (0,0,0,0,0,0);
651 my($dow,$ampm,$zone,$G,$W,$L,$U) = (0,0,0,0,0,0,0);
652
653 while ($format) {
654 last if ($format eq '%');
655
656 if ($format =~ s/^([^%]+)//) {
657 $re .= $1;
658 next;
659 }
660
661 $format =~ s/^%(.)//;
662 my $f = $1;
663
664 if (exists $y_form{$f}) {
665 if ($y) {
666 $err = 'Year specified multiple times';
667 last;
668 }
669 $y = 1;
670 }
671
672 if (exists $m_form{$f}) {
673 if ($m) {
674 $err = 'Month specified multiple times';
675 last;
676 }
677 $m = 1;
678 }
679
680 if (exists $d_form{$f}) {
681 if ($d) {
682 $err = 'Day specified multiple times';
683 last;
684 }
685 $d = 1;
686 }
687
688 if (exists $h_form{$f}) {
689 if ($h) {
690 $err = 'Hour specified multiple times';
691 last;
692 }
693 $h = 1;
694 }
695
696 if (exists $mn_form{$f}) {
697 if ($mn) {
698 $err = 'Minutes specified multiple times';
699 last;
700 }
701 $mn = 1;
702 }
703
704 if (exists $s_form{$f}) {
705 if ($s) {
706 $err = 'Seconds specified multiple times';
707 last;
708 }
709 $s = 1;
710 }
711
712 if (exists $dow_form{$f}) {
713 if ($dow) {
714 $err = 'Day-of-week specified multiple times';
715 last;
716 }
717 $dow = 1;
718 }
719
720 if (exists $am_form{$f}) {
721 if ($ampm) {
722 $err = 'AM/PM specified multiple times';
723 last;
724 }
725 $ampm = 1;
726 }
727
728 if (exists $z_form{$f}) {
729 if ($zone) {
730 $err = 'Zone specified multiple times';
731 last;
732 }
733 $zone = 1;
734 }
735
736 if ($f eq 'G') {
737 if ($G) {
738 $err = 'G specified multiple times';
739 last;
740 }
741 $G = 1;
742
743 } elsif ($f eq 'W') {
744 if ($W) {
745 $err = 'W specified multiple times';
746 last;
747 }
748 $W = 1;
749
750 } elsif ($f eq 'L') {
751 if ($L) {
752 $err = 'L specified multiple times';
753 last;
754 }
755 $L = 1;
756
757 } elsif ($f eq 'U') {
758 if ($U) {
759 $err = 'U specified multiple times';
760 last;
761 }
762 $U = 1;
763 }
764
765 ###
766
767 if ($f eq 'Y') {
768 $re .= '(?<y>\d\d\d\d)';
769
770 } elsif ($f eq 'y') {
771 $re .= '(?<y>\d\d)';
772
773 } elsif ($f eq 'm') {
774 $re .= '(?<m>\d\d)';
775
776 } elsif ($f eq 'f') {
777 $re .= '(?:(?<m>\d\d)| ?(?<m>\d))';
778
779 } elsif (exists $mon_form{$f}) {
780 my $abb = $$dmb{'data'}{'rx'}{'month_abb'}[0];
781 my $nam = $$dmb{'data'}{'rx'}{'month_name'}[0];
782 $re .= "(?:(?<mon_name>$nam)|(?<mon_abb>$abb))";
783
784 } elsif ($f eq 'j') {
785 $re .= '(?<doy>\d\d\d)';
786
787 } elsif ($f eq 'd') {
788 $re .= '(?<d>\d\d)';
789
790 } elsif ($f eq 'e') {
791 $re .= '(?:(?<d>\d\d)| ?(?<d>\d))';
792
793 } elsif (exists $day_form{$f}) {
794 my $abb = $$dmb{'data'}{'rx'}{'day_abb'}[0];
795 my $name = $$dmb{'data'}{'rx'}{'day_name'}[0];
796 my $char = $$dmb{'data'}{'rx'}{'day_char'}[0];
797 $re .= "(?:(?<dow_name>$name)|(?<dow_abb>$abb)|(?<dow_char>$char))";
798
799 } elsif ($f eq 'w') {
800 $re .= '(?<dow_num>[1-7])';
801
802 } elsif ($f eq 'E') {
803 my $nth = $$dmb{'data'}{'rx'}{'nth'}[0];
804 $re .= "(?<nth>$nth)"
805
806 } elsif ($f eq 'H' || $f eq 'I') {
807 $re .= '(?<h>\d\d)';
808
809 } elsif ($f eq 'k' || $f eq 'i') {
810 $re .= '(?:(?<h>\d\d)| ?(?<h>\d))';
811
812 } elsif ($f eq 'p') {
813 my $ampm = $$dmb{data}{rx}{ampm}[0];
814 $re .= "(?<ampm>$ampm)";
815
816 } elsif ($f eq 'M') {
817 $re .= '(?<mn>\d\d)';
818
819 } elsif ($f eq 'S') {
820 $re .= '(?<s>\d\d)';
821
822 } elsif (exists $z_form{$f}) {
823 $re .= $dmt->_zrx('zrx');
824
825 } elsif ($f eq 's') {
826 $re .= '(?<epochs>\d+)';
827
828 } elsif ($f eq 'o') {
829 $re .= '(?<epocho>\d+)';
830
831 } elsif ($f eq 'G') {
832 $re .= '(?<g>\d\d\d\d)';
833
834 } elsif ($f eq 'W') {
835 $re .= '(?<w>\d\d)';
836
837 } elsif ($f eq 'L') {
838 $re .= '(?<l>\d\d\d\d)';
839
840 } elsif ($f eq 'U') {
841 $re .= '(?<u>\d\d)';
842
843 } elsif ($f eq 'c') {
844 $format = '%a %b %e %H:%M:%S %Y' . $format;
845
846 } elsif ($f eq 'C' || $f eq 'u') {
847 $format = '%a %b %e %H:%M:%S %Z %Y' . $format;
848
849 } elsif ($f eq 'g') {
850 $format = '%a, %d %b %Y %H:%M:%S %Z' . $format;
851
852 } elsif ($f eq 'D') {
853 $format = '%m/%d/%y' . $format;
854
855 } elsif ($f eq 'r') {
856 $format = '%I:%M:%S %p' . $format;
857
858 } elsif ($f eq 'R') {
859 $format = '%H:%M' . $format;
860
861 } elsif ($f eq 'T' || $f eq 'X') {
862 $format = '%H:%M:%S' . $format;
863
864 } elsif ($f eq 'V') {
865 $format = '%m%d%H%M%y' . $format;
866
867 } elsif ($f eq 'Q') {
868 $format = '%Y%m%d' . $format;
869
870 } elsif ($f eq 'q') {
871 $format = '%Y%m%d%H%M%S' . $format;
872
873 } elsif ($f eq 'P') {
874 $format = '%Y%m%d%H:%M:%S' . $format;
875
876 } elsif ($f eq 'O') {
877 $format = '%Y\\-%m\\-%dT%H:%M:%S' . $format;
878
879 } elsif ($f eq 'F') {
880 $format = '%A, %B %e, %Y' . $format;
881
882 } elsif ($f eq 'K') {
883 $format = '%Y-%j' . $format;
884
885 } elsif ($f eq 'J') {
886 $format = '%G-W%W-%w' . $format;
887
888 } elsif ($f eq 'x') {
889 if ($dmb->_config('dateformat') eq 'US') {
890 $format = '%m/%d/%y' . $format;
891 } else {
892 $format = '%d/%m/%y' . $format;
893 }
894
895 } elsif ($f eq 't') {
896 $re .= "\t";
897
898 } elsif ($f eq '%') {
899 $re .= '%';
900
901 } elsif ($f eq '+') {
902 $re .= '\\+';
903 }
904 }
905
906 if ($m != $d) {
907 $err = 'Date not fully specified';
908 } elsif ( ($h || $mn || $s) && (! $h || ! $mn) ) {
909 $err = 'Time not fully specified';
910 } elsif ($ampm && ! $h) {
911 $err = 'Time not fully specified';
912 } elsif ($G != $W) {
913 $err = 'G/W must both be specified';
914 } elsif ($L != $U) {
915 $err = 'L/U must both be specified';
916 }
917
918 if ($err) {
919 $$dmb{'data'}{'format'}{$format} = [$err];
920 return ($err);
921 }
922
923 $$dmb{'data'}{'format'}{$format} = [0, qr/$re/i];
924 return @{ $$dmb{'data'}{'format'}{$format} };
925 }
9261814µs119µs}
# spent 19µs making 1 call to Date::Manip::Date::BEGIN@625
927
928########################################################################
929# DATE FORMATS
930########################################################################
931
932
# spent 205ms (23.5+181) within Date::Manip::Date::_parse_check which was called 2430 times, avg 84µs/call: # 2430 times (23.5ms+181ms) by Date::Manip::Date::parse at line 321, avg 84µs/call
sub _parse_check {
93324301.36ms my($self,$caller,$instring,
934 $y,$m,$d,$h,$mn,$s,$dow,$tzstring,$zone,$abb,$off) = @_;
9352430434µs my $dmt = $$self{'tz'};
9362430368µs my $dmb = $$dmt{'base'};
937
938 # Check day_of_week for validity BEFORE converting 24:00:00 to the
939 # next day
940
9412430450µs if ($dow) {
94224013.01ms24016.95ms my $tmp = $dmb->day_of_week([$y,$m,$d]);
# spent 6.95ms making 2401 calls to Date::Manip::Base::day_of_week, avg 3µs/call
9432401605µs if ($tmp != $dow) {
944 $$self{'err'} = "[$caller] Day of week invalid";
945 return 1;
946 }
947 }
948
949 # Handle 24:00:00 times.
950
9512430251µs if ($h == 24) {
952 ($h,$mn,$s) = (0,0,0);
953 ($y,$m,$d) = @{ $dmb->calc_date_days([$y,$m,$d],1) };
954 }
955
95624303.03ms243026.6ms if (! $dmb->check([$y,$m,$d,$h,$mn,$s])) {
# spent 26.6ms making 2430 calls to Date::Manip::Base::check, avg 11µs/call
957 $$self{'err'} = "[$caller] Invalid date";
958 return 1;
959 }
960
961 # Interpret timezone information and check that date is valid
962 # in the timezone.
963
9642430227µs my ($zonename,$isdst);
96524301.02ms if (defined($zone)) {
966 $zonename = $dmt->_zone($zone);
967
968 if (! $zonename) {
969 $$self{'err'} = "[$caller] Unable to determine timezone: $zone";
970 return 1;
971 }
972
973 } elsif (defined($abb) || defined($off)) {
974 my (@tmp,$err);
975 push(@tmp,[$y,$m,$d,$h,$mn,$s]);
976 push(@tmp,$off) if (defined $off);
977 push(@tmp,$abb) if (defined $abb);
978 $zonename = $dmt->zone(@tmp);
979
980 if (! $zonename) {
981 $$self{'err'} = 'Unable to determine timezone';
982 return 1;
983 }
984
985 # Figure out $isdst from $abb/$off (for everything else, we'll
986 # try both values).
987
988 if (defined $off || defined $abb) {
989 my @off = @{ $dmb->split('offset',$off) } if (defined($off));
990 my $err = 1;
991 foreach my $i (0,1) {
992 my $per = $dmt->date_period([$y,$m,$d,$h,$mn,$s],$zonename,1,$i);
993 next if (! $per);
994 my $a = $$per[4];
995 my $o = $$per[3];
996 if (defined $abb && lc($a) eq lc($abb)) {
997 $err = 0;
998 $isdst = $i;
999 $abb = $a;
1000 last;
1001 }
1002 if (defined ($off)) {
1003 if ($off[0] == $$o[0] &&
1004 $off[1] == $$o[1] &&
1005 $off[2] == $$o[2]) {
1006 $err = 0;
1007 $isdst = $i;
1008 last;
1009 }
1010 }
1011 }
1012 if ($err) {
1013 $$self{'err'} = 'Invalid timezone';
1014 return 1;
1015 }
1016 }
1017
1018 } else {
101924301.74ms243020.4ms $zonename = $dmt->_now('tz');
# spent 20.4ms making 2430 calls to Date::Manip::TZ_Base::_now, avg 8µs/call
1020 }
1021
1022 # Store the date
1023
102424302.70ms2430127ms $self->set('zdate',$zonename,[$y,$m,$d,$h,$mn,$s],$isdst);
# spent 127ms making 2430 calls to Date::Manip::Date::set, avg 52µs/call
10252430467µs return 1 if ($$self{'err'});
1026
10272430492µs $$self{'data'}{'in'} = $instring;
10282430230µs $$self{'data'}{'zin'} = $zone if (defined($zone));
1029
103024302.78ms return 0;
1031}
1032
1033# Set up the regular expressions for ISO 8601 parsing. Returns the
1034# requested regexp. $rx can be:
1035# cdate : regular expression for a complete date
1036# tdate : regular expression for a truncated date
1037# ctime : regular expression for a complete time
1038# ttime : regular expression for a truncated time
1039# date : regular expression for a date only
1040# time : regular expression for a time only
1041# UNDEF : regular expression for a valid date and/or time
1042#
1043# Date matches are:
1044# y m d doy w dow yod c
1045# Time matches are:
1046# h h24 mn s fh fm
1047#
1048
# spent 27.1ms (3.56+23.5) within Date::Manip::Date::_iso8601_rx which was called 2440 times, avg 11µs/call: # 2436 times (3.47ms+23.6ms) by Date::Manip::Date::_parse_datetime_iso8601 at line 1201, avg 11µs/call # once (2µs+-2µs) by Date::Manip::Date::_iso8601_rx at line 1179 # once (4µs+-4µs) by Date::Manip::Date::_iso8601_rx at line 1181 # once (51µs+-51µs) by Date::Manip::Date::_iso8601_rx at line 1178 # once (34µs+-34µs) by Date::Manip::Date::_iso8601_rx at line 1180
sub _iso8601_rx {
10492440297µs my($self,$rx) = @_;
10502440318µs my $dmt = $$self{'tz'};
10512440332µs my $dmb = $$dmt{'base'};
1052
105324404.09ms return $$dmb{'data'}{'rx'}{'iso'}{$rx}
1054 if (exists $$dmb{'data'}{'rx'}{'iso'}{$rx});
1055
105633µs if ($rx eq 'cdate' || $rx eq 'tdate') {
1057
10581200ns my $y4 = '(?<y>\d\d\d\d)';
10591200ns my $y2 = '(?<y>\d\d)';
10601100ns my $m = '(?<m>0[1-9]|1[0-2])';
10611100ns my $d = '(?<d>0[1-9]|[12][0-9]|3[01])';
10621200ns my $doy = '(?<doy>00[1-9]|0[1-9][0-9]|[1-2][0-9][0-9]|3[0-5][0-9]|36[0-6])';
10631100ns my $w = '(?<w>0[1-9]|[1-4][0-9]|5[0-3])';
10641100ns my $dow = '(?<dow>[1-7])';
10651100ns my $yod = '(?<yod>\d)';
10661100ns my $cc = '(?<c>\d\d)';
1067
1068112µs my $cdaterx =
1069 "${y4}${m}${d}|" . # CCYYMMDD
1070 "${y4}\\-${m}\\-${d}|" . # CCYY-MM-DD
1071 "\\-${y2}${m}${d}|" . # -YYMMDD
1072 "\\-${y2}\\-${m}\\-${d}|" . # -YY-MM-DD
1073 "\\-?${y2}${m}${d}|" . # YYMMDD
1074 "\\-?${y2}\\-${m}\\-${d}|" . # YY-MM-DD
1075 "\\-\\-${m}\\-?${d}|" . # --MM-DD --MMDD
1076 "\\-\\-\\-${d}|" . # ---DD
1077
1078 "${y4}\\-?${doy}|" . # CCYY-DoY CCYYDoY
1079 "\\-?${y2}\\-?${doy}|" . # YY-DoY -YY-DoY
1080 # YYDoY -YYDoY
1081 "\\-${doy}|" . # -DoY
1082
1083 "${y4}W${w}${dow}|" . # CCYYWwwD
1084 "${y4}\\-W${w}\\-${dow}|" . # CCYY-Www-D
1085 "\\-?${y2}W${w}${dow}|" . # YYWwwD -YYWwwD
1086 "\\-?${y2}\\-W${w}\\-${dow}|" . # YY-Www-D -YY-Www-D
1087
1088 "\\-?${yod}W${w}${dow}|" . # YWwwD -YWwwD
1089 "\\-?${yod}\\-W${w}\\-${dow}|" . # Y-Www-D -Y-Www-D
1090 "\\-W${w}\\-?${dow}|" . # -Www-D -WwwD
1091 "\\-W\\-${dow}|" . # -W-D
1092 "\\-\\-\\-${dow}"; # ---D
10931152µs2138µs $cdaterx = qr/(?:$cdaterx)/i;
# spent 137µs making 1 call to Date::Manip::Date::CORE:regcomp # spent 800ns making 1 call to Date::Manip::Date::CORE:qr
1094
109514µs my $tdaterx =
1096 "${y4}\\-${m}|" . # CCYY-MM
1097 "${y4}|" . # CCYY
1098 "\\-${y2}\\-?${m}|" . # -YY-MM -YYMM
1099 "\\-${y2}|" . # -YY
1100 "\\-\\-${m}|" . # --MM
1101
1102 "${y4}\\-?W${w}|" . # CCYYWww CCYY-Www
1103 "\\-?${y2}\\-?W${w}|" . # YY-Www YYWww
1104 # -YY-Www -YYWww
1105 "\\-?W${w}|" . # -Www Www
1106
1107 "${cc}"; # CC
1108139µs234µs $tdaterx = qr/(?:$tdaterx)/i;
# spent 34µs making 1 call to Date::Manip::Date::CORE:regcomp # spent 500ns making 1 call to Date::Manip::Date::CORE:qr
1109
11101800ns $$dmb{'data'}{'rx'}{'iso'}{'cdate'} = $cdaterx;
111111µs $$dmb{'data'}{'rx'}{'iso'}{'tdate'} = $tdaterx;
1112
1113 } elsif ($rx eq 'ctime' || $rx eq 'ttime') {
1114
11151200ns my $hh = '(?<h>[0-1][0-9]|2[0-3])';
11161300ns my $mn = '(?<mn>[0-5][0-9])';
11171100ns my $ss = '(?<s>[0-5][0-9])';
11181200ns my $h24a = '(?<h24>24(?::00){0,2})';
11191200ns my $h24b = '(?<h24>24(?:00){0,2})';
11201100ns my $h = '(?<h>[0-9])';
1121
11221100ns my $fh = '(?:[\.,](?<fh>\d*))'; # fractional hours (keep)
11231100ns my $fm = '(?:[\.,](?<fm>\d*))'; # fractional seconds (keep)
11241100ns my $fs = '(?:[\.,]\d*)'; # fractional hours (discard)
1125
112612µs115.6ms my $zrx = $dmt->_zrx('zrx');
# spent 15.6ms making 1 call to Date::Manip::TZ::_zrx
1127
112819µs my $ctimerx =
1129 "${hh}${mn}${ss}${fs}?|" . # HHMNSS[,S+]
1130 "${hh}:${mn}:${ss}${fs}?|" . # HH:MN:SS[,S+]
1131 "${hh}:?${mn}${fm}|" . # HH:MN,M+ HHMN,M+
1132 "${hh}${fh}|" . # HH,H+
1133 "\\-${mn}:?${ss}${fs}?|" . # -MN:SS[,S+] -MNSS[,S+]
1134 "\\-${mn}${fm}|" . # -MN,M+
1135 "\\-\\-${ss}${fs}?|" . # --SS[,S+]
1136 "${hh}:?${mn}|" . # HH:MN HHMN
1137 "${h24a}|" . # 24:00:00 24:00 24
1138 "${h24b}|" . # 240000 2400
1139 "${h}:${mn}:${ss}${fs}?|" . # H:MN:SS[,S+]
1140 "${h}:${mn}${fm}"; # H:MN,M+
114112.46ms22.45ms $ctimerx = qr/(?:$ctimerx)(?:\s*$zrx)?/;
# spent 2.45ms making 1 call to Date::Manip::Date::CORE:regcomp # spent 900ns making 1 call to Date::Manip::Date::CORE:qr
1142
114311µs my $ttimerx =
1144 "${hh}|" . # HH
1145 "\\-${mn}"; # -MN
1146114µs211µs $ttimerx = qr/(?:$ttimerx)/;
# spent 10µs making 1 call to Date::Manip::Date::CORE:regcomp # spent 500ns making 1 call to Date::Manip::Date::CORE:qr
1147
114812µs $$dmb{'data'}{'rx'}{'iso'}{'ctime'} = $ctimerx;
114912µs $$dmb{'data'}{'rx'}{'iso'}{'ttime'} = $ttimerx;
1150
1151 } elsif ($rx eq 'date') {
1152
1153 my $cdaterx = $self->_iso8601_rx('cdate');
1154 my $tdaterx = $self->_iso8601_rx('tdate');
1155 $$dmb{'data'}{'rx'}{'iso'}{'date'} = qr/(?:$cdaterx|$tdaterx)/;
1156
1157 } elsif ($rx eq 'time') {
1158
1159 my $ctimerx = $self->_iso8601_rx('ctime');
1160 my $ttimerx = $self->_iso8601_rx('ttime');
1161 $$dmb{'data'}{'rx'}{'iso'}{'time'} = qr/(?:$ctimerx|$ttimerx)/;
1162
1163 } elsif ($rx eq 'fulldate') {
1164
1165 # A parseable string contains:
1166 # a complete date and complete time
1167 # a complete date and truncated time
1168 # a truncated date
1169 # a complete time
1170 # a truncated time
1171
1172 # If the string contains both a time and date, they may be adjacent
1173 # or separated by:
1174 # whitespace
1175 # T (which must be followed by a number)
1176 # a dash
1177
1178114µs10s my $cdaterx = $self->_iso8601_rx('cdate');
# spent 224µs making 1 call to Date::Manip::Date::_iso8601_rx, recursion: max depth 1, sum of overlapping time 224µs
117911µs10s my $tdaterx = $self->_iso8601_rx('tdate');
# spent 2µs making 1 call to Date::Manip::Date::_iso8601_rx, recursion: max depth 1, sum of overlapping time 2µs
11801800ns10s my $ctimerx = $self->_iso8601_rx('ctime');
# spent 18.1ms making 1 call to Date::Manip::Date::_iso8601_rx, recursion: max depth 1, sum of overlapping time 18.1ms
118112µs10s my $ttimerx = $self->_iso8601_rx('ttime');
# spent 4µs making 1 call to Date::Manip::Date::_iso8601_rx, recursion: max depth 1, sum of overlapping time 4µs
1182
118312µs1700ns my $sep = qr/(?:T|\-|\s*)/i;
# spent 700ns making 1 call to Date::Manip::Date::CORE:qr
1184
118515.23ms25.21ms my $daterx = qr/^\s*(?: $cdaterx(?:$sep(?:$ctimerx|$ttimerx))? |
# spent 5.21ms making 1 call to Date::Manip::Date::CORE:regcomp # spent 1µs making 1 call to Date::Manip::Date::CORE:qr
1186 $tdaterx |
1187 $ctimerx |
1188 $ttimerx
1189 )\s*$/x;
1190
119113µs $$dmb{'data'}{'rx'}{'iso'}{'fulldate'} = $daterx;
1192 }
1193
119439µs return $$dmb{'data'}{'rx'}{'iso'}{$rx};
1195}
1196
1197
# spent 50.0ms (11.1+38.9) within Date::Manip::Date::_parse_datetime_iso8601 which was called 2436 times, avg 21µs/call: # 2436 times (11.1ms+38.9ms) by Date::Manip::Date::parse at line 142, avg 21µs/call
sub _parse_datetime_iso8601 {
11982436435µs my($self,$string,$noupdate) = @_;
11992436366µs my $dmt = $$self{'tz'};
12002436331µs my $dmb = $$dmt{'base'};
120124361.37ms243627.1ms my $daterx = $self->_iso8601_rx('fulldate');
# spent 27.1ms making 2436 calls to Date::Manip::Date::_iso8601_rx, avg 11µs/call
1202
12032436293µs my($y,$m,$d,$h,$mn,$s,$tzstring,$zone,$abb,$off);
1204 my($doy,$dow,$yod,$c,$w,$fh,$fm,$h24);
1205
1206243616.5ms487211.8ms if ($string =~ $daterx) {
# spent 7.15ms making 2436 calls to Date::Manip::Date::CORE:match, avg 3µs/call # spent 4.69ms making 2436 calls to Date::Manip::Date::CORE:regcomp, avg 2µs/call
1207 ($y,$m,$d,$h,$mn,$s,$doy,$dow,$yod,$c,$w,$fh,$fm,$h24,
1208 $tzstring,$zone,$abb,$off) =
1209 @+{qw(y m d h mn s doy dow yod c w fh fm h24 tzstring zone abb off)};
1210
1211 if (defined $w || defined $dow) {
1212 ($y,$m,$d) = $self->_def_date_dow($y,$w,$dow,$noupdate);
1213 } elsif (defined $doy) {
1214 ($y,$m,$d) = $self->_def_date_doy($y,$doy,$noupdate);
1215 } else {
1216 $y = $c . '00' if (defined $c);
1217 ($y,$m,$d) = $self->_def_date($y,$m,$d,$noupdate);
1218 }
1219
1220 ($h,$mn,$s) = $self->_time($h,$mn,$s,$fh,$fm,$h24,undef,$noupdate);
1221 } else {
122224363.41ms return (0);
1223 }
1224
1225 return (1,$y,$m,$d,$h,$mn,$s,$tzstring,$zone,$abb,$off);
1226}
1227
1228sub _parse_date_iso8601 {
1229 my($self,$string,$noupdate) = @_;
1230 my $dmt = $$self{'tz'};
1231 my $dmb = $$dmt{'base'};
1232 my $daterx = $self->_iso8601_rx('date');
1233
1234 my($y,$m,$d);
1235 my($doy,$dow,$yod,$c,$w);
1236
1237 if ($string =~ /^$daterx$/) {
1238 ($y,$m,$d,$doy,$dow,$yod,$c,$w) =
1239 @+{qw(y m d doy dow yod c w)};
1240
1241 if (defined $w || defined $dow) {
1242 ($y,$m,$d) = $self->_def_date_dow($y,$w,$dow,$noupdate);
1243 } elsif (defined $doy) {
1244 ($y,$m,$d) = $self->_def_date_doy($y,$doy,$noupdate);
1245 } else {
1246 $y = $c . '00' if (defined $c);
1247 ($y,$m,$d) = $self->_def_date($y,$m,$d,$noupdate);
1248 }
1249 } else {
1250 return (0);
1251 }
1252
1253 return (1,$y,$m,$d);
1254}
1255
1256# Handle all of the time fields.
1257#
12582100µs210µs
# spent 9µs (7+2) within Date::Manip::Date::BEGIN@1258 which was called: # once (7µs+2µs) by main::RUNTIME at line 1258
no integer;
# spent 9µs making 1 call to Date::Manip::Date::BEGIN@1258 # spent 2µs making 1 call to integer::unimport
1259
# spent 10.8ms (7.16+3.67) within Date::Manip::Date::_time which was called 2436 times, avg 4µs/call: # 2436 times (7.16ms+3.67ms) by Date::Manip::Date::_parse_time at line 1648, avg 4µs/call
sub _time {
12602436959µs my($self,$h,$mn,$s,$fh,$fm,$h24,$ampm,$noupdate) = @_;
1261
12622436261µs if (defined($ampm) && $ampm) {
1263 my $dmt = $$self{'tz'};
1264 my $dmb = $$dmt{'base'};
1265 if ($$dmb{'data'}{'wordmatch'}{'ampm'}{lc($ampm)} == 2) {
1266 # pm times
1267 $h+=12 unless ($h==12);
1268 } else {
1269 # am times
1270 $h=0 if ($h==12);
1271 }
1272 }
1273
12742436576µs if (defined $h24) {
1275 return(24,0,0);
1276 } elsif (defined $fh && $fh ne "") {
1277 $fh = "0.$fh";
1278 $s = int($fh * 3600);
1279 $mn = int($s/60);
1280 $s -= $mn*60;
1281 } elsif (defined $fm && $fm ne "") {
1282 $fm = "0.$fm";
1283 $s = int($fm*60);
1284 }
128524362.20ms24363.67ms ($h,$mn,$s) = $self->_def_time($h,$mn,$s,$noupdate);
# spent 3.67ms making 2436 calls to Date::Manip::Date::_def_time, avg 2µs/call
128624362.70ms return($h,$mn,$s);
1287}
128823.29ms29µs
# spent 7µs (5+2) within Date::Manip::Date::BEGIN@1288 which was called: # once (5µs+2µs) by main::RUNTIME at line 1288
use integer;
# spent 7µs making 1 call to Date::Manip::Date::BEGIN@1288 # spent 2µs making 1 call to integer::import
1289
1290# Set up the regular expressions for other date and time formats. Returns the
1291# requested regexp.
1292#
1293
# spent 10.7ms (316µs+10.4) within Date::Manip::Date::_other_rx which was called 7 times, avg 1.53ms/call: # once (57µs+5.07ms) by Date::Manip::Date::_parse_datetime_other at line 1867 # once (60µs+2.52ms) by Date::Manip::Date::_parse_time at line 1628 # once (106µs+1.92ms) by Date::Manip::Date::_parse_date_other at line 1944 # once (56µs+830µs) by Date::Manip::Date::_parse_date_common at line 1693 # once (17µs+46µs) by Date::Manip::Date::_parse_dow at line 1734 # once (11µs+23µs) by Date::Manip::Date::_parse_date_common at line 1678 # once (8µs+10µs) by Date::Manip::Date::_parse_date at line 427
sub _other_rx {
129472µs my($self,$rx) = @_;
129572µs my $dmt = $$self{'tz'};
129672µs my $dmb = $$dmt{'base'};
129771µs $rx = '_' if (! defined $rx);
1298
1299710µs if ($rx eq 'time') {
1300
13011200ns my $h24 = '(?<h>2[0-3]|1[0-9]|0?[0-9])'; # 0-23 00-23
13021600ns my $h12 = '(?<h>1[0-2]|0?[1-9])'; # 1-12 01-12
13031200ns my $mn = '(?<mn>[0-5][0-9])'; # 00-59
13041300ns my $ss = '(?<s>[0-5][0-9])'; # 00-59
1305
1306 # how to express fractions
1307
13081200ns my($f1,$f2,$sepfr);
130911µs if (exists $$dmb{'data'}{'rx'}{'sepfr'} &&
1310 $$dmb{'data'}{'rx'}{'sepfr'}) {
1311 $sepfr = $$dmb{'data'}{'rx'}{'sepfr'};
1312 } else {
13131300ns $sepfr = '';
1314 }
1315
13161400ns if ($sepfr) {
1317 $f1 = "(?:[.,]|$sepfr)";
1318 $f2 = "(?:[.,:]|$sepfr)";
1319 } else {
13201300ns $f1 = "[.,]";
13211300ns $f2 = "[.,:]";
1322 }
13231700ns my $fh = "(?:$f1(?<fh>\\d*))"; # fractional hours (keep)
13241300ns my $fm = "(?:$f1(?<fm>\\d*))"; # fractional minutes (keep)
13251500ns my $fs = "(?:$f2\\d*)"; # fractional seconds
1326
1327 # AM/PM
1328
13291400ns my($ampm);
133012µs if (exists $$dmb{'data'}{'rx'}{'ampm'}) {
1331 $ampm = "(?:\\s*(?<ampm>$$dmb{data}{rx}{ampm}[0]))";
1332 }
1333
1334 # H:MN and MN:S separators
1335
13361600ns my @hm = ("\Q:\E");
13371600ns my @ms = ("\Q:\E");
133813µs16µs if ($dmb->_config('periodtimesep')) {
# spent 6µs making 1 call to Date::Manip::TZ_Base::_config
1339 push(@hm,"\Q.\E");
1340 push(@ms,"\Q.\E");
1341 }
134212µs if (exists $$dmb{'data'}{'rx'}{'sephm'} &&
1343 defined $$dmb{'data'}{'rx'}{'sephm'} &&
1344 exists $$dmb{'data'}{'rx'}{'sepms'} &&
1345 defined $$dmb{'data'}{'rx'}{'sepms'}) {
1346 push(@hm,@{ $$dmb{'data'}{'rx'}{'sephm'} });
1347 push(@ms,@{ $$dmb{'data'}{'rx'}{'sepms'} });
1348 }
1349
1350 # How to express the time
1351 # matches = (H, FH, MN, FMN, S, AM, TZSTRING, ZONE, ABB, OFF, ABB)
1352
13531100ns my $timerx;
1354
135513µs for (my $i=0; $i<=$#hm; $i++) {
13561300ns my $hm = $hm[$i];
13571400ns my $ms = $ms[$i];
135812µs $timerx .= "${h12}$hm${mn}$ms${ss}${fs}?${ampm}?|" # H12:MN:SS[,S+] [AM]
1359 if ($ampm);
136012µs $timerx .= "${h24}$hm${mn}$ms${ss}${fs}?|" . # H24:MN:SS[,S+]
1361 "(?<h>24)$hm(?<mn>00)$ms(?<s>00)|"; # 24:00:00
1362 }
136311µs for (my $i=0; $i<=$#hm; $i++) {
13641300ns my $hm = $hm[$i];
13651200ns my $ms = $ms[$i];
13661900ns $timerx .= "${h12}$hm${mn}${fm}${ampm}?|" # H12:MN,M+ [AM]
1367 if ($ampm);
136811µs $timerx .= "${h24}$hm${mn}${fm}|"; # H24:MN,M+
1369 }
137011µs for (my $i=0; $i<=$#hm; $i++) {
13711400ns my $hm = $hm[$i];
13721300ns my $ms = $ms[$i];
13731800ns $timerx .= "${h12}$hm${mn}${ampm}?|" # H12:MN [AM]
1374 if ($ampm);
137511µs $timerx .= "${h24}$hm${mn}|" . # H24:MN
1376 "(?<h>24)$hm(?<mn>00)|"; # 24:00
1377 }
1378
137914µs $timerx .= "${h12}${fh}${ampm}|" # H12,H+ AM
1380 if ($ampm);
1381
13821800ns $timerx .= "${h12}${ampm}|" if ($ampm); # H12 AM
1383
13841500ns $timerx .= "${h24}${fh}|"; # H24,H+
1385
13861500ns chop($timerx); # remove trailing pipe
1387
138811µs11µs my $zrx = $dmt->_zrx('zrx');
# spent 1µs making 1 call to Date::Manip::TZ::_zrx
138911µs my $at = $$dmb{'data'}{'rx'}{'at'};
1390112µs29µs my $atrx = qr/(?:^|\s+)(?:$at)\s+/;
# spent 8µs making 1 call to Date::Manip::Date::CORE:regcomp # spent 500ns making 1 call to Date::Manip::Date::CORE:qr
139112.52ms22.51ms $timerx = qr/(?:$atrx|^|\s+)(?:$timerx)(?:\s*$zrx)?(?:\s+|$)/i;
# spent 2.51ms making 1 call to Date::Manip::Date::CORE:regcomp # spent 1µs making 1 call to Date::Manip::Date::CORE:qr
1392
139313µs $$dmb{'data'}{'rx'}{'other'}{$rx} = $timerx;
1394
1395 } elsif ($rx eq 'common_1') {
1396
1397 # These are of the format M/D/Y
1398
1399 # Do NOT replace <m> and <d> with a regular expression to
1400 # match 1-12 since the DateFormat config may reverse the two.
14011300ns my $y4 = '(?<y>\d\d\d\d)';
14021300ns my $y2 = '(?<y>\d\d)';
14031200ns my $m = '(?<m>\d\d?)';
14041100ns my $d = '(?<d>\d\d?)';
14051100ns my $sep = '(?<sep>[\s\.\/\-])';
1406
140713µs my $daterx =
1408 "${m}${sep}${d}\\k<sep>$y4|" . # M/D/YYYY
1409 "${m}${sep}${d}\\k<sep>$y2|" . # M/D/YY
1410 "${m}${sep}${d}"; # M/D
1411
1412127µs223µs $daterx = qr/^\s*(?:$daterx)\s*$/;
# spent 23µs making 1 call to Date::Manip::Date::CORE:regcomp # spent 500ns making 1 call to Date::Manip::Date::CORE:qr
141312µs $$dmb{'data'}{'rx'}{'other'}{$rx} = $daterx;
1414
1415 } elsif ($rx eq 'common_2') {
1416
14171900ns my $abb = $$dmb{'data'}{'rx'}{'month_abb'}[0];
141811µs my $nam = $$dmb{'data'}{'rx'}{'month_name'}[0];
1419
14201300ns my $y4 = '(?<y>\d\d\d\d)';
14211200ns my $y2 = '(?<y>\d\d)';
142210s my $m = '(?<m>\d\d?)';
142310s my $d = '(?<d>\d\d?)';
14241100ns my $dd = '(?<d>\d\d)';
142511µs my $mmm = "(?:(?<mmm>$abb)|(?<month>$nam))";
14261400ns my $sep = '(?<sep>[\s\.\/\-])';
1427
1428122µs my $daterx =
1429 "${y4}${sep}${m}\\k<sep>$d|" . # YYYY/M/D
1430
1431 "${mmm}\\s*${dd}\\s*${y4}|" . # mmmDDYYYY
1432 "${mmm}\\s*${dd}\\s*${y2}|" . # mmmDDYY
1433 "${mmm}\\s*${d}|" . # mmmD
1434 "${d}\\s*${mmm}\\s*${y4}|" . # DmmmYYYY
1435 "${d}\\s*${mmm}\\s*${y2}|" . # DmmmYY
1436 "${d}\\s*${mmm}|" . # Dmmm
1437 "${y4}\\s*${mmm}\\s*${d}|" . # YYYYmmmD
1438
1439 "${mmm}${sep}${d}\\k<sep>${y4}|" . # mmm/D/YYYY
1440 "${mmm}${sep}${d}\\k<sep>${y2}|" . # mmm/D/YY
1441 "${mmm}${sep}${d}|" . # mmm/D
1442 "${d}${sep}${mmm}\\k<sep>${y4}|" . # D/mmm/YYYY
1443 "${d}${sep}${mmm}\\k<sep>${y2}|" . # D/mmm/YY
1444 "${d}${sep}${mmm}|" . # D/mmm
1445 "${y4}${sep}${mmm}\\k<sep>${d}|" . # YYYY/mmm/D
1446
1447 "${mmm}${sep}?${d}\\s+${y2}|" . # mmmD YY mmm/D YY
1448 "${mmm}${sep}?${d}\\s+${y4}|" . # mmmD YYYY mmm/D YYYY
1449 "${d}${sep}?${mmm}\\s+${y2}|" . # Dmmm YY D/mmm YY
1450 "${d}${sep}?${mmm}\\s+${y4}|" . # Dmmm YYYY D/mmm YYYY
1451
1452 "${y2}\\s+${mmm}${sep}?${d}|" . # YY mmmD YY mmm/D
1453 "${y4}\\s+${mmm}${sep}?${d}|" . # YYYY mmmD YYYY mmm/D
1454 "${y2}\\s+${d}${sep}?${mmm}|" . # YY Dmmm YY D/mmm
1455 "${y4}\\s+${d}${sep}?${mmm}|" . # YYYY Dmmm YYYY D/mmm
1456
1457 "${y4}:${m}:${d}"; # YYYY:MM:DD
1458
14591857µs2830µs $daterx = qr/^\s*(?:$daterx)\s*$/i;
# spent 829µs making 1 call to Date::Manip::Date::CORE:regcomp # spent 900ns making 1 call to Date::Manip::Date::CORE:qr
146012µs $$dmb{'data'}{'rx'}{'other'}{$rx} = $daterx;
1461
1462 } elsif ($rx eq 'dow') {
1463
146411µs my $day_abb = $$dmb{'data'}{'rx'}{'day_abb'}[0];
14651900ns my $day_name = $$dmb{'data'}{'rx'}{'day_name'}[0];
1466
14671900ns my $on = $$dmb{'data'}{'rx'}{'on'};
1468113µs29µs my $onrx = qr/(?:^|\s+)(?:$on)\s+/;
# spent 8µs making 1 call to Date::Manip::Date::CORE:regcomp # spent 1µs making 1 call to Date::Manip::Date::CORE:qr
1469142µs236µs my $dowrx = qr/(?:$onrx|^|\s+)(?<dow>$day_name|$day_abb)($|\s+)/i;
# spent 36µs making 1 call to Date::Manip::Date::CORE:regcomp # spent 600ns making 1 call to Date::Manip::Date::CORE:qr
1470
147112µs $$dmb{'data'}{'rx'}{'other'}{$rx} = $dowrx;
1472
1473 } elsif ($rx eq 'ignore') {
1474
147511µs my $of = $$dmb{'data'}{'rx'}{'of'};
1476
1477113µs210µs my $ignrx = qr/(?:^|\s+)(?<of>$of)(\s+|$)/;
# spent 9µs making 1 call to Date::Manip::Date::CORE:regcomp # spent 500ns making 1 call to Date::Manip::Date::CORE:qr
147811µs $$dmb{'data'}{'rx'}{'other'}{$rx} = $ignrx;
1479
1480 } elsif ($rx eq 'miscdatetime') {
1481
148211µs my $special = $$dmb{'data'}{'rx'}{'offset_time'}[0];
1483
148411µs $special = "(?<special>$special)";
14851300ns my $secs = "(?<epoch>[-+]?\\d+)";
148611µs my $abb = $$dmb{'data'}{'rx'}{'month_abb'}[0];
14871600ns my $mmm = "(?<mmm>$abb)";
14881200ns my $y4 = '(?<y>\d\d\d\d)';
14891100ns my $dd = '(?<d>\d\d)';
14901100ns my $h24 = '(?<h>2[0-3]|[01][0-9])'; # 00-23
14911200ns my $mn = '(?<mn>[0-5][0-9])'; # 00-59
14921200ns my $ss = '(?<s>[0-5][0-9])'; # 00-59
149312µs12µs my $offrx = $dmt->_zrx('offrx');
# spent 2µs making 1 call to Date::Manip::TZ::_zrx
14941800ns1700ns my $zrx = $dmt->_zrx('zrx');
# spent 700ns making 1 call to Date::Manip::TZ::_zrx
1495
1496123µs my $daterx =
1497 "${special}|" . # now
1498 "${special}\\s+${zrx}|" . # now EDT
1499
1500 "epoch\\s+$secs|" . # epoch SECS
1501 "epoch\\s+$secs\\s+${zrx}|" . # epoch SECS EDT
1502
1503 "${dd}\\/${mmm}\\/${y4}:${h24}:${mn}:${ss}\\s*${offrx}";
1504 # Common log format: 10/Oct/2000:13:55:36 -0700
1505
150615.08ms25.07ms $daterx = qr/^\s*(?:$daterx)\s*$/i;
# spent 5.07ms making 1 call to Date::Manip::Date::CORE:regcomp # spent 1µs making 1 call to Date::Manip::Date::CORE:qr
150715µs $$dmb{'data'}{'rx'}{'other'}{$rx} = $daterx;
1508
1509 } elsif ($rx eq 'misc') {
1510
151111µs my $abb = $$dmb{'data'}{'rx'}{'month_abb'}[0];
151211µs my $nam = $$dmb{'data'}{'rx'}{'month_name'}[0];
151311µs my $next = $$dmb{'data'}{'rx'}{'nextprev'}[0];
15141800ns my $last = $$dmb{'data'}{'rx'}{'last'};
15151700ns my $yf = $$dmb{data}{rx}{fields}[1];
151611µs my $mf = $$dmb{data}{rx}{fields}[2];
15171800ns my $wf = $$dmb{data}{rx}{fields}[3];
15181500ns my $df = $$dmb{data}{rx}{fields}[4];
151911µs my $nth = $$dmb{'data'}{'rx'}{'nth'}[0];
152011µs my $nth_wom = $$dmb{'data'}{'rx'}{'nth_wom'}[0];
152111µs my $special = $$dmb{'data'}{'rx'}{'offset_date'}[0];
1522
15231100ns my $y = '(?:(?<y>\d\d\d\d)|(?<y>\d\d))';
152412µs my $mmm = "(?:(?<mmm>$abb)|(?<month>$nam))";
15251800ns $next = "(?<next>$next)";
15261500ns $last = "(?<last>$last)";
15271500ns $yf = "(?<field_y>$yf)";
15281500ns $mf = "(?<field_m>$mf)";
15291700ns $wf = "(?<field_w>$wf)";
15301500ns $df = "(?<field_d>$df)";
15311900ns my $fld = "(?:$yf|$mf|$wf)";
153211µs $nth = "(?<nth>$nth)";
15331500ns $nth_wom = "(?<nth>$nth_wom)";
153411µs $special = "(?<special>$special)";
1535
1536120µs my $daterx =
1537 "${mmm}\\s+${nth}\\s*$y?|" . # Dec 1st [1970]
1538 "${nth}\\s+${mmm}\\s*$y?|" . # 1st Dec [1970]
1539 "$y\\s+${mmm}\\s+${nth}|" . # 1970 Dec 1st
1540 "$y\\s+${nth}\\s+${mmm}|" . # 1970 1st Dec
1541
1542 "${next}\\s+${fld}|" . # next year, next month, next week
1543 "${next}|" . # next friday
1544
1545 "${last}\\s+${mmm}\\s*$y?|" . # last friday in october 95
1546 "${last}\\s+${df}\\s+${mmm}\\s*$y?|" .
1547 # last day in october 95
1548 "${last}\\s*$y?|" . # last friday in 95
1549
1550 "${nth_wom}\\s+${mmm}\\s*$y?|" .
1551 # nth DoW in MMM [YYYY]
1552 "${nth}\\s*$y?|" . # nth DoW in [YYYY]
1553
1554 "${nth}\\s+$df\\s+${mmm}\\s*$y?|" .
1555 # nth day in MMM [YYYY]
1556
1557 "${nth}\\s+${wf}\\s*$y?|" . # DoW Nth week [YYYY]
1558 "${wf}\\s+(?<n>\\d+)\\s*$y?|" . # DoW week N [YYYY]
1559
1560 "${special}|" . # today, tomorrow
1561 "${special}\\s+${wf}|" . # today week
1562 # British: same as 1 week from today
1563
1564 "${nth}|" . # nth
1565
1566 "${wf}"; # monday week
1567 # British: same as 'in 1 week on monday'
1568
156911.97ms21.92ms $daterx = qr/^\s*(?:$daterx)\s*$/i;
# spent 1.92ms making 1 call to Date::Manip::Date::CORE:regcomp # spent 2µs making 1 call to Date::Manip::Date::CORE:qr
157012µs $$dmb{'data'}{'rx'}{'other'}{$rx} = $daterx;
1571
1572 }
1573
1574721µs return $$dmb{'data'}{'rx'}{'other'}{$rx};
1575}
1576
1577
# spent 138ms (68.2+69.8) within Date::Manip::Date::_parse_time which was called 2436 times, avg 57µs/call: # 2436 times (68.2ms+69.8ms) by Date::Manip::Date::parse at line 170, avg 57µs/call
sub _parse_time {
15782436876µs my($self,$caller,$string,$noupdate,%opts) = @_;
15792436327µs my $dmt = $$self{'tz'};
15802436315µs my $dmb = $$dmt{'base'};
1581
15822436262µs my($timerx,$h,$mn,$s,$fh,$fm,$h24,$ampm,$tzstring,$zone,$abb,$off);
15832436275µs my $got_time = 0;
1584
1585 # Check for ISO 8601 time
1586 #
1587 # This is only called via. parse_time (parse_date uses a regexp
1588 # that matches a full ISO 8601 date/time instead of parsing them
1589 # separately. Since some ISO 8601 times are a substring of non-ISO
1590 # 8601 times (i.e. 12:30 is a substring of '12:30 PM'), we need to
1591 # match entire strings here.
1592
15932436323µs if ($caller eq 'parse_time') {
1594 $timerx = (exists $$dmb{'data'}{'rx'}{'iso'}{'time'} ?
1595 $$dmb{'data'}{'rx'}{'iso'}{'time'} :
1596 $self->_iso8601_rx('time'));
1597
1598 if (! exists $opts{'noiso8601'}) {
1599 if ($string =~ s/^\s*$timerx\s*$//) {
1600 ($h,$fh,$mn,$fm,$s,$ampm,$tzstring,$zone,$abb,$off) =
1601 @+{qw(h fh mn fm s ampm tzstring zone abb off)};
1602
1603 ($h,$mn,$s) = $self->_def_time($h,$mn,$s,$noupdate);
1604 $h24 = 1 if ($h == 24 && $mn == 0 && $s == 0);
1605 $string =~ s/\s*$//;
1606 $got_time = 1;
1607 }
1608 }
1609 }
1610
1611 # Make time substitutions (i.e. noon => 12:00:00)
1612
16132436948µs if (! $got_time &&
1614 ! exists $opts{'noother'}) {
161524361.36ms my @rx = @{ $$dmb{'data'}{'rx'}{'times'} };
16162436404µs shift(@rx);
16172436989µs foreach my $rx (@rx) {
1618487220.1ms974411.2ms if ($string =~ $rx) {
# spent 9.47ms making 4872 calls to Date::Manip::Date::CORE:match, avg 2µs/call # spent 1.68ms making 4872 calls to Date::Manip::Date::CORE:regcomp, avg 346ns/call
1619 my $repl = $$dmb{'data'}{'wordmatch'}{'times'}{lc($1)};
1620 $string =~ s/$rx/$repl/g;
1621 }
1622 }
1623 }
1624
1625 # Check to see if there is a time in the string
1626
16272436648µs if (! $got_time) {
162824361.41ms12.58ms $timerx = (exists $$dmb{'data'}{'rx'}{'other'}{'time'} ?
# spent 2.58ms making 1 call to Date::Manip::Date::_other_rx
1629 $$dmb{'data'}{'rx'}{'other'}{'time'} :
1630 $self->_other_rx('time'));
1631
1632243634.0ms487229.4ms if ($string =~ s/$timerx/ /) {
# spent 28.0ms making 2436 calls to Date::Manip::Date::CORE:subst, avg 11µs/call # spent 1.36ms making 2436 calls to Date::Manip::Date::CORE:regcomp, avg 559ns/call
1633243637.7ms243606.43ms ($h,$fh,$mn,$fm,$s,$ampm,$tzstring,$zone,$abb,$off) =
# spent 6.43ms making 24360 calls to Tie::Hash::NamedCapture::FETCH, avg 264ns/call
1634 @+{qw(h fh mn fm s ampm tzstring zone abb off)};
1635
163624362.94ms24365.66ms ($h,$mn,$s) = $self->_def_time($h,$mn,$s,$noupdate);
# spent 5.66ms making 2436 calls to Date::Manip::Date::_def_time, avg 2µs/call
16372436575µs $h24 = 1 if ($h == 24 && $mn == 0 && $s == 0);
163824366.17ms24363.76ms $string =~ s/\s*$//;
# spent 3.76ms making 2436 calls to Date::Manip::Date::CORE:subst, avg 2µs/call
16392436484µs $got_time = 1;
1640 }
1641 }
1642
1643 # If we called this from $date->parse()
1644 # returns the string and a list of time components
1645
16462436467µs if ($caller eq 'parse') {
16472436259µs if ($got_time) {
164824362.48ms243610.8ms ($h,$mn,$s) = $self->_time($h,$mn,$s,$fh,$fm,$h24,$ampm,$noupdate);
# spent 10.8ms making 2436 calls to Date::Manip::Date::_time, avg 4µs/call
164924364.37ms return ($got_time,$string,$h,$mn,$s,$tzstring,$zone,$abb,$off);
1650 } else {
1651 return (0);
1652 }
1653 }
1654
1655 # If we called this from $date->parse_time()
1656
1657 if (! $got_time || $string) {
1658 $$self{'err'} = "[$caller] Invalid time string";
1659 return ();
1660 }
1661
1662 ($h,$mn,$s) = $self->_time($h,$mn,$s,$fh,$fm,$h24,$ampm,$noupdate);
1663 return ($h,$mn,$s,$tzstring,$zone,$abb,$off);
1664}
1665
1666# Parse common dates
1667
# spent 85.1ms (39.6+45.5) within Date::Manip::Date::_parse_date_common which was called 2436 times, avg 35µs/call: # 2436 times (39.6ms+45.5ms) by Date::Manip::Date::_parse_date at line 463, avg 35µs/call
sub _parse_date_common {
16682436466µs my($self,$string,$noupdate) = @_;
16692436357µs my $dmt = $$self{'tz'};
16702436310µs my $dmb = $$dmt{'base'};
1671
1672 # Since we want whitespace to be used as a separator, turn all
1673 # whitespace into single spaces. This is necessary since the
1674 # regexps do backreferences to make sure that separators are
1675 # not mixed.
167624365.30ms24363.00ms $string =~ s/\s+/ /g;
# spent 3.00ms making 2436 calls to Date::Manip::Date::CORE:subst, avg 1µs/call
1677
167824361.42ms134µs my $daterx = (exists $$dmb{'data'}{'rx'}{'other'}{'common_1'} ?
# spent 34µs making 1 call to Date::Manip::Date::_other_rx
1679 $$dmb{'data'}{'rx'}{'other'}{'common_1'} :
1680 $self->_other_rx('common_1'));
1681
168224369.11ms48724.79ms if ($string =~ $daterx) {
# spent 3.52ms making 2436 calls to Date::Manip::Date::CORE:match, avg 1µs/call # spent 1.27ms making 2436 calls to Date::Manip::Date::CORE:regcomp, avg 523ns/call
1683 my($y,$m,$d) = @+{qw(y m d)};
1684
1685 if ($dmb->_config('dateformat') ne 'US') {
1686 ($m,$d) = ($d,$m);
1687 }
1688
1689 ($y,$m,$d) = $self->_def_date($y,$m,$d,$noupdate);
1690 return($y,$m,$d);
1691 }
1692
169324361.33ms1886µs $daterx = (exists $$dmb{'data'}{'rx'}{'other'}{'common_2'} ?
# spent 886µs making 1 call to Date::Manip::Date::_other_rx
1694 $$dmb{'data'}{'rx'}{'other'}{'common_2'} :
1695 $self->_other_rx('common_2'));
1696
1697243611.0ms48726.69ms if ($string =~ $daterx) {
# spent 3.69ms making 2436 calls to Date::Manip::Date::CORE:match, avg 2µs/call # spent 3.00ms making 2436 calls to Date::Manip::Date::CORE:regcomp, avg 1µs/call
1698243019.8ms121503.49ms my($y,$m,$d,$mmm,$month) = @+{qw(y m d mmm month)};
# spent 3.49ms making 12150 calls to Tie::Hash::NamedCapture::FETCH, avg 287ns/call
1699
170024301.65ms if ($mmm) {
1701 $m = $$dmb{'data'}{'wordmatch'}{'month_abb'}{lc($mmm)};
1702 } elsif ($month) {
1703 $m = $$dmb{'data'}{'wordmatch'}{'month_name'}{lc($month)};
1704 }
1705
170624303.03ms243026.6ms ($y,$m,$d) = $self->_def_date($y,$m,$d,$noupdate);
# spent 26.6ms making 2430 calls to Date::Manip::Date::_def_date, avg 11µs/call
170724303.69ms return($y,$m,$d);
1708 }
1709
171068µs return ();
1711}
1712
1713
# spent 2.93ms (150µs+2.78) within Date::Manip::Date::_parse_tz which was called 6 times, avg 489µs/call: # 6 times (150µs+2.78ms) by Date::Manip::Date::parse at line 221, avg 489µs/call
sub _parse_tz {
171462µs my($self,$string,$noupdate) = @_;
171562µs my $dmt = $$self{'tz'};
17166700ns my($tzstring,$zone,$abb,$off);
1717
171867µs69µs my $rx = $dmt->_zrx('zrx');
# spent 9µs making 6 calls to Date::Manip::TZ::_zrx, avg 2µs/call
171962.90ms122.77ms if ($string =~ s/(?:^|\s)$rx(?:$|\s)/ /) {
# spent 2.71ms making 6 calls to Date::Manip::Date::CORE:regcomp, avg 452µs/call # spent 64µs making 6 calls to Date::Manip::Date::CORE:subst, avg 11µs/call
1720 ($tzstring,$zone,$abb,$off) = @+{qw(tzstring zone abb off)};
1721 return($string,$tzstring,$zone,$abb,$off);
1722 }
1723627µs return($string);
1724}
1725
1726
# spent 33.1ms (23.1+9.99) within Date::Manip::Date::_parse_dow which was called 2436 times, avg 14µs/call: # 2436 times (23.1ms+9.99ms) by Date::Manip::Date::parse at line 184, avg 14µs/call
sub _parse_dow {
17272436455µs my($self,$string,$noupdate) = @_;
17282436401µs my $dmt = $$self{'tz'};
17292436286µs my $dmb = $$dmt{'base'};
17302436225µs my($y,$m,$d,$dow);
1731
1732 # Remove the day of week
1733
173424361.54ms162µs my $rx = (exists $$dmb{'data'}{'rx'}{'other'}{'dow'} ?
# spent 62µs making 1 call to Date::Manip::Date::_other_rx
1735 $$dmb{'data'}{'rx'}{'other'}{'dow'} :
1736 $self->_other_rx('dow'));
173724369.50ms48724.51ms if ($string =~ s/$rx/ /) {
# spent 3.37ms making 2436 calls to Date::Manip::Date::CORE:subst, avg 1µs/call # spent 1.14ms making 2436 calls to Date::Manip::Date::CORE:regcomp, avg 469ns/call
173824015.59ms24011.08ms $dow = $+{'dow'};
# spent 1.08ms making 2401 calls to Tie::Hash::NamedCapture::FETCH, avg 448ns/call
17392401686µs $dow = lc($dow);
1740
174124012.26ms $dow = $$dmb{'data'}{'wordmatch'}{'day_abb'}{$dow}
1742 if (exists $$dmb{'data'}{'wordmatch'}{'day_abb'}{$dow});
174324011.07ms $dow = $$dmb{'data'}{'wordmatch'}{'day_name'}{$dow}
1744 if (exists $$dmb{'data'}{'wordmatch'}{'day_name'}{$dow});
1745 } else {
17463540µs return (0);
1747 }
1748
174924015.31ms24012.96ms $string =~ s/\s*$//;
# spent 2.96ms making 2401 calls to Date::Manip::Date::CORE:subst, avg 1µs/call
175024013.46ms24011.37ms $string =~ s/^\s*//;
# spent 1.37ms making 2401 calls to Date::Manip::Date::CORE:subst, avg 571ns/call
1751
175224013.55ms return (0,$string,$dow) if ($string);
1753
1754 # Handle the simple DoW format
1755
1756 ($y,$m,$d) = $self->_def_date($y,$m,$d,$noupdate);
1757
1758 my($w,$dow1);
1759
1760 ($y,$w) = $dmb->week_of_year([$y,$m,$d]); # week of year
1761 ($y,$m,$d) = @{ $dmb->week_of_year($y,$w) }; # first day
1762 $dow1 = $dmb->day_of_week([$y,$m,$d]); # DoW of first day
1763 $dow1 -= 7 if ($dow1 > $dow);
1764 ($y,$m,$d) = @{ $dmb->calc_date_days([$y,$m,$d],$dow-$dow1) };
1765
1766 return(1,$y,$m,$d);
1767}
1768
1769
# spent 13µs within Date::Manip::Date::_parse_holidays which was called 6 times, avg 2µs/call: # 6 times (13µs+0s) by Date::Manip::Date::parse at line 270, avg 2µs/call
sub _parse_holidays {
177062µs my($self,$string,$noupdate) = @_;
177162µs my $dmt = $$self{'tz'};
177262µs my $dmb = $$dmt{'base'};
17736900ns my($y,$m,$d);
1774
1775610µs if (! exists $$dmb{'data'}{'rx'}{'holidays'}) {
1776 return (0);
1777 }
1778
1779 $string =~ s/\s*$//;
1780 $string =~ s/^\s*//;
1781
1782 my $rx = $$dmb{'data'}{'rx'}{'holidays'};
1783 if ($string =~ $rx) {
1784 my $hol;
1785 ($y,$hol) = @+{qw(y holiday)};
1786 $y = $dmt->_now('y',$noupdate) if (! $y);
1787 $y += 0;
1788
1789 $self->_holidays($y,2);
1790 return (0) if (! exists $$dmb{'data'}{'holidays'}{'dates'}{$y});
1791 foreach my $m (keys %{ $$dmb{'data'}{'holidays'}{'dates'}{$y} }) {
1792 foreach my $d (keys %{ $$dmb{'data'}{'holidays'}{'dates'}{$y}{$m} }) {
1793 foreach my $nam (@{ $$dmb{'data'}{'holidays'}{'dates'}{$y}{$m}{$d} }) {
1794 if (lc($nam) eq lc($hol)) {
1795 return(1,$y,$m,$d);
1796 }
1797 }
1798 }
1799 }
1800 }
1801
1802 return (0);
1803}
1804
1805
# spent 5.16ms (66µs+5.10) within Date::Manip::Date::_parse_delta which was called 6 times, avg 860µs/call: # 6 times (66µs+5.10ms) by Date::Manip::Date::parse at line 257, avg 860µs/call
sub _parse_delta {
180664µs my($self,$string,$dow,$got_time,$h,$mn,$s,$noupdate) = @_;
180762µs my $dmt = $$self{'tz'};
180861µs my $dmb = $$dmt{'base'};
18096700ns my($y,$m,$d);
1810
1811611µs62.85ms my $delta = $self->new_delta();
# spent 2.85ms making 6 calls to Date::Manip::Obj::new_delta, avg 475µs/call
181265µs62.16ms my $err = $delta->parse($string);
# spent 2.16ms making 6 calls to Date::Manip::Delta::parse, avg 360µs/call
181366µs645µs my $tz = $dmt->_now('tz');
# spent 45µs making 6 calls to Date::Manip::TZ_Base::_now, avg 8µs/call
181464µs641µs my $isdst = $dmt->_now('isdst');
# spent 41µs making 6 calls to Date::Manip::TZ_Base::_now, avg 7µs/call
1815
181661µs if (! $err) {
1817 my($dy,$dm,$dw,$dd,$dh,$dmn,$ds) = @{ $$delta{'data'}{'delta'} };
1818
1819 if ($got_time &&
1820 ($dh != 0 || $dmn != 0 || $ds != 0)) {
1821 $$self{'err'} = '[parse] Two times entered or implied';
1822 return (1);
1823 }
1824
1825 if ($got_time) {
1826 ($y,$m,$d) = $self->_def_date($y,$m,$d,$noupdate);
1827 } else {
1828 ($y,$m,$d,$h,$mn,$s) = $dmt->_now('now',$$noupdate);
1829 $$noupdate = 1;
1830 }
1831
1832 my $business = $$delta{'data'}{'business'};
1833
1834 my($date2,$offset,$abbrev);
1835 ($err,$date2,$offset,$isdst,$abbrev) =
1836 $self->__calc_date_delta([$y,$m,$d,$h,$mn,$s],
1837 [$dy,$dm,$dw,$dd,$dh,$dmn,$ds],
1838 0,$business,$tz,$isdst);
1839 ($y,$m,$d,$h,$mn,$s) = @$date2;
1840
1841 if ($dow) {
1842 if ($dd != 0 || $dh != 0 || $dmn != 0 || $ds != 0) {
1843 $$self{'err'} = '[parse] Day of week not allowed';
1844 return (1);
1845 }
1846
1847 my($w,$dow1);
1848
1849 ($y,$w) = $dmb->week_of_year([$y,$m,$d]); # week of year
1850 ($y,$m,$d) = @{ $dmb->week_of_year($y,$w) }; # first day
1851 $dow1 = $dmb->day_of_week([$y,$m,$d]); # DoW of first day
1852 $dow1 -= 7 if ($dow1 > $dow);
1853 ($y,$m,$d) = @{ $dmb->calc_date_days([$y,$m,$d],$dow-$dow1) };
1854 }
1855
1856 return (1,$y,$m,$d,$h,$mn,$s);
1857 }
1858
1859620µs return (0);
1860}
1861
1862
# spent 17.8ms (8.64+9.20) within Date::Manip::Date::_parse_datetime_other which was called 2436 times, avg 7µs/call: # 2436 times (8.64ms+9.20ms) by Date::Manip::Date::parse at line 160, avg 7µs/call
sub _parse_datetime_other {
18632436501µs my($self,$string,$noupdate) = @_;
18642436406µs my $dmt = $$self{'tz'};
18652436311µs my $dmb = $$dmt{'base'};
1866
186724361.57ms15.13ms my $rx = (exists $$dmb{'data'}{'rx'}{'other'}{'miscdatetime'} ?
# spent 5.13ms making 1 call to Date::Manip::Date::_other_rx
1868 $$dmb{'data'}{'rx'}{'other'}{'miscdatetime'} :
1869 $self->_other_rx('miscdatetime'));
1870
187124368.33ms48724.07ms if ($string =~ $rx) {
# spent 2.55ms making 2436 calls to Date::Manip::Date::CORE:match, avg 1µs/call # spent 1.52ms making 2436 calls to Date::Manip::Date::CORE:regcomp, avg 625ns/call
1872 my ($special,$epoch,$y,$mmm,$d,$h,$mn,$s,$tzstring,$zone,$abb,$off) =
1873 @+{qw(special epoch y mmm d h mn s tzstring zone abb off)};
1874
1875 if ($tzstring) {
1876 }
1877
1878 if (defined($special)) {
1879 my $delta = $$dmb{'data'}{'wordmatch'}{'offset_time'}{lc($special)};
1880 my @delta = @{ $dmb->split('delta',$delta) };
1881 my @date = $dmt->_now('now',$$noupdate);
1882 my $tz = $dmt->_now('tz');
1883 my $isdst = $dmt->_now('isdst');
1884 $$noupdate = 1;
1885
1886 my($err,$date2,$offset,$abbrev);
1887 ($err,$date2,$offset,$isdst,$abbrev) =
1888 $self->__calc_date_delta([@date],[@delta],0,0,$tz,$isdst);
1889
1890 if ($tzstring) {
1891 my(@args);
1892 push(@args,$zone) if ($zone);
1893 push(@args,$abb) if ($abb);
1894 push(@args,$off) if ($off);
1895 push(@args,$date2);
1896 $zone = $dmt->zone(@args);
1897
1898 return (0) if (! $zone);
1899
1900 my(@tmp) = $dmt->_convert('_parse_datetime_other',$date2,$tz,$zone);
1901 $date2 = $tmp[1];
1902 }
1903
1904 @date = @$date2;
1905
1906 return (1,@date,$tzstring,$zone,$abb,$off);
1907
1908 } elsif (defined($epoch)) {
1909 my $date = [1970,1,1,0,0,0];
1910 my @delta = (0,0,$epoch);
1911 $date = $dmb->calc_date_time($date,\@delta);
1912 my($err);
1913 if ($tzstring) {
1914 my(@args);
1915 push(@args,$zone) if ($zone);
1916 push(@args,$abb) if ($abb);
1917 push(@args,$off) if ($off);
1918 push(@args,$date);
1919 $zone = $dmt->zone(@args);
1920
1921 return (0) if (! $zone);
1922
1923 ($err,$date) = $dmt->convert_from_gmt($date,$zone);
1924 } else {
1925 ($err,$date) = $dmt->convert_from_gmt($date);
1926 }
1927 return (1,@$date,$tzstring,$zone,$abb,$off);
1928
1929 } elsif (defined($y)) {
1930 my $m = $$dmb{'data'}{'wordmatch'}{'month_abb'}{lc($mmm)};
1931 return (1,$y,$m,$d,$h,$mn,$s,$tzstring,$zone,$abb,$off);
1932 }
1933 }
1934
193524362.84ms return (0);
1936}
1937
1938
# spent 2.10ms (36µs+2.07) within Date::Manip::Date::_parse_date_other which was called 6 times, avg 351µs/call: # 6 times (36µs+2.07ms) by Date::Manip::Date::_parse_date at line 473, avg 351µs/call
sub _parse_date_other {
193962µs my($self,$string,$dow,$of,$noupdate) = @_;
194062µs my $dmt = $$self{'tz'};
194162µs my $dmb = $$dmt{'base'};
19426800ns my($y,$m,$d,$h,$mn,$s);
1943
194466µs12.02ms my $rx = (exists $$dmb{'data'}{'rx'}{'other'}{'misc'} ?
# spent 2.02ms making 1 call to Date::Manip::Date::_other_rx
1945 $$dmb{'data'}{'rx'}{'other'}{'misc'} :
1946 $self->_other_rx('misc'));
1947
194861µs my($mmm,$month,$nextprev,$last,$field_y,$field_m,$field_w,$field_d,$nth);
1949 my($special,$got_m,$n,$got_y);
1950
1951657µs1244µs if ($string =~ $rx) {
# spent 26µs making 6 calls to Date::Manip::Date::CORE:regcomp, avg 4µs/call # spent 19µs making 6 calls to Date::Manip::Date::CORE:match, avg 3µs/call
1952 ($y,$mmm,$month,$nextprev,$last,$field_y,$field_m,$field_w,$field_d,$nth,
1953 $special,$n) =
1954 @+{qw(y mmm month next last field_y field_m field_w field_d
1955 nth special n)};
1956
1957 if (defined($y)) {
1958 $y = $dmt->_fix_year($y);
1959 $got_y = 1;
1960 return () if (! $y);
1961 } else {
1962 $y = $dmt->_now('y',$$noupdate);
1963 $$noupdate = 1;
1964 $got_y = 0;
1965 $$self{'data'}{'def'}[0] = '';
1966 }
1967
1968 if (defined($mmm)) {
1969 $m = $$dmb{'data'}{'wordmatch'}{'month_abb'}{lc($mmm)};
1970 $got_m = 1;
1971 } elsif ($month) {
1972 $m = $$dmb{'data'}{'wordmatch'}{'month_name'}{lc($month)};
1973 $got_m = 1;
1974 }
1975
1976 if ($nth) {
1977 $nth = $$dmb{'data'}{'wordmatch'}{'nth'}{lc($nth)};
1978 }
1979
1980 if ($got_m && $nth && ! $dow) {
1981 # Dec 1st 1970
1982 # 1st Dec 1970
1983 # 1970 Dec 1st
1984 # 1970 1st Dec
1985
1986 $d = $nth;
1987
1988 } elsif ($nextprev) {
1989
1990 my $next = 0;
1991 my $sign = -1;
1992 if ($$dmb{'data'}{'wordmatch'}{'nextprev'}{lc($nextprev)} == 1) {
1993 $next = 1;
1994 $sign = 1;
1995 }
1996
1997 if ($field_y || $field_m || $field_w) {
1998 # next/prev year/month/week
1999
2000 my(@delta);
2001 if ($field_y) {
2002 @delta = ($sign*1,0,0,0,0,0,0);
2003 } elsif ($field_m) {
2004 @delta = (0,$sign*1,0,0,0,0,0);
2005 } else {
2006 @delta = (0,0,$sign*1,0,0,0,0);
2007 }
2008
2009 my @now = $dmt->_now('now',$$noupdate);
2010 my $tz = $dmt->_now('tz');
2011 my $isdst = $dmt->_now('isdst');
2012 $$noupdate = 1;
2013
2014 my($err,$offset,$abbrev,$date2);
2015 ($err,$date2,$offset,$isdst,$abbrev) =
2016 $self->__calc_date_delta([@now],[@delta],0,0,$tz,$isdst);
2017 ($y,$m,$d,$h,$mn,$s) = @$date2;
2018
2019 } elsif ($dow) {
2020 # next/prev friday
2021
2022 my @now = $dmt->_now('now',$$noupdate);
2023 $$noupdate = 1;
2024 ($y,$m,$d,$h,$mn,$s) = @{ $self->__next_prev(\@now,$next,$dow,0) };
2025 $dow = 0;
2026
2027 } else {
2028 return ();
2029 }
2030
2031 } elsif ($last) {
2032
2033 if ($field_d && $got_m) {
2034 # last day in october 95
2035
2036 $d = $dmb->days_in_month($y,$m);
2037
2038 } elsif ($dow && $got_m) {
2039 # last friday in october 95
2040
2041 $d = $dmb->days_in_month($y,$m);
2042 ($y,$m,$d,$h,$mn,$s) =
2043 @{ $self->__next_prev([$y,$m,$d,0,0,0],0,$dow,1) };
2044 $dow = 0;
2045
2046 } elsif ($dow) {
2047 # last friday in 95
2048
2049 ($y,$m,$d,$h,$mn,$s) =
2050 @{ $self->__next_prev([$y,12,31,0,0,0],0,$dow,0) };
2051
2052 } else {
2053 return ();
2054 }
2055
2056 } elsif ($nth && $dow && ! $field_w) {
2057
2058 if ($got_m) {
2059 if ($of) {
2060 # nth DoW of MMM [YYYY]
2061 return () if ($nth > 5);
2062
2063 $d = 1;
2064 ($y,$m,$d,$h,$mn,$s) =
2065 @{ $self->__next_prev([$y,$m,1,0,0,0],1,$dow,1) };
2066 my $m2 = $m;
2067 ($y,$m2,$d) = @{ $dmb->calc_date_days([$y,$m,$d],7*($nth-1)) }
2068 if ($nth > 1);
2069 return () if (! $m2 || $m2 != $m);
2070
2071 } else {
2072 # DoW, nth MMM [YYYY] (i.e. Sunday, 9th Dec 2008)
2073 $d = $nth;
2074 }
2075
2076 } else {
2077 # nth DoW [in YYYY]
2078
2079 ($y,$m,$d,$h,$mn,$s) = @{ $self->__next_prev([$y,1,1,0,0,0],1,$dow,1) };
2080 ($y,$m,$d) = @{ $dmb->calc_date_days([$y,$m,$d],7*($nth-1)) }
2081 if ($nth > 1);
2082 }
2083
2084 } elsif ($field_w && $dow) {
2085
2086 if (defined($n) || $nth) {
2087 # sunday week 22 in 1996
2088 # sunday 22nd week in 1996
2089
2090 $n = $nth if ($nth);
2091 return () if (! $n);
2092 ($y,$m,$d) = @{ $dmb->week_of_year($y,$n) };
2093 ($y,$m,$d) = @{ $self->__next_prev([$y,$m,$d,0,0,0],1,$dow,1) };
2094
2095 } else {
2096 # DoW week
2097
2098 ($y,$m,$d) = $dmt->_now('now',$$noupdate);
2099 $$noupdate = 1;
2100 my $tmp = $dmb->_config('firstday');
2101 ($y,$m,$d) = @{ $self->__next_prev([$y,$m,$d,0,0,0],1,$tmp,0) };
2102 ($y,$m,$d) = @{ $self->__next_prev([$y,$m,$d,0,0,0],1,$dow,1) };
2103 }
2104
2105 } elsif ($nth && ! $got_y) {
2106 # 'in one week' makes it here too so return nothing in that case so it
2107 # drops through to the deltas.
2108 return () if ($field_d || $field_w || $field_m || $field_y);
2109 ($y,$m,$d) = $dmt->_now('now',$$noupdate);
2110 $$noupdate = 1;
2111 $d = $nth;
2112
2113 } elsif ($special) {
2114
2115 my $delta = $$dmb{'data'}{'wordmatch'}{'offset_date'}{lc($special)};
2116 my @delta = @{ $dmb->split('delta',$delta) };
2117 ($y,$m,$d) = $dmt->_now('now',$$noupdate);
2118 my $tz = $dmt->_now('tz');
2119 my $isdst = $dmt->_now('isdst');
2120 $$noupdate = 1;
2121 my($err,$offset,$abbrev,$date2);
2122 ($err,$date2,$offset,$isdst,$abbrev) =
2123 $self->__calc_date_delta([$y,$m,$d,0,0,0],[@delta],0,0,$tz,$isdst);
2124 ($y,$m,$d) = @$date2;
2125
2126 if ($field_w) {
2127 ($y,$m,$d) = @{ $dmb->calc_date_days([$y,$m,$d],7) };
2128 }
2129 }
2130
2131 } else {
213269µs return ();
2133 }
2134
2135 return($y,$m,$d,$dow);
2136}
2137
2138# Supply defaults for missing values (Y/M/D)
2139
# spent 26.6ms (9.23+17.4) within Date::Manip::Date::_def_date which was called 2430 times, avg 11µs/call: # 2430 times (9.23ms+17.4ms) by Date::Manip::Date::_parse_date_common at line 1706, avg 11µs/call
sub _def_date {
21402430744µs my($self,$y,$m,$d,$noupdate) = @_;
21412430257µs $y = '' if (! defined $y);
21422430185µs $m = '' if (! defined $m);
21432430182µs $d = '' if (! defined $d);
21442430211µs my $defined = 0;
21452430352µs my $dmt = $$self{'tz'};
21462430306µs my $dmb = $$dmt{'base'};
2147
2148 # If year was not specified, defaults to current year.
2149 #
2150 # We'll also fix the year (turn 2-digit into 4-digit).
2151
21522430587µs if ($y eq '') {
2153 $y = $dmt->_now('y',$$noupdate);
2154 $$noupdate = 1;
2155 $$self{'data'}{'def'}[0] = '';
2156 } else {
215724302.17ms243017.4ms $y = $dmt->_fix_year($y);
# spent 17.4ms making 2430 calls to Date::Manip::TZ_Base::_fix_year, avg 7µs/call
21582430404µs $defined = 1;
2159 }
2160
2161 # If the month was not specifed, but the year was, a default of
2162 # 01 is supplied (this is a truncated date).
2163 #
2164 # If neither was specified, month defaults to the current month.
2165
21662430642µs if ($m ne '') {
2167 $defined = 1;
2168 } elsif ($defined) {
2169 $m = 1;
2170 $$self{'data'}{'def'}[1] = 1;
2171 } else {
2172 $m = $dmt->_now('m',$$noupdate);
2173 $$noupdate = 1;
2174 $$self{'data'}{'def'}[1] = '';
2175 }
2176
2177 # If the day was not specified, but the year or month was, a default
2178 # of 01 is supplied (this is a truncated date).
2179 #
2180 # If none were specified, it default to the current day.
2181
21822430317µs if ($d ne '') {
2183 $defined = 1;
2184 } elsif ($defined) {
2185 $d = 1;
2186 $$self{'data'}{'def'}[2] = 1;
2187 } else {
2188 $d = $dmt->_now('d',$$noupdate);
2189 $$noupdate = 1;
2190 $$self{'data'}{'def'}[2] = '';
2191 }
2192
219324303.16ms return($y,$m,$d);
2194}
2195
2196# Supply defaults for missing values (Y/DoY)
2197sub _def_date_doy {
2198 my($self,$y,$doy,$noupdate) = @_;
2199 $y = '' if (! defined $y);
2200 my $dmt = $$self{'tz'};
2201 my $dmb = $$dmt{'base'};
2202
2203 # If year was not specified, defaults to current year.
2204 #
2205 # We'll also fix the year (turn 2-digit into 4-digit).
2206
2207 if ($y eq '') {
2208 $y = $dmt->_now('y',$$noupdate);
2209 $$noupdate = 1;
2210 $$self{'data'}{'def'}[0] = '';
2211 } else {
2212 $y = $dmt->_fix_year($y);
2213 }
2214
2215 # DoY must be specified.
2216
2217 my($m,$d);
2218 my $ymd = $dmb->day_of_year($y,$doy);
2219
2220 return @$ymd;
2221}
2222
2223# Supply defaults for missing values (YY/Www/D) and (Y/Www/D)
2224sub _def_date_dow {
2225 my($self,$y,$w,$dow,$noupdate) = @_;
2226 $y = '' if (! defined $y);
2227 $w = '' if (! defined $w);
2228 $dow = '' if (! defined $dow);
2229 my $dmt = $$self{'tz'};
2230 my $dmb = $$dmt{'base'};
2231
2232 # If year was not specified, defaults to current year.
2233 #
2234 # If it was specified and is a single digit, it is the
2235 # year in the current decade.
2236 #
2237 # We'll also fix the year (turn 2-digit into 4-digit).
2238
2239 if ($y ne '') {
2240 if (length($y) == 1) {
2241 my $tmp = $dmt->_now('y',$$noupdate);
2242 $tmp =~ s/.$/$y/;
2243 $y = $tmp;
2244 $$noupdate = 1;
2245
2246 } else {
2247 $y = $dmt->_fix_year($y);
2248
2249 }
2250
2251 } else {
2252 $y = $dmt->_now('y',$$noupdate);
2253 $$noupdate = 1;
2254 $$self{'data'}{'def'}[0] = '';
2255 }
2256
2257 # If week was not specified, it defaults to the current
2258 # week. Get the first day of the week.
2259
2260 my($m,$d);
2261 if ($w ne '') {
2262 ($y,$m,$d) = @{ $dmb->week_of_year($y,$w) };
2263 } else {
2264 my($nowy,$nowm,$nowd) = $dmt->_now('now',$$noupdate);
2265 $$noupdate = 1;
2266 my $noww;
2267 ($nowy,$noww) = $dmb->week_of_year([$nowy,$nowm,$nowd]);
2268 ($y,$m,$d) = @{ $dmb->week_of_year($nowy,$noww) };
2269 }
2270
2271 # Handle the DoW
2272
2273 if ($dow eq '') {
2274 $dow = 1;
2275 }
2276 my $n = $dmb->days_in_month($y,$m);
2277 $d += ($dow-1);
2278 if ($d > $n) {
2279 $m++;
2280 if ($m==13) {
2281 $y++;
2282 $m = 1;
2283 }
2284 $d = $d-$n;
2285 }
2286
2287 return($y,$m,$d);
2288}
2289
2290# Supply defaults for missing values (HH:MN:SS)
2291
# spent 9.33ms within Date::Manip::Date::_def_time which was called 4872 times, avg 2µs/call: # 2436 times (5.66ms+0s) by Date::Manip::Date::_parse_time at line 1636, avg 2µs/call # 2436 times (3.67ms+0s) by Date::Manip::Date::_time at line 1285, avg 2µs/call
sub _def_time {
229248721.21ms my($self,$h,$m,$s,$noupdate) = @_;
22934872462µs $h = '' if (! defined $h);
22944872318µs $m = '' if (! defined $m);
22954872290µs $s = '' if (! defined $s);
22964872465µs my $defined = 0;
22974872599µs my $dmt = $$self{'tz'};
22984872582µs my $dmb = $$dmt{'base'};
2299
2300 # If no time was specified, defaults to 00:00:00.
2301
23024872552µs if ($h eq '' &&
2303 $m eq '' &&
2304 $s eq '') {
2305 $$self{'data'}{'def'}[3] = 1;
2306 $$self{'data'}{'def'}[4] = 1;
2307 $$self{'data'}{'def'}[5] = 1;
2308 return(0,0,0);
2309 }
2310
2311 # If hour was not specified, defaults to current hour.
2312
23134872740µs if ($h ne '') {
2314 $defined = 1;
2315 } else {
2316 $h = $dmt->_now('h',$$noupdate);
2317 $$noupdate = 1;
2318 $$self{'data'}{'def'}[3] = '';
2319 }
2320
2321 # If the minute was not specifed, but the hour was, a default of
2322 # 00 is supplied (this is a truncated time).
2323 #
2324 # If neither was specified, minute defaults to the current minute.
2325
23264872543µs if ($m ne '') {
2327 $defined = 1;
2328 } elsif ($defined) {
2329 $m = 0;
2330 $$self{'data'}{'def'}[4] = 1;
2331 } else {
2332 $m = $dmt->_now('mn',$$noupdate);
2333 $$noupdate = 1;
2334 $$self{'data'}{'def'}[4] = '';
2335 }
2336
2337 # If the second was not specified (either the hour or the minute were),
2338 # a default of 00 is supplied (this is a truncated time).
2339
23404872435µs if ($s eq '') {
2341 $s = 0;
2342 $$self{'data'}{'def'}[5] = 1;
2343 }
2344
234548726.07ms return($h,$m,$s);
2346}
2347
2348########################################################################
2349# OTHER DATE METHODS
2350########################################################################
2351
2352# Gets the date in the parsed timezone (if $type = ''), local timezone
2353# (if $type = 'local') or GMT timezone (if $type = 'gmt').
2354#
2355# Gets the string value in scalar context, the split value in list
2356# context.
2357#
2358sub value {
2359 my($self,$type) = @_;
2360 my $dmt = $$self{'tz'};
2361 my $dmb = $$dmt{'base'};
2362 my $date;
2363
2364 while (1) {
2365 if (! $$self{'data'}{'set'}) {
2366 $$self{'err'} = '[value] Object does not contain a date';
2367 last;
2368 }
2369
2370 $type = '' if (! $type);
2371
2372 if ($type eq 'gmt') {
2373
2374 if (! @{ $$self{'data'}{'gmt'} }) {
2375 my $zone = $$self{'data'}{'tz'};
2376 my $date = $$self{'data'}{'date'};
2377
2378 if ($zone eq 'Etc/GMT') {
2379 $$self{'data'}{'gmt'} = $date;
2380
2381 } else {
2382 my $isdst = $$self{'data'}{'isdst'};
2383 my($err,$d) = $dmt->convert_to_gmt($date,$zone,$isdst);
2384 if ($err) {
2385 $$self{'err'} = '[value] Unable to convert date to GMT';
2386 last;
2387 }
2388 $$self{'data'}{'gmt'} = $d;
2389 }
2390 }
2391 $date = $$self{'data'}{'gmt'};
2392
2393 } elsif ($type eq 'local') {
2394
2395 if (! @{ $$self{'data'}{'loc'} }) {
2396 my $zone = $$self{'data'}{'tz'};
2397 $date = $$self{'data'}{'date'};
2398 my $local = $dmt->_now('tz',1);
2399
2400 if ($zone eq $local) {
2401 $$self{'data'}{'loc'} = $date;
2402
2403 } else {
2404 my $isdst = $$self{'data'}{'isdst'};
2405 my($err,$d) = $dmt->convert_to_local($date,$zone,$isdst);
2406 if ($err) {
2407 $$self{'err'} = '[value] Unable to convert date to localtime';
2408 last;
2409 }
2410 $$self{'data'}{'loc'} = $d;
2411 }
2412 }
2413 $date = $$self{'data'}{'loc'};
2414
2415 } else {
2416
2417 $date = $$self{'data'}{'date'};
2418
2419 }
2420
2421 last;
2422 }
2423
2424 if ($$self{'err'}) {
2425 if (wantarray) {
2426 return ();
2427 } else {
2428 return '';
2429 }
2430 }
2431
2432 if (wantarray) {
2433 return @$date;
2434 } else {
2435 return $dmb->join('date',$date);
2436 }
2437}
2438
2439sub cmp {
2440 my($self,$date) = @_;
2441 if ($$self{'err'} || ! $$self{'data'}{'set'}) {
2442 warn "WARNING: [cmp] Arguments must be valid dates: date1\n";
2443 return undef;
2444 }
2445
2446 if (! ref($date) eq 'Date::Manip::Date') {
2447 warn "WARNING: [cmp] Argument must be a Date::Manip::Date object\n";
2448 return undef;
2449 }
2450 if ($$date{'err'} || ! $$date{'data'}{'set'}) {
2451 warn "WARNING: [cmp] Arguments must be valid dates: date2\n";
2452 return undef;
2453 }
2454
2455 my($d1,$d2);
2456 if ($$self{'data'}{'tz'} eq $$date{'data'}{'tz'}) {
2457 $d1 = $self->value();
2458 $d2 = $date->value();
2459 } else {
2460 $d1 = $self->value('gmt');
2461 $d2 = $date->value('gmt');
2462 }
2463
2464 return ($d1 cmp $d2);
2465}
2466
2467
# spent 6µs within Date::Manip::Date::BEGIN@2467 which was called: # once (6µs+0s) by main::RUNTIME at line 2686
BEGIN {
246816µs my %field = qw(y 0 m 1 d 2 h 3 mn 4 s 5);
2469
2470
# spent 127ms (32.2+95.3) within Date::Manip::Date::set which was called 2430 times, avg 52µs/call: # 2430 times (32.2ms+95.3ms) by Date::Manip::Date::_parse_check at line 1024, avg 52µs/call
sub set {
24712430922µs my($self,$field,@val) = @_;
24722430533µs $field = lc($field);
24732430432µs my $dmt = $$self{'tz'};
24742430315µs my $dmb = $$dmt{'base'};
2475
2476 # Make sure $self includes a valid date (unless the entire date is
2477 # being set, in which case it doesn't matter).
2478
24792430213µs my($date,@def,$tz,$isdst);
2480
24812430577µs if ($field eq 'zdate') {
2482 # If {data}{set} = 2, we want to preserve the defaults. Also, we've
2483 # already initialized.
2484 #
2485 # It is only set in the parse routines which means that this was
2486 # called via _parse_check.
2487
24882430581µs $self->_init() if ($$self{'data'}{'set'} != 2);
248924301.34ms @def = @{ $$self{'data'}{'def'} };
2490
2491 } elsif ($field eq 'date') {
2492 if ($$self{'data'}{'set'} && ! $$self{'err'}) {
2493 $tz = $$self{'data'}{'tz'};
2494 } else {
2495 $tz = $dmt->_now('tz',1);
2496 }
2497 $self->_init();
2498 @def = @{ $$self{'data'}{'def'} };
2499
2500 } else {
2501 return 1 if ($$self{'err'} || ! $$self{'data'}{'set'});
2502 $date = $$self{'data'}{'date'};
2503 $tz = $$self{'data'}{'tz'};
2504 $isdst = $$self{'data'}{'isdst'};
2505 @def = @{ $$self{'data'}{'def'} };
2506 $self->_init();
2507 }
2508
2509 # Check the arguments
2510
25112430179µs my($err,$new_tz,$new_date,$new_time);
2512
25132430832µs if ($field eq 'date') {
2514
2515 if ($#val == 0) {
2516 # date,DATE
2517 $new_date = $val[0];
2518 } elsif ($#val == 1) {
2519 # date,DATE,ISDST
2520 ($new_date,$isdst) = @val;
2521 } else {
2522 $err = 1;
2523 }
2524 for (my $i=0; $i<=5; $i++) {
2525 $def[$i] = 0 if ($def[$i]);
2526 }
2527
2528 } elsif ($field eq 'time') {
2529
2530 if ($#val == 0) {
2531 # time,TIME
2532 $new_time = $val[0];
2533 } elsif ($#val == 1) {
2534 # time,TIME,ISDST
2535 ($new_time,$isdst) = @val;
2536 } else {
2537 $err = 1;
2538 }
2539 $def[3] = 0 if ($def[3]);
2540 $def[4] = 0 if ($def[4]);
2541 $def[5] = 0 if ($def[5]);
2542
2543 } elsif ($field eq 'zdate') {
2544
254524301.81ms if ($#val == 0) {
2546 # zdate,DATE
2547 $new_date = $val[0];
2548 } elsif ($#val == 1 && ($val[1] eq '0' || $val[1] eq '1')) {
2549 # zdate,DATE,ISDST
2550 ($new_date,$isdst) = @val;
2551 } elsif ($#val == 1) {
2552 # zdate,ZONE,DATE
2553 ($new_tz,$new_date) = @val;
2554 } elsif ($#val == 2) {
2555 # zdate,ZONE,DATE,ISDST
2556 ($new_tz,$new_date,$isdst) = @val;
2557 } else {
2558 $err = 1;
2559 }
256024302.93ms for (my $i=0; $i<=5; $i++) {
2561 $def[$i] = 0 if ($def[$i]);
2562 }
25632430372µs $tz = $dmt->_now('tz',1) if (! $new_tz);
2564
2565 } elsif ($field eq 'zone') {
2566
2567 if ($#val == -1) {
2568 # zone
2569 } elsif ($#val == 0 && ($val[0] eq '0' || $val[0] eq '1')) {
2570 # zone,ISDST
2571 $isdst = $val[0];
2572 } elsif ($#val == 0) {
2573 # zone,ZONE
2574 $new_tz = $val[0];
2575 } elsif ($#val == 1) {
2576 # zone,ZONE,ISDST
2577 ($new_tz,$isdst) = @val;
2578 } else {
2579 $err = 1;
2580 }
2581 $tz = $dmt->_now('tz',1) if (! $new_tz);
2582
2583 } elsif (exists $field{$field}) {
2584
2585 my $i = $field{$field};
2586 my $val;
2587 if ($#val == 0) {
2588 $val = $val[0];
2589 } elsif ($#val == 1) {
2590 ($val,$isdst) = @val;
2591 } else {
2592 $err = 1;
2593 }
2594
2595 $$date[$i] = $val;
2596 $def[$i] = 0 if ($def[$i]);
2597
2598 } else {
2599
2600 $err = 2;
2601
2602 }
2603
26042430195µs if ($err) {
2605 if ($err == 1) {
2606 $$self{'err'} = '[set] Invalid arguments';
2607 } else {
2608 $$self{'err'} = '[set] Invalid field';
2609 }
2610 return 1;
2611 }
2612
2613 # Handle the arguments
2614
26152430433µs if ($new_tz) {
261624301.66ms24304.13ms my $tmp = $dmt->_zone($new_tz);
# spent 4.13ms making 2430 calls to Date::Manip::TZ::_zone, avg 2µs/call
26172430644µs if ($tmp) {
2618 # A zone/alias
2619 $tz = $tmp;
2620
2621 } else {
2622 # An offset
2623 my ($err,@args);
2624 push(@args,$date) if ($date);
2625 push(@args,$new_tz);
2626 push(@args,($isdst ? 'dstonly' : 'stdonly')) if (defined $isdst);
2627 $tz = $dmb->zone(@args);
2628
2629 if (! $tz) {
2630 $$self{'err'} = "[set] Invalid timezone argument: $new_tz";
2631 return 1;
2632 }
2633 }
2634 }
2635
26362430509µs if ($new_date) {
263724301.45ms243022.2ms if ($dmb->check($new_date)) {
# spent 22.2ms making 2430 calls to Date::Manip::Base::check, avg 9µs/call
2638 $date = $new_date;
2639 } else {
2640 $$self{'err'} = '[set] Invalid date argument';
2641 return 1;
2642 }
2643 }
2644
26452430185µs if ($new_time) {
2646 if ($dmb->check_time($new_time)) {
2647 $$date[3] = $$new_time[0];
2648 $$date[4] = $$new_time[1];
2649 $$date[5] = $$new_time[2];
2650 } else {
2651 $$self{'err'} = '[set] Invalid time argument';
2652 return 1;
2653 }
2654 }
2655
2656 # Check the date/timezone combination
2657
26582430217µs my($abb,$off);
26592430588µs if ($tz eq 'etc/gmt') {
2660 $abb = 'GMT';
2661 $off = [0,0,0];
2662 $isdst = 0;
2663 } else {
266424301.95ms243069.0ms my $per = $dmt->date_period($date,$tz,1,$isdst);
# spent 69.0ms making 2430 calls to Date::Manip::TZ::date_period, avg 28µs/call
26652430277µs if (! $per) {
2666 $$self{'err'} = '[set] Invalid date/timezone';
2667 return 1;
2668 }
26692430358µs $isdst = $$per[5];
26702430310µs $abb = $$per[4];
267124301.61ms $off = $$per[3];
2672 }
2673
2674 # Set the information
2675
26762430512µs $$self{'data'}{'set'} = 1;
26772430687µs $$self{'data'}{'date'} = $date;
26782430527µs $$self{'data'}{'tz'} = $tz;
26792430628µs $$self{'data'}{'isdst'} = $isdst;
26802430431µs $$self{'data'}{'offset'}= $off;
26812430427µs $$self{'data'}{'abb'} = $abb;
268224301.42ms $$self{'data'}{'def'} = [ @def ];
2683
268424303.40ms return 0;
2685 }
26861851µs16µs}
# spent 6µs making 1 call to Date::Manip::Date::BEGIN@2467
2687
2688########################################################################
2689# NEXT/PREV METHODS
2690
2691sub prev {
2692 my($self,@args) = @_;
2693 return 1 if ($$self{'err'} || ! $$self{'data'}{'set'});
2694 my $date = $$self{'data'}{'date'};
2695
2696 $date = $self->__next_prev($date,0,@args);
2697
2698 return 1 if (! defined($date));
2699 $self->set('date',$date);
2700 return 0;
2701}
2702
2703sub next {
2704 my($self,@args) = @_;
2705 return 1 if ($$self{'err'} || ! $$self{'data'}{'set'});
2706 my $date = $$self{'data'}{'date'};
2707
2708 $date = $self->__next_prev($date,1,@args);
2709
2710 return 1 if (! defined($date));
2711 $self->set('date',$date);
2712 return 0;
2713}
2714
2715sub __next_prev {
2716 my($self,$date,$next,$dow,$curr,$time) = @_;
2717
2718 my ($caller,$sign,$prev);
2719 if ($next) {
2720 $caller = 'next';
2721 $sign = 1;
2722 $prev = 0;
2723 } else {
2724 $caller = 'prev';
2725 $sign = -1;
2726 $prev = 1;
2727 }
2728
2729 my $dmt = $$self{'tz'};
2730 my $dmb = $$dmt{'base'};
2731 my $orig = [ @$date ];
2732
2733 # Check the time (if any)
2734
2735 if (defined($time)) {
2736 if ($dow) {
2737 # $time will refer to a full [H,MN,S]
2738 my($err,$h,$mn,$s) = $dmb->_hms_fields({ 'out' => 'list' },$time);
2739 if ($err) {
2740 $$self{'err'} = "[$caller] invalid time argument";
2741 return undef;
2742 }
2743 $time = [$h,$mn,$s];
2744 } else {
2745 # $time may have leading undefs
2746 my @tmp = @$time;
2747 if ($#tmp != 2) {
2748 $$self{'err'} = "[$caller] invalid time argument";
2749 return undef;
2750 }
2751 my($h,$mn,$s) = @$time;
2752 if (defined($h)) {
2753 $mn = 0 if (! defined($mn));
2754 $s = 0 if (! defined($s));
2755 } elsif (defined($mn)) {
2756 $s = 0 if (! defined($s));
2757 } else {
2758 $s = 0 if (! defined($s));
2759 }
2760 $time = [$h,$mn,$s];
2761 }
2762 }
2763
2764 # Find the next DoW
2765
2766 if ($dow) {
2767
2768 if (! $dmb->_is_int($dow,1,7)) {
2769 $$self{'err'} = "[$caller] Invalid DOW: $dow";
2770 return undef;
2771 }
2772
2773 # Find the next/previous occurrence of DoW
2774
2775 my $curr_dow = $dmb->day_of_week($date);
2776 my $adjust = 0;
2777
2778 if ($dow == $curr_dow) {
2779 $adjust = 1 if ($curr == 0);
2780
2781 } else {
2782 my $num;
2783 if ($next) {
2784 # force $dow to be more than $curr_dow
2785 $dow += 7 if ($dow<$curr_dow);
2786 $num = $dow - $curr_dow;
2787 } else {
2788 # force $dow to be less than $curr_dow
2789 $dow -= 7 if ($dow>$curr_dow);
2790 $num = $curr_dow - $dow;
2791 $num *= -1;
2792 }
2793
2794 # Add/subtract $num days
2795 $date = $dmb->calc_date_days($date,$num);
2796 }
2797
2798 if (defined($time)) {
2799 my ($y,$m,$d,$h,$mn,$s) = @$date;
2800 ($h,$mn,$s) = @$time;
2801 $date = [$y,$m,$d,$h,$mn,$s];
2802 }
2803
2804 my $cmp = $dmb->cmp($orig,$date);
2805 $adjust = 1 if ($curr == 2 && $cmp != -1*$sign);
2806
2807 if ($adjust) {
2808 # Add/subtract 1 week
2809 $date = $dmb->calc_date_days($date,$sign*7);
2810 }
2811
2812 return $date;
2813 }
2814
2815 # Find the next Time
2816
2817 if (defined($time)) {
2818
2819 my ($h,$mn,$s) = @$time;
2820 my $orig = [ @$date ];
2821
2822 my $cmp;
2823 if (defined $h) {
2824 # Find next/prev HH:MN:SS
2825
2826 @$date[3..5] = @$time;
2827 $cmp = $dmb->cmp($orig,$date);
2828 if ($cmp == -1) {
2829 if ($prev) {
2830 $date = $dmb->calc_date_days($date,-1);
2831 }
2832 } elsif ($cmp == 1) {
2833 if ($next) {
2834 $date = $dmb->calc_date_days($date,1);
2835 }
2836 } else {
2837 if (! $curr) {
2838 $date = $dmb->calc_date_days($date,$sign);
2839 }
2840 }
2841
2842 } elsif (defined $mn) {
2843 # Find next/prev MN:SS
2844
2845 @$date[4..5] = @$time[1..2];
2846
2847 $cmp = $dmb->cmp($orig,$date);
2848 if ($cmp == -1) {
2849 if ($prev) {
2850 $date = $dmb->calc_date_time($date,[-1,0,0]);
2851 }
2852 } elsif ($cmp == 1) {
2853 if ($next) {
2854 $date = $dmb->calc_date_time($date,[1,0,0]);
2855 }
2856 } else {
2857 if (! $curr) {
2858 $date = $dmb->calc_date_time($date,[$sign,0,0]);
2859 }
2860 }
2861
2862 } else {
2863 # Find next/prev SS
2864
2865 $$date[5] = $$time[2];
2866
2867 $cmp = $dmb->cmp($orig,$date);
2868 if ($cmp == -1) {
2869 if ($prev) {
2870 $date = $dmb->calc_date_time($date,[0,-1,0]);
2871 }
2872 } elsif ($cmp == 1) {
2873 if ($next) {
2874 $date = $dmb->calc_date_time($date,[0,1,0]);
2875 }
2876 } else {
2877 if (! $curr) {
2878 $date = $dmb->calc_date_time($date,[0,$sign,0]);
2879 }
2880 }
2881 }
2882
2883 return $date;
2884 }
2885
2886 $$self{'err'} = "[$caller] Either DoW or time (or both) required";
2887 return undef;
2888}
2889
2890########################################################################
2891# CALC METHOD
2892
2893sub calc {
2894 my($self,$obj,@args) = @_;
2895
2896 if (ref($obj) eq 'Date::Manip::Date') {
2897 return $self->_calc_date_date($obj,@args);
2898
2899 } elsif (ref($obj) eq 'Date::Manip::Delta') {
2900 return $self->_calc_date_delta($obj,@args);
2901
2902 } else {
2903 return undef;
2904 }
2905}
2906
2907sub _calc_date_date {
2908 my($self,$date,@args) = @_;
2909 my $ret = $self->new_delta();
2910
2911 if ($$self{'err'} || ! $$self{'data'}{'set'}) {
2912 $$ret{'err'} = '[calc] First object invalid (date)';
2913 return $ret;
2914 }
2915
2916 if ($$date{'err'} || ! $$date{'data'}{'set'}) {
2917 $$ret{'err'} = '[calc] Second object invalid (date)';
2918 return $ret;
2919 }
2920
2921 # Handle subtract/mode arguments
2922
2923 my($subtract,$mode);
2924
2925 if ($#args == -1) {
2926 ($subtract,$mode) = (0,'');
2927 } elsif ($#args == 0) {
2928 if ($args[0] eq '0' || $args[0] eq '1') {
2929 ($subtract,$mode) = ($args[0],'');
2930 } else {
2931 ($subtract,$mode) = (0,$args[0]);
2932 }
2933
2934 } elsif ($#args == 1) {
2935 ($subtract,$mode) = @args;
2936 } else {
2937 $$ret{'err'} = '[calc] Invalid arguments';
2938 return $ret;
2939 }
2940 $mode = 'exact' if (! $mode);
2941
2942 if ($mode !~ /^(business|bsemi|bapprox|approx|semi|exact)$/i) {
2943 $$ret{'err'} = '[calc] Invalid mode argument';
2944 return $ret;
2945 }
2946
2947 # if business mode
2948 # dates must be in the same timezone
2949 # use dates in that zone
2950 #
2951 # otherwise if both dates are in the same timezone && approx/semi mode
2952 # use the dates in that zone
2953 #
2954 # otherwise
2955 # convert to gmt
2956 # use those dates
2957
2958 my($date1,$date2,$tz1,$isdst1,$tz2,$isdst2);
2959 if ($mode eq 'business' || $mode eq 'bapprox' || $mode eq 'bsemi') {
2960 if ($$self{'data'}{'tz'} eq $$date{'data'}{'tz'}) {
2961 $date1 = [ $self->value() ];
2962 $date2 = [ $date->value() ];
2963 $tz1 = $$self{'data'}{'tz'};
2964 $tz2 = $tz1;
2965 $isdst1 = $$self{'data'}{'isdst'};
2966 $isdst2 = $$date{'data'}{'isdst'};
2967 } else {
2968 $$ret{'err'} = '[calc] Dates must be in the same timezone for ' .
2969 'business mode calculations';
2970 return $ret;
2971 }
2972
2973 } elsif (($mode eq 'approx' || $mode eq 'semi') &&
2974 $$self{'data'}{'tz'} eq $$date{'data'}{'tz'}) {
2975 $date1 = [ $self->value() ];
2976 $date2 = [ $date->value() ];
2977 $tz1 = $$self{'data'}{'tz'};
2978 $tz2 = $tz1;
2979 $isdst1 = $$self{'data'}{'isdst'};
2980 $isdst2 = $$date{'data'}{'isdst'};
2981
2982 } else {
2983 $date1 = [ $self->value('gmt') ];
2984 $date2 = [ $date->value('gmt') ];
2985 $tz1 = 'GMT';
2986 $tz2 = $tz1;
2987 $isdst1 = 0;
2988 $isdst2 = 0;
2989 }
2990
2991 # Do the calculation
2992
2993 my(@delta);
2994 if ($subtract) {
2995 if ($mode eq 'business' || $mode eq 'exact' || $subtract == 2) {
2996 @delta = @{ $self->__calc_date_date($mode,$date2,$tz2,$isdst2,
2997 $date1,$tz1,$isdst1) };
2998 } else {
2999 @delta = @{ $self->__calc_date_date($mode,$date1,$tz1,$isdst1,
3000 $date2,$tz2,$isdst2) };
3001 @delta = map { -1*$_ } @delta;
3002 }
3003 } else {
3004 @delta = @{ $self->__calc_date_date($mode,$date1,$tz1,$isdst1,
3005 $date2,$tz2,$isdst2) };
3006 }
3007
3008 # Save the delta
3009
3010 if ($mode eq 'business' || $mode eq 'bapprox' || $mode eq 'bsemi') {
3011 $ret->set('business',\@delta);
3012 } else {
3013 $ret->set('delta',\@delta);
3014 }
3015 return $ret;
3016}
3017
3018sub __calc_date_date {
3019 my($self,$mode,$date1,$tz1,$isdst1,$date2,$tz2,$isdst2) = @_;
3020 my $dmt = $$self{'tz'};
3021 my $dmb = $$dmt{'base'};
3022
3023 my($dy,$dm,$dw,$dd,$dh,$dmn,$ds) = (0,0,0,0,0,0,0);
3024
3025 if ($mode eq 'approx' || $mode eq 'bapprox') {
3026 my($y1,$m1,$d1,$h1,$mn1,$s1) = @$date1;
3027 my($y2,$m2,$d2,$h2,$mn2,$s2) = @$date2;
3028 $dy = $y2-$y1;
3029 $dm = $m2-$m1;
3030
3031 if ($dy || $dm) {
3032 # If $d1 is greater than the number of days allowed in the
3033 # month $y2/$m2, set it equal to the number of days. In other
3034 # words:
3035 # Jan 31 2006 to Feb 28 2008 = 2 years 1 month
3036 #
3037 my $dim = $dmb->days_in_month($y2,$m2);
3038 $d1 = $dim if ($d1 > $dim);
3039
3040 $date1 = [$y2,$m2,$d1,$h1,$mn1,$s1];
3041 }
3042 }
3043
3044 if ($mode eq 'semi' || $mode eq 'approx') {
3045
3046 # Calculate the number of weeks/days apart (temporarily ignoring
3047 # DST effects).
3048
3049 $dd = $dmb->days_since_1BC($date2) -
3050 $dmb->days_since_1BC($date1);
3051 $dw = int($dd/7);
3052 $dd -= $dw*7;
3053
3054 # Adding $dd to $date1 gives: ($y2,$m2,$d2, $h1,$mn1,$s1)
3055 # Make sure this is valid (taking into account DST effects).
3056 # If it isn't, make it valid.
3057
3058 if ($dw || $dd) {
3059 my($y1,$m1,$d1,$h1,$mn1,$s1) = @$date1;
3060 my($y2,$m2,$d2,$h2,$mn2,$s2) = @$date2;
3061 $date1 = [$y2,$m2,$d2,$h1,$mn1,$s1];
3062 }
3063 if ($dy || $dm || $dw || $dd) {
3064 my $force = ( ($dw > 0 || $dd > 0) ? 1 : -1 );
3065 my($off,$isdst,$abb);
3066 ($date1,$off,$isdst,$abb) =
3067 $self->_calc_date_check_dst($date1,$tz2,$isdst2,$force);
3068 }
3069 }
3070
3071 if ($mode eq 'bsemi' || $mode eq 'bapprox') {
3072 # Calculate the number of weeks. Ignore the days
3073 # part. Also, since there are no DST effects, we don't
3074 # have to check for validity.
3075
3076 $dd = $dmb->days_since_1BC($date2) -
3077 $dmb->days_since_1BC($date1);
3078 $dw = int($dd/7);
3079 $dd = 0;
3080 $date1 = $dmb->calc_date_days($date1,$dw*7);
3081 }
3082
3083 if ($mode eq 'exact' || $mode eq 'semi' || $mode eq 'approx') {
3084 my $sec1 = $dmb->secs_since_1970($date1);
3085 my $sec2 = $dmb->secs_since_1970($date2);
3086 $ds = $sec2 - $sec1;
3087
3088 {
30892825µs29µs
# spent 8µs (7+1) within Date::Manip::Date::BEGIN@3089 which was called: # once (7µs+1µs) by main::RUNTIME at line 3089
no integer;
# spent 8µs making 1 call to Date::Manip::Date::BEGIN@3089 # spent 1µs making 1 call to integer::unimport
3090 $dh = int($ds/3600);
3091 $ds -= $dh*3600;
3092 }
3093 $dmn = int($ds/60);
3094 $ds -= $dmn*60;
3095 }
3096
3097 if ($mode eq 'business' || $mode eq 'bsemi' || $mode eq 'bapprox') {
3098
3099 # Make sure both are work days
3100
3101 $date1 = $self->__nextprev_business_day(0,0,1,$date1);
3102 $date2 = $self->__nextprev_business_day(0,0,1,$date2);
3103
3104 my($y1,$m1,$d1,$h1,$mn1,$s1) = @$date1;
3105 my($y2,$m2,$d2,$h2,$mn2,$s2) = @$date2;
3106
3107 # Find out which direction we need to move $date1 to get to $date2
3108
3109 my $dir = 0;
3110 if ($y1 < $y2) {
3111 $dir = 1;
3112 } elsif ($y1 > $y2) {
3113 $dir = -1;
3114 } elsif ($m1 < $m2) {
3115 $dir = 1;
3116 } elsif ($m1 > $m2) {
3117 $dir = -1;
3118 } elsif ($d1 < $d2) {
3119 $dir = 1;
3120 } elsif ($d1 > $d2) {
3121 $dir = -1;
3122 }
3123
3124 # Now do the day part (to get to the same day)
3125
3126 $dd = 0;
3127 while ($dir) {
3128 ($y1,$m1,$d1) = @{ $dmb->calc_date_days([$y1,$m1,$d1],$dir) };
3129 $dd += $dir if ($self->__is_business_day([$y1,$m1,$d1,0,0,0],0));
3130 $dir = 0 if ($y1 == $y2 && $m1 == $m2 && $d1 == $d2);
3131 }
3132
3133 # Both dates are now on a business day, and during business
3134 # hours, so do the hr/min/sec part trivially
3135
3136 $dh = $h2-$h1;
3137 $dmn = $mn2-$mn1;
3138 $ds = $s2-$s1;
3139 }
3140
3141 return [ $dy,$dm,$dw,$dd,$dh,$dmn,$ds ];
3142}
3143
3144sub _calc_date_delta {
3145 my($self,$delta,$subtract) = @_;
3146 my $ret = $self->new_date();
3147
3148 if ($$self{'err'} || ! $$self{'data'}{'set'}) {
3149 $$ret{'err'} = '[calc] Date object invalid';
3150 return $ret;
3151 }
3152
3153 if ($$delta{'err'}) {
3154 $$ret{'err'} = '[calc] Delta object invalid';
3155 return $ret;
3156 }
3157
3158 # Get the date/delta fields
3159
3160 $subtract = 0 if (! $subtract);
3161 my @delta = @{ $$delta{'data'}{'delta'} };
3162 my @date = @{ $$self{'data'}{'date'} };
3163 my $business = $$delta{'data'}{'business'};
3164 my $tz = $$self{'data'}{'tz'};
3165 my $isdst = $$self{'data'}{'isdst'};
3166
3167 my($err,$date2,$offset,$abbrev);
3168 ($err,$date2,$offset,$isdst,$abbrev) =
3169 $self->__calc_date_delta([@date],[@delta],$subtract,$business,$tz,$isdst);
3170
3171 if ($err) {
3172 $$ret{'err'} = '[calc] Unable to perform calculation';
3173 } else {
3174 $$ret{'data'}{'set'} = 1;
3175 $$ret{'data'}{'date'} = $date2;
3176 $$ret{'data'}{'tz'} = $tz;
3177 $$ret{'data'}{'isdst'} = $isdst;
3178 $$ret{'data'}{'offset'}= $offset;
3179 $$ret{'data'}{'abb'} = $abbrev;
3180 }
3181 return $ret;
3182}
3183
3184sub __calc_date_delta {
3185 my($self,$date,$delta,$subtract,$business,$tz,$isdst) = @_;
3186
3187 my ($dy,$dm,$dw,$dd,$dh,$dmn,$ds) = @$delta;
3188 my @date = @$date;
3189
3190 my ($err,$date2,$offset,$abbrev);
3191
3192 # In business mode, daylight saving time is ignored, so days are
3193 # of a constant, known length, so they'll be done in the exact
3194 # function. Otherwise, they'll be done in the approximate function.
3195 #
3196 # Also in business mode, if $subtract = 2, then the starting date
3197 # must be a business date or an error occurs.
3198
3199 my($dd_exact,$dd_approx);
3200 if ($business) {
3201 $dd_exact = $dd;
3202 $dd_approx = 0;
3203
3204 if ($subtract == 2 && ! $self->__is_business_day($date,1)) {
3205 return (1);
3206 }
3207
3208 } else {
3209 $dd_exact = 0;
3210 $dd_approx = $dd;
3211 }
3212
3213 if ($subtract == 2 && ($dy || $dm || $dw || $dd_approx)) {
3214 # For subtract=2:
3215 # DATE = RET + DELTA
3216 #
3217 # The delta consisists of an approximate part (which is added first)
3218 # and an exact part (added second):
3219 # DATE = RET + DELTA(approx) + DELTA(exact)
3220 # DATE = RET' + DELTA(exact)
3221 # where RET' = RET + DELTA(approx)
3222 #
3223 # For an exact delta, subtract==2 and subtract==1 are equivalent,
3224 # so this can be written:
3225 # DATE - DELTA(exact) = RET'
3226 #
3227 # So the inverse subtract only needs include the approximate
3228 # portion of the delta.
3229
3230 ($err,$date2,$offset,$isdst,$abbrev) =
3231 $self->__calc_date_delta_exact([@date],[-1*$dd_exact,-1*$dh,-1*$dmn,-1*$ds],
3232 $business,$tz,$isdst);
3233
3234 ($err,$date2,$offset,$isdst,$abbrev) =
3235 $self->__calc_date_delta_inverse($date2,[$dy,$dm,$dw,$dd_approx],
3236 $business,$tz,$isdst)
3237 if (! $err);
3238
3239 } else {
3240 # We'll add the approximate part, followed by the exact part.
3241 # After the approximate part, we need to make sure we're on
3242 # a valid business day in business mode.
3243
3244 ($dy,$dm,$dw,$dd_exact,$dd_approx,$dh,$dmn,$ds) =
3245 map { -1*$_ } ($dy,$dm,$dw,$dd_exact,$dd_approx,$dh,$dmn,$ds)
3246 if ($subtract);
3247 @$date2 = @date;
3248
3249 if ($dy || $dm || $dw || $dd) {
3250 ($err,$date2,$offset,$isdst,$abbrev) =
3251 $self->__calc_date_delta_approx($date2,[$dy,$dm,$dw,$dd_approx],
3252 $business,$tz,$isdst);
3253 } elsif ($business) {
3254 $date2 = $self->__nextprev_business_day(0,0,1,$date2);
3255 }
3256
3257 ($err,$date2,$offset,$isdst,$abbrev) =
3258 $self->__calc_date_delta_exact($date2,[$dd_exact,$dh,$dmn,$ds],
3259 $business,$tz,$isdst)
3260 if (! $err && ($dd_exact || $dh || $dmn || $ds));
3261 }
3262
3263 return($err,$date2,$offset,$isdst,$abbrev);
3264}
3265
3266# Do the inverse part of a calculation.
3267#
3268# $delta = [$dy,$dm,$dw,$dd]
3269#
3270sub __calc_date_delta_inverse {
3271 my($self,$date,$delta,$business,$tz,$isdst) = @_;
3272 my $dmt = $$self{'tz'};
3273 my $dmb = $$dmt{'base'};
3274 my @date2;
3275
3276 # Given: DATE1, DELTA
3277 # Find: DATE2
3278 # where DATE2 + DELTA = DATE1
3279 #
3280 # Start with:
3281 # DATE2 = DATE1 - DELTA
3282 #
3283 # if (DATE2+DELTA < DATE1)
3284 # while (1)
3285 # DATE2 = DATE2 + 1 day
3286 # if DATE2+DELTA < DATE1
3287 # next
3288 # elsif DATE2+DELTA > DATE1
3289 # return ERROR
3290 # else
3291 # return DATE2
3292 # done
3293 #
3294 # elsif (DATE2+DELTA > DATE1)
3295 # while (1)
3296 # DATE2 = DATE2 - 1 day
3297 # if DATE2+DELTA > DATE1
3298 # next
3299 # elsif DATE2+DELTA < DATE1
3300 # return ERROR
3301 # else
3302 # return DATE2
3303 # done
3304 #
3305 # else
3306 # return DATE2
3307
3308 if ($business) {
3309
3310 my $date1 = $date;
3311 my ($err,$date2,$off,$isd,$abb,@del,$tmp,$cmp);
3312 @del = map { $_*-1 } @$delta;
3313
3314 ($err,$date2,$off,$isd,$abb) =
3315 $self->__calc_date_delta_approx($date,[@del],$business,$tz,$isdst);
3316
3317 ($err,$tmp,$off,$isd,$abb) =
3318 $self->__calc_date_delta_approx($date2,$delta,$business,$tz,$isdst);
3319
3320 $cmp = $self->_cmp_date($tmp,$date1);
3321
3322 if ($cmp < 0) {
3323 while (1) {
3324 $date2 = $self->__nextprev_business_day(0,1,0,$date2);
3325 ($err,$tmp,$off,$isd,$abb) =
3326 $self->__calc_date_delta_approx($date2,$delta,$business,$tz,$isdst);
3327 $cmp = $self->_cmp_date($tmp,$date1);
3328 if ($cmp < 0) {
3329 next;
3330 } elsif ($cmp > 0) {
3331 return (1);
3332 } else {
3333 last;
3334 }
3335 }
3336
3337 } elsif ($cmp > 0) {
3338 while (1) {
3339 $date2 = $self->__nextprev_business_day(1,1,0,$date2);
3340 ($err,$tmp,$off,$isd,$abb) =
3341 $self->__calc_date_delta_approx($date2,$delta,$business,$tz,$isdst);
3342 $cmp = $self->_cmp_date($tmp,$date1);
3343 if ($cmp > 0) {
3344 next;
3345 } elsif ($cmp < 0) {
3346 return (1);
3347 } else {
3348 last;
3349 }
3350 }
3351 }
3352
3353 @date2 = @$date2;
3354
3355 } else {
3356
3357 my @tmp = @$date[0..2]; # [y,m,d]
3358 my @hms = @$date[3..5]; # [h,m,s]
3359 my $date1 = [@tmp];
3360
3361 my $date2 = $dmb->_calc_date_ymwd($date1,$delta,1);
3362 my $tmp = $dmb->_calc_date_ymwd($date2,$delta);
3363 my $cmp = $self->_cmp_date($tmp,$date1);
3364
3365 if ($cmp < 0) {
3366 while (1) {
3367 $date2 = $dmb->calc_date_days($date2,1);
3368 $tmp = $dmb->_calc_date_ymwd($date2,$delta);
3369 $cmp = $self->_cmp_date($tmp,$date1);
3370 if ($cmp < 0) {
3371 next;
3372 } elsif ($cmp > 0) {
3373 return (1);
3374 } else {
3375 last;
3376 }
3377 }
3378
3379 } elsif ($cmp > 0) {
3380 while (1) {
3381 $date2 = $dmb->calc_date_days($date2,-1);
3382 $tmp = $dmb->_calc_date_ymwd($date2,$delta);
3383 $cmp = $self->_cmp_date($tmp,$date1);
3384 if ($cmp > 0) {
3385 next;
3386 } elsif ($cmp < 0) {
3387 return (1);
3388 } else {
3389 last;
3390 }
3391 }
3392 }
3393
3394 @date2 = (@$date2,@hms);
3395 }
3396
3397 # Make sure DATE2 is valid (within DST constraints) and
3398 # return it.
3399
3400 my($date2,$abb,$off,$err);
3401 ($date2,$off,$isdst,$abb) = $self->_calc_date_check_dst([@date2],$tz,$isdst,0);
3402
3403 return (1) if (! defined($date2));
3404 return (0,$date2,$off,$isdst,$abb);
3405}
3406
3407sub _cmp_date {
3408 my($self,$date0,$date1) = @_;
3409 return ($$date0[0] <=> $$date1[0] ||
3410 $$date0[1] <=> $$date1[1] ||
3411 $$date0[2] <=> $$date1[2]);
3412}
3413
3414# Do the approximate part of a calculation.
3415#
3416sub __calc_date_delta_approx {
3417 my($self,$date,$delta,$business,$tz,$isdst) = @_;
3418
3419 my $dmt = $$self{'tz'};
3420 my $dmb = $$dmt{'base'};
3421 my($y,$m,$d,$h,$mn,$s) = @$date;
3422 my($dy,$dm,$dw,$dd) = @$delta;
3423
3424 #
3425 # Do the year/month part.
3426 #
3427 # If we are past the last day of a month, move the date back to
3428 # the last day of the month. i.e. Jan 31 + 1 month = Feb 28.
3429 #
3430
3431 $y += $dy if ($dy);
3432 $dmb->_mod_add(-12,$dm,\$m,\$y) # -12 means 1-12 instead of 0-11
3433 if ($dm);
3434
3435 my $dim = $dmb->days_in_month($y,$m);
3436 $d = $dim if ($d > $dim);
3437
3438 #
3439 # Do the week part.
3440 #
3441 # The week is treated as 7 days for both business and non-business
3442 # calculations.
3443 #
3444 # In a business calculation, make sure we're on a business date.
3445 #
3446
3447 if ($business) {
3448 ($y,$m,$d) = @{ $dmb->calc_date_days([$y,$m,$d],$dw*7) } if ($dw);
3449 ($y,$m,$d,$h,$mn,$s) =
3450 @{ $self->__nextprev_business_day(0,0,1,[$y,$m,$d,$h,$mn,$s]) };
3451 } else {
3452 $dd += $dw*7;
3453 }
3454
3455 #
3456 # Now do the day part. $dd is always 0 in business calculations.
3457 #
3458
3459 if ($dd) {
3460 ($y,$m,$d) = @{ $dmb->calc_date_days([$y,$m,$d],$dd) };
3461 }
3462
3463 #
3464 # At this point, we need to make sure that we're a valid date
3465 # (within the constraints of DST).
3466 #
3467 # If it is not valid in this offset, try the other one. If neither
3468 # works, then we want the the date to be 24 hours later than the
3469 # previous day at this time (if $dd > 0) or 24 hours earlier than
3470 # the next day at this time (if $dd < 0). We'll use the 24 hour
3471 # definition even for business days, but then we'll double check
3472 # that the resulting date is a business date.
3473 #
3474
3475 my $force = ( ($dd > 0 || $dw > 0 || $dm > 0 || $dy > 0) ? 1 : -1 );
3476 my($off,$abb);
3477 ($date,$off,$isdst,$abb) =
3478 $self->_calc_date_check_dst([$y,$m,$d,$h,$mn,$s],$tz,$isdst,$force);
3479 return (0,$date,$off,$isdst,$abb);
3480}
3481
3482# Do the exact part of a calculation.
3483#
3484sub __calc_date_delta_exact {
3485 my($self,$date,$delta,$business,$tz,$isdst) = @_;
3486 my $dmt = $$self{'tz'};
3487 my $dmb = $$dmt{'base'};
3488
3489 if ($business) {
3490
3491 # Simplify hours/minutes/seconds where the day length is defined
3492 # by the start/end of the business day.
3493
3494 my ($dd,$dh,$dmn,$ds) = @$delta;
3495 my ($y,$m,$d,$h,$mn,$s)= @$date;
3496 my ($hbeg,$mbeg,$sbeg) = @{ $$dmb{'data'}{'calc'}{'workdaybeg'} };
3497 my ($hend,$mend,$send) = @{ $$dmb{'data'}{'calc'}{'workdayend'} };
3498 my $bdlen = $$dmb{'data'}{'len'}{'bdlength'};
3499
3500234µs28µs
# spent 7µs (6+1000ns) within Date::Manip::Date::BEGIN@3500 which was called: # once (6µs+1000ns) by main::RUNTIME at line 3500
no integer;
# spent 7µs making 1 call to Date::Manip::Date::BEGIN@3500 # spent 1µs making 1 call to integer::unimport
3501 my $tmp;
3502 $ds += $dh*3600 + $dmn*60;
3503 $tmp = int($ds/$bdlen);
3504 $dd += $tmp;
3505 $ds -= $tmp*$bdlen;
3506 $dh = int($ds/3600);
3507 $ds -= $dh*3600;
3508 $dmn = int($ds/60);
3509 $ds -= $dmn*60;
351022.30ms26µs
# spent 5µs (4+900ns) within Date::Manip::Date::BEGIN@3510 which was called: # once (4µs+900ns) by main::RUNTIME at line 3510
use integer;
# spent 5µs making 1 call to Date::Manip::Date::BEGIN@3510 # spent 900ns making 1 call to integer::import
3511
3512 if ($dd) {
3513 my $prev = 0;
3514 if ($dd < 1) {
3515 $prev = 1;
3516 $dd *= -1;
3517 }
3518
3519 ($y,$m,$d,$h,$mn,$s) =
3520 @{ $self->__nextprev_business_day($prev,$dd,0,[$y,$m,$d,$h,$mn,$s]) };
3521 }
3522
3523 # At this point, we're adding less than a day for the
3524 # hours/minutes/seconds part AND we know that the current
3525 # day is during business hours.
3526 #
3527 # We'll add them (without affecting days... we'll need to
3528 # test things by hand to make sure we should or shouldn't
3529 # do that.
3530
3531 $dmb->_mod_add(60,$ds,\$s,\$mn);
3532 $dmb->_mod_add(60,$dmn,\$mn,\$h);
3533 $h += $dh;
3534 # Note: it's possible that $h > 23 at this point or $h < 0
3535
3536 if ($h > $hend ||
3537 ($h == $hend && $mn > $mend) ||
3538 ($h == $hend && $mn == $mend && $s > $send) ||
3539 ($h == $hend && $mn == $mend && $s == $send)) {
3540
3541 # We've gone past the end of the business day.
3542
3543 my $t2 = $dmb->calc_time_time([$h,$mn,$s],[$hend,$mend,$send],1);
3544
3545 while (1) {
3546 ($y,$m,$d) = @{ $dmb->calc_date_days([$y,$m,$d],1) };
3547 last if ($self->__is_business_day([$y,$m,$d,$h,$mn,$s]));
3548 }
3549
3550 ($h,$mn,$s) = @{ $dmb->calc_time_time([$hbeg,$mbeg,$sbeg],$t2) };
3551
3552 } elsif ($h < $hbeg ||
3553 ($h == $hbeg && $mn < $mbeg) ||
3554 ($h == $hbeg && $mn == $mbeg && $s < $sbeg)) {
3555
3556 # We've gone back past the start of the business day.
3557
3558 my $t2 = $dmb->calc_time_time([$hbeg,$mbeg,$sbeg],[$h,$mn,$s],1);
3559
3560 while (1) {
3561 ($y,$m,$d) = @{ $dmb->calc_date_days([$y,$m,$d],-1) };
3562 last if ($self->__is_business_day([$y,$m,$d,$h,$mn,$s]));
3563 }
3564
3565 ($h,$mn,$s) = @{ $dmb->calc_time_time([$hend,$mend,$send],$t2,1) };
3566 }
3567
3568 # Now make sure that the date is valid within DST constraints.
3569
3570 my $force = ( ($dd > 0 || $dh > 0 || $dmn > 0 || $ds > 0) ? 1 : -1 );
3571 my($off,$abb);
3572 ($date,$off,$isdst,$abb) =
3573 $self->_calc_date_check_dst([$y,$m,$d,$h,$mn,$s],$tz,$isdst,$force);
3574 return (0,$date,$off,$isdst,$abb);
3575
3576 } else {
3577
3578 # Convert to GTM
3579 # Do the calculation
3580 # Convert back
3581
3582 my ($dd,$dh,$dm,$ds) = @$delta; # $dd is always 0
3583 my $del = [$dh,$dm,$ds];
3584 my ($err,$offset,$abbrev);
3585
3586 ($err,$date,$offset,$isdst,$abbrev) =
3587 $dmt->_convert('__calc_date_delta_exact',$date,$tz,'GMT',$isdst);
3588
3589 $date = $dmb->calc_date_time($date,$del,0);
3590
3591 ($err,$date,$offset,$isdst,$abbrev) =
3592 $dmt->_convert('__calc_date_delta_exact',$date,'GMT',$tz,$isdst);
3593
3594 return($err,$date,$offset,$isdst,$abbrev);
3595 }
3596}
3597
3598# This checks to see which time (STD or DST) a date is in. It checks
3599# $isdst first, and the other value (1-$isdst) second.
3600#
3601# If the date is found in either time, it is returned.
3602#
3603# If the date is NOT found, then we got here by adding/subtracting 1 day
3604# from a different value, and we've obtained an invalid value. In this
3605# case, if $force = 0, then return nothing.
3606#
3607# If $force = 1, then go to the previous day and add 24 hours. If force
3608# is -1, then go to the next day and subtract 24 hours.
3609#
3610# Returns:
3611# ($date,$off,$isdst,$abb)
3612# or
3613# (undef)
3614#
3615sub _calc_date_check_dst {
3616 my($self,$date,$tz,$isdst,$force) = @_;
3617 my $dmt = $$self{'tz'};
3618 my $dmb = $$dmt{'base'};
3619 my($abb,$off,$err);
3620
3621 # Try the date as is in both ISDST and 1-ISDST times
3622
3623 my $per = $dmt->date_period($date,$tz,1,$isdst);
3624 if ($per) {
3625 $abb = $$per[4];
3626 $off = $$per[3];
3627 return($date,$off,$isdst,$abb);
3628 }
3629
3630 $per = $dmt->date_period($date,$tz,1,1-$isdst);
3631 if ($per) {
3632 $isdst = 1-$isdst;
3633 $abb = $$per[4];
3634 $off = $$per[3];
3635 return($date,$off,$isdst,$abb);
3636 }
3637
3638 # If we made it here, the date is invalid in this timezone.
3639 # Either return undef, or add/subtract a day from the date
3640 # and find out what time period we're in (all we care about
3641 # is the ISDST value).
3642
3643 if (! $force) {
3644 return(undef);
3645 }
3646
3647 my($dd);
3648 if ($force > 0) {
3649 $date = $dmb->calc_date_days($date,-1);
3650 $dd = 1;
3651 } else {
3652 $date = $dmb->calc_date_days($date,+1);
3653 $dd = -1;
3654 }
3655
3656 $per = $dmt->date_period($date,$tz,1,$isdst);
3657 $isdst = (1-$isdst) if (! $per);
3658
3659 # Now, convert it to GMT, add/subtract 24 hours, and convert
3660 # it back.
3661
3662 ($err,$date,$off,$isdst,$abb) = $dmt->convert_to_gmt($date,$tz,$isdst);
3663 $date = $dmb->calc_date_days($date,$dd);
3664 ($err,$date,$off,$isdst,$abb) = $dmt->convert_from_gmt($date,$tz);
3665
3666 return($date,$off,$isdst,$abb);
3667}
3668
3669########################################################################
3670# MISC METHODS
3671
3672sub secs_since_1970_GMT {
3673 my($self,$secs) = @_;
3674
3675 my $dmt = $$self{'tz'};
3676 my $dmb = $$dmt{'base'};
3677
3678 if (defined $secs) {
3679 my $date = $dmb->secs_since_1970($secs);
3680 my $err;
3681 ($err,$date) = $dmt->convert_from_gmt($date);
3682 return 1 if ($err);
3683 $self->set('date',$date);
3684 return 0;
3685 }
3686
3687 my @date = $self->value('gmt');
3688 $secs = $dmb->secs_since_1970(\@date);
3689 return $secs;
3690}
3691
3692sub week_of_year {
3693 my($self,$first) = @_;
3694 if ($$self{'err'} || ! $$self{'data'}{'set'}) {
3695 warn "WARNING: [week_of_year] Object must contain a valid date\n";
3696 return undef;
3697 }
3698
3699 my $dmt = $$self{'tz'};
3700 my $dmb = $$dmt{'base'};
3701 my $date = $$self{'data'}{'date'};
3702 my $y = $$date[0];
3703
3704 my($day,$dow,$doy,$f);
3705 $doy = $dmb->day_of_year($date);
3706
3707 # The date in January which must belong to the first week, and
3708 # it's DayOfWeek.
3709 if ($dmb->_config('jan1week1')) {
3710 $day=1;
3711 } else {
3712 $day=4;
3713 }
3714 $dow = $dmb->day_of_week([$y,1,$day]);
3715
3716 # The start DayOfWeek. If $first is passed in, use it. Otherwise,
3717 # use FirstDay.
3718
3719 if (! $first) {
3720 $first = $dmb->_config('firstday');
3721 }
3722
3723 # Find the pseudo-date of the first day of the first week (it may
3724 # be negative meaning it occurs last year).
3725
3726 $first -= 7 if ($first > $dow);
3727 $day -= ($dow-$first);
3728
3729 return 0 if ($day>$doy); # Day is in last week of previous year
3730 return (($doy-$day)/7 + 1);
3731}
3732
3733sub complete {
3734 my($self,$field) = @_;
3735 if ($$self{'err'} || ! $$self{'data'}{'set'}) {
3736 warn "WARNING: [complete] Object must contain a valid date\n";
3737 return undef;
3738 }
3739
3740 if (! $field) {
3741 return 1 if (! $$self{'data'}{'def'}[1] &&
3742 ! $$self{'data'}{'def'}[2] &&
3743 ! $$self{'data'}{'def'}[3] &&
3744 ! $$self{'data'}{'def'}[4] &&
3745 ! $$self{'data'}{'def'}[5]);
3746 return 0;
3747 }
3748
3749 if ($field eq 'm') {
3750 return 1 if (! $$self{'data'}{'def'}[1]);
3751 }
3752
3753 if ($field eq 'd') {
3754 return 1 if (! $$self{'data'}{'def'}[2]);
3755 }
3756
3757 if ($field eq 'h') {
3758 return 1 if (! $$self{'data'}{'def'}[3]);
3759 }
3760
3761 if ($field eq 'mn') {
3762 return 1 if (! $$self{'data'}{'def'}[4]);
3763 }
3764
3765 if ($field eq 's') {
3766 return 1 if (! $$self{'data'}{'def'}[5]);
3767 }
3768 return 0;
3769}
3770
3771sub convert {
3772 my($self,$zone) = @_;
3773 if ($$self{'err'} || ! $$self{'data'}{'set'}) {
3774 warn "WARNING: [convert] Object must contain a valid date\n";
3775 return 1;
3776 }
3777 my $dmt = $$self{'tz'};
3778 my $dmb = $$dmt{'base'};
3779
3780 my $zonename = $dmt->_zone($zone);
3781
3782 if (! $zonename) {
3783 $$self{'err'} = "[convert] Unable to determine timezone: $zone";
3784 return 1;
3785 }
3786
3787 my $date0 = $$self{'data'}{'date'};
3788 my $zone0 = $$self{'data'}{'tz'};
3789 my $isdst0 = $$self{'data'}{'isdst'};
3790
3791 my($err,$date,$off,$isdst,$abb) = $dmt->convert($date0,$zone0,$zonename,$isdst0);
3792
3793 if ($err) {
3794 $$self{'err'} = '[convert] Unable to convert date to new timezone';
3795 return 1;
3796 }
3797
3798 $self->_init();
3799 $$self{'data'}{'date'} = $date;
3800 $$self{'data'}{'tz'} = $zonename;
3801 $$self{'data'}{'isdst'} = $isdst;
3802 $$self{'data'}{'offset'} = $off;
3803 $$self{'data'}{'abb'} = $abb;
3804 $$self{'data'}{'set'} = 1;
3805
3806 return 0;
3807}
3808
3809########################################################################
3810# BUSINESS DAY METHODS
3811
3812sub is_business_day {
3813 my($self,$checktime) = @_;
3814 if ($$self{'err'} || ! $$self{'data'}{'set'}) {
3815 warn "WARNING: [is_business_day] Object must contain a valid date\n";
3816 return undef;
3817 }
3818 my $date = $$self{'data'}{'date'};
3819 return $self->__is_business_day($date,$checktime);
3820}
3821
3822sub __is_business_day {
3823 my($self,$date,$checktime) = @_;
3824 my($y,$m,$d,$h,$mn,$s) = @$date;
3825
3826 my $dmt = $$self{'tz'};
3827 my $dmb = $$dmt{'base'};
3828
3829 # Return 0 if it's a weekend.
3830
3831 my $dow = $dmb->day_of_week([$y,$m,$d]);
3832 return 0 if ($dow < $dmb->_config('workweekbeg') ||
3833 $dow > $dmb->_config('workweekend'));
3834
3835 # Return 0 if it's not during work hours (and we're checking
3836 # for that).
3837
3838 if ($checktime &&
3839 ! $dmb->_config('workday24hr')) {
3840 my $t = $dmb->join('hms',[$h,$mn,$s]);
3841 my $t0 = $dmb->join('hms',$$dmb{'data'}{'calc'}{'workdaybeg'});
3842 my $t1 = $dmb->join('hms',$$dmb{'data'}{'calc'}{'workdayend'});
3843 return 0 if ($t lt $t0 || $t gt $t1);
3844 }
3845
3846 # Check for holidays
3847
3848 $self->_holidays($y,2) unless ($$dmb{'data'}{'init_holidays'});
3849
3850 return 0 if (exists $$dmb{'data'}{'holidays'}{'dates'} &&
3851 exists $$dmb{'data'}{'holidays'}{'dates'}{$y+0} &&
3852 exists $$dmb{'data'}{'holidays'}{'dates'}{$y+0}{$m+0} &&
3853 exists $$dmb{'data'}{'holidays'}{'dates'}{$y+0}{$m+0}{$d+0});
3854
3855 return 1;
3856}
3857
3858sub list_holidays {
3859 my($self,$y) = @_;
3860 my $dmt = $$self{'tz'};
3861 my $dmb = $$dmt{'base'};
3862
3863 $y = $dmt->_now('y',1) if (! $y);
3864 $self->_holidays($y,2);
3865
3866 my @ret;
3867 my @m = sort { $a <=> $b } keys %{ $$dmb{'data'}{'holidays'}{'dates'}{$y+0} };
3868 foreach my $m (@m) {
3869 my @d = sort { $a <=> $b } keys %{ $$dmb{'data'}{'holidays'}{'dates'}{$y+0}{$m} };
3870 foreach my $d (@d) {
3871 my $hol = $self->new_date();
3872 $hol->set('date',[$y,$m,$d,0,0,0]);
3873 push(@ret,$hol);
3874 }
3875 }
3876
3877 return @ret;
3878}
3879
3880sub holiday {
3881 my($self) = @_;
3882 if ($$self{'err'} || ! $$self{'data'}{'set'}) {
3883 warn "WARNING: [holiday] Object must contain a valid date\n";
3884 return undef;
3885 }
3886 my $dmt = $$self{'tz'};
3887 my $dmb = $$dmt{'base'};
3888
3889 my($y,$m,$d) = @{ $$self{'data'}{'date'} };
3890 $self->_holidays($y,2);
3891
3892 if (exists $$dmb{'data'}{'holidays'}{'dates'}{$y+0} &&
3893 exists $$dmb{'data'}{'holidays'}{'dates'}{$y+0}{$m+0} &&
3894 exists $$dmb{'data'}{'holidays'}{'dates'}{$y+0}{$m+0}{$d+0}) {
3895 my @tmp = @{ $$dmb{'data'}{'holidays'}{'dates'}{$y+0}{$m+0}{$d+0} };
3896 if (wantarray) {
3897 return () if (! @tmp);
3898 return @tmp;
3899 } else {
3900 return '' if (! @tmp);
3901 return $tmp[0];
3902 }
3903 }
3904 return undef;
3905}
3906
3907sub next_business_day {
3908 my($self,$off,$checktime) = @_;
3909 if ($$self{'err'} || ! $$self{'data'}{'set'}) {
3910 warn "WARNING: [next_business_day] Object must contain a valid date\n";
3911 return undef;
3912 }
3913 my $date = $$self{'data'}{'date'};
3914
3915 $date = $self->__nextprev_business_day(0,$off,$checktime,$date);
3916 $self->set('date',$date);
3917}
3918
3919sub prev_business_day {
3920 my($self,$off,$checktime) = @_;
3921 if ($$self{'err'} || ! $$self{'data'}{'set'}) {
3922 warn "WARNING: [prev_business_day] Object must contain a valid date\n";
3923 return undef;
3924 }
3925 my $date = $$self{'data'}{'date'};
3926
3927 $date = $self->__nextprev_business_day(1,$off,$checktime,$date);
3928 $self->set('date',$date);
3929}
3930
3931sub __nextprev_business_day {
3932 my($self,$prev,$off,$checktime,$date) = @_;
3933 my($y,$m,$d,$h,$mn,$s) = @$date;
3934
3935 my $dmt = $$self{'tz'};
3936 my $dmb = $$dmt{'base'};
3937
3938 # Get day 0
3939
3940 while (! $self->__is_business_day([$y,$m,$d,$h,$mn,$s],$checktime)) {
3941 if ($checktime) {
3942 ($y,$m,$d,$h,$mn,$s) =
3943 @{ $self->__next_prev([$y,$m,$d,$h,$mn,$s],1,undef,0,
3944 $$dmb{'data'}{'calc'}{'workdaybeg'}) };
3945 } else {
3946 # Move forward 1 day
3947 ($y,$m,$d) = @{ $dmb->calc_date_days([$y,$m,$d],1) };
3948 }
3949 }
3950
3951 # Move $off days into the future/past
3952
3953 while ($off > 0) {
3954 while (1) {
3955 if ($prev) {
3956 # Move backward 1 day
3957 ($y,$m,$d) = @{ $dmb->calc_date_days([$y,$m,$d],-1) };
3958 } else {
3959 # Move forward 1 day
3960 ($y,$m,$d) = @{ $dmb->calc_date_days([$y,$m,$d],1) };
3961 }
3962 last if ($self->__is_business_day([$y,$m,$d,$h,$mn,$s]));
3963 }
3964 $off--;
3965 }
3966
3967 return [$y,$m,$d,$h,$mn,$s];
3968}
3969
3970sub nearest_business_day {
3971 my($self,$tomorrow) = @_;
3972 if ($$self{'err'} || ! $$self{'data'}{'set'}) {
3973 warn "WARNING: [nearest_business_day] Object must contain a valid date\n";
3974 return undef;
3975 }
3976
3977 my $date = $$self{'data'}{'date'};
3978 $date = $self->__nearest_business_day($tomorrow,$date);
3979
3980 # If @date is empty, the date is a business day and doesn't need
3981 # to be changed.
3982
3983 return if (! defined($date));
3984
3985 $self->set('date',$date);
3986}
3987
3988sub __nearest_business_day {
3989 my($self,$tomorrow,$date) = @_;
3990
3991 # We're done if this is a business day
3992 return undef if ($self->__is_business_day($date,0));
3993
3994 my $dmt = $$self{'tz'};
3995 my $dmb = $$dmt{'base'};
3996
3997 $tomorrow = $dmb->_config('tomorrowfirst') if (! defined $tomorrow);
3998
3999 my($a1,$a2);
4000 if ($tomorrow) {
4001 ($a1,$a2) = (1,-1);
4002 } else {
4003 ($a1,$a2) = (-1,1);
4004 }
4005
4006 my ($y,$m,$d,$h,$mn,$s) = @$date;
4007 my ($y1,$m1,$d1) = ($y,$m,$d);
4008 my ($y2,$m2,$d2) = ($y,$m,$d);
4009
4010 while (1) {
4011 ($y1,$m1,$d1) = @{ $dmb->calc_date_days([$y1,$m1,$d1],$a1) };
4012 if ($self->__is_business_day([$y1,$m1,$d1,$h,$mn,$s],0)) {
4013 ($y,$m,$d) = ($y1,$m1,$d1);
4014 last;
4015 }
4016 ($y2,$m2,$d2) = @{ $dmb->calc_date_days([$y2,$m2,$d2],$a2) };
4017 if ($self->__is_business_day([$y2,$m2,$d2,$h,$mn,$s],0)) {
4018 ($y,$m,$d) = ($y2,$m2,$d2);
4019 last;
4020 }
4021 }
4022
4023 return [$y,$m,$d,$h,$mn,$s];
4024}
4025
4026# We need to create all the objects which will be used to determine holidays.
4027# By doing this once only, a lot of time is saved.
4028#
4029sub _holiday_objs {
4030 my($self) = @_;
4031 my $dmt = $$self{'tz'};
4032 my $dmb = $$dmt{'base'};
4033
4034 $$dmb{'data'}{'holidays'}{'init'} = 1;
4035
4036 # Go through all of the strings from the config file.
4037 #
4038 my (@str) = @{ $$dmb{'data'}{'sections'}{'holidays'} };
4039 $$dmb{'data'}{'holidays'}{'hols'} = [];
4040
4041 while (@str) {
4042 my($string) = shift(@str);
4043 my($name) = shift(@str);
4044
4045 # If $string is a parse_date string AND it contains a year, we'll
4046 # store the date as a holiday, but not store the holiday description
4047 # so it never needs to be re-parsed.
4048
4049 my $date = $self->new_date();
4050 my $err = $date->parse_date($string);
4051 if (! $err) {
4052 if ($$date{'data'}{'def'}[0] eq '') {
4053 push(@{ $$dmb{'data'}{'holidays'}{'hols'} },$string,$name);
4054 } else {
4055 my($y,$m,$d) = @{ $$date{'data'}{'date'} };
4056 if (exists $$dmb{'data'}{'holidays'}{'dates'}{$y+0}{$m+0}{$d+0}) {
4057 push @{ $$dmb{'data'}{'holidays'}{'dates'}{$y+0}{$m+0}{$d+0} },$name;
4058 } else {
4059 $$dmb{'data'}{'holidays'}{'dates'}{$y+0}{$m+0}{$d+0} = [ $name ];
4060 }
4061 }
4062
4063 next;
4064 }
4065 $date->err(1);
4066
4067 # If $string is a recurrence, we'll create a Recur object (which we
4068 # only have to do once) and store it.
4069
4070 my $recur = $self->new_recur();
4071 $recur->_holiday();
4072 $err = $recur->parse($string);
4073 if (! $err) {
4074 push(@{ $$dmb{'data'}{'holidays'}{'hols'} },$recur,$name);
4075 next;
4076 }
4077 $recur->err(1);
4078
4079 warn "WARNING: invalid holiday description: $string\n";
4080 }
4081}
4082
4083# Make sure that holidays are set for a given year.
4084#
4085# $$dmb{'data'}{'holidays'}{'years'}{$year} = 0 nothing done
4086# 1 this year done
4087# 2 both adjacent years done
4088#
4089sub _holidays {
4090 my($self,$year,$level) = @_;
4091
4092 my $dmt = $$self{'tz'};
4093 my $dmb = $$dmt{'base'};
4094 $self->_holiday_objs($year) if (! $$dmb{'data'}{'holidays'}{'init'});
4095
4096 $$dmb{'data'}{'holidays'}{'years'}{$year} = 0
4097 if (! exists $$dmb{'data'}{'holidays'}{'years'}{$year});
4098
4099 my $curr_level = $$dmb{'data'}{'holidays'}{'years'}{$year};
4100 return if ($curr_level >= $level);
4101 $$dmb{'data'}{'holidays'}{'years'}{$year} = $level;
4102
4103 # Parse the year
4104
4105 if ($curr_level == 0) {
4106 $self->_holidays_year($year);
4107
4108 return if ($level == 1);
4109 }
4110
4111 # Parse the years around it.
4112
4113 $self->_holidays($year-1,1);
4114 $self->_holidays($year+1,1);
4115}
4116
4117sub _holidays_year {
4118 my($self,$y) = @_;
4119
4120 my $dmt = $$self{'tz'};
4121 my $dmb = $$dmt{'base'};
4122
4123 # Get the objects and set them to use the new year. Also, get the
4124 # range for recurrences.
4125
4126 my @hol = @{ $$dmb{'data'}{'holidays'}{'hols'} };
4127
4128 my $beg = $self->new_date();
4129 $beg->set('date',[$y-1,12,1,0,0,0]);
4130 my $end = $self->new_date();
4131 $end->set('date',[$y+1,2,1,0,0,0]);
4132
4133 # Get the date for each holiday.
4134
4135 $$dmb{'data'}{'init_holidays'} = 1;
4136
4137 while (@hol) {
4138
4139 my($obj) = shift(@hol);
4140 my($name) = shift(@hol);
4141
4142 $$dmb{'data'}{'tmpnow'} = [$y,1,1,0,0,0];
4143 if (ref($obj)) {
4144 # It's a recurrence
4145
4146 # If the recurrence has a date range built in, we won't override it.
4147 # Otherwise, we'll only look for dates in this year.
4148
4149 if ($obj->start() && $obj->end()) {
4150 $obj->dates();
4151 } else {
4152 $obj->dates($beg,$end);
4153 }
4154
4155 foreach my $i (keys %{ $$obj{'data'}{'dates'} }) {
4156 next if ($$obj{'data'}{'saved'}{$i});
4157 my $date = $$obj{'data'}{'dates'}{$i};
4158 my($y,$m,$d) = @{ $$date{'data'}{'date'} };
4159 if (exists $$dmb{'data'}{'holidays'}{'dates'}{$y+0}{$m+0}{$d+0}) {
4160 push @{ $$dmb{'data'}{'holidays'}{'dates'}{$y+0}{$m+0}{$d+0} },$name;
4161 } else {
4162 $$dmb{'data'}{'holidays'}{'dates'}{$y+0}{$m+0}{$d+0} = [$name];
4163 }
4164 $$obj{'data'}{'saved'}{$i} = 1;
4165 }
4166
4167 } else {
4168 my $date = $self->new_date();
4169 $date->parse_date($obj);
4170 my($y,$m,$d) = @{ $$date{'data'}{'date'} };
4171 if (exists $$dmb{'data'}{'holidays'}{'dates'}{$y+0}{$m+0}{$d+0}) {
4172 push @{ $$dmb{'data'}{'holidays'}{'dates'}{$y+0}{$m+0}{$d+0} },$name;
4173 } else {
4174 $$dmb{'data'}{'holidays'}{'dates'}{$y+0}{$m+0}{$d+0} = [$name];
4175 }
4176 }
4177 $$dmb{'data'}{'tmpnow'} = [];
4178 }
4179
4180 $$dmb{'data'}{'init_holidays'} = 0;
4181}
4182
4183########################################################################
4184# PRINTF METHOD
4185
4186
# spent 16µs within Date::Manip::Date::BEGIN@4186 which was called: # once (16µs+0s) by main::RUNTIME at line 4503
BEGIN {
418716µs my %pad_0 = map { $_,1 } qw ( Y m d H M S I j G W L U );
418812µs my %pad_sp = map { $_,1 } qw ( y f e k i );
418911µs my %hr = map { $_,1 } qw ( H k I i );
419011µs my %dow = map { $_,1 } qw ( v a A w );
4191110µs my %num = map { $_,1 } qw ( Y m d H M S y f e k I i j G W L U );
4192
4193 sub printf {
4194 my($self,@in) = @_;
4195 if ($$self{'err'} || ! $$self{'data'}{'set'}) {
4196 warn "WARNING: [printf] Object must contain a valid date\n";
4197 return undef;
4198 }
4199
4200 my $dmt = $$self{'tz'};
4201 my $dmb = $$dmt{'base'};
4202
4203 my($y,$m,$d,$h,$mn,$s) = @{ $$self{'data'}{'date'} };
4204
4205 my(@out);
4206 foreach my $in (@in) {
4207 my $out = '';
4208 while ($in) {
4209 last if ($in eq '%');
4210
4211 # Everything up to the first '%'
4212
4213 if ($in =~ s/^([^%]+)//) {
4214 $out .= $1;
4215 next;
4216 }
4217
4218 # Extended formats: %<...>
4219
4220 if ($in =~ s/^%<([^>]+)>//) {
4221 my $f = $1;
4222 my $val;
4223
4224 if ($f =~ /^a=([1-7])$/) {
4225 $val = $$dmb{'data'}{'wordlist'}{'day_abb'}[$1-1];
4226
4227 } elsif ($f =~ /^v=([1-7])$/) {
4228 $val = $$dmb{'data'}{'wordlist'}{'day_char'}[$1-1];
4229
4230 } elsif ($f =~ /^A=([1-7])$/) {
4231 $val = $$dmb{'data'}{'wordlist'}{'day_name'}[$1-1];
4232
4233 } elsif ($f =~ /^p=([1-2])$/) {
4234 $val = $$dmb{'data'}{'wordlist'}{'ampm'}[$1-1];
4235
4236 } elsif ($f =~ /^b=(0?[1-9]|1[0-2])$/) {
4237 $val = $$dmb{'data'}{'wordlist'}{'month_abb'}[$1-1];
4238
4239 } elsif ($f =~ /^B=(0?[1-9]|1[0-2])$/) {
4240 $val = $$dmb{'data'}{'wordlist'}{'month_name'}[$1-1];
4241
4242 } elsif ($f =~ /^E=(0?[1-9]|[1-4][0-9]|5[0-3])$/) {
4243 $val = $$dmb{'data'}{'wordlist'}{'nth'}[$1-1];
4244
4245 } else {
4246 $val = '%<' . $1 . '>';
4247 }
4248 $out .= $val;
4249 next;
4250 }
4251
4252 # Normals one-character formats
4253
4254 $in =~ s/^%(.)//s;
4255 my $f = $1;
4256
4257 if (exists $$self{'data'}{'f'}{$f}) {
4258 $out .= $$self{'data'}{'f'}{$f};
4259 next;
4260 }
4261
4262 my ($val,$pad,$len,$dow);
4263
4264 if (exists $pad_0{$f}) {
4265 $pad = '0';
4266 }
4267
4268 if (exists $pad_sp{$f}) {
4269 $pad = ' ';
4270 }
4271
4272 if ($f eq 'G' || $f eq 'W') {
4273 my($yy,$ww) = $dmb->_week_of_year(1,[$y,$m,$d]);
4274 if ($f eq 'G') {
4275 $val = $yy;
4276 $len = 4;
4277 } else {
4278 $val = $ww;
4279 $len = 2;
4280 }
4281 }
4282
4283 if ($f eq 'L' || $f eq 'U') {
4284 my($yy,$ww) = $dmb->_week_of_year(7,[$y,$m,$d]);
4285 if ($f eq 'L') {
4286 $val = $yy;
4287 $len = 4;
4288 } else {
4289 $val = $ww;
4290 $len = 2;
4291 }
4292 }
4293
4294 if ($f eq 'Y' || $f eq 'y') {
4295 $val = $y;
4296 $len = 4;
4297 }
4298
4299 if ($f eq 'm' || $f eq 'f') {
4300 $val = $m;
4301 $len = 2;
4302 }
4303
4304 if ($f eq 'd' || $f eq 'e') {
4305 $val = $d;
4306 $len = 2;
4307 }
4308
4309 if ($f eq 'j') {
4310 $val = $dmb->day_of_year([$y,$m,$d]);
4311 $len = 3;
4312 }
4313
4314
4315 if (exists $hr{$f}) {
4316 $val = $h;
4317 if ($f eq 'I' || $f eq 'i') {
4318 $val -= 12 if ($val > 12);
4319 $val = 12 if ($val == 0);
4320 }
4321 $len = 2;
4322 }
4323
4324 if ($f eq 'M') {
4325 $val = $mn;
4326 $len = 2;
4327 }
4328
4329 if ($f eq 'S') {
4330 $val = $s;
4331 $len = 2;
4332 }
4333
4334 if (exists $dow{$f}) {
4335 $dow = $dmb->day_of_week([$y,$m,$d]);
4336 }
4337
4338 ###
4339
4340 if (exists $num{$f}) {
4341 while (length($val) < $len) {
4342 $val = "$pad$val";
4343 }
4344
4345 $val = substr($val,2,2) if ($f eq 'y');
4346
4347 } elsif ($f eq 'b' || $f eq 'h') {
4348 $val = $$dmb{'data'}{'wordlist'}{'month_abb'}[$m-1];
4349
4350 } elsif ($f eq 'B') {
4351 $val = $$dmb{'data'}{'wordlist'}{'month_name'}[$m-1];
4352
4353 } elsif ($f eq 'v') {
4354 $val = $$dmb{'data'}{'wordlist'}{'day_char'}[$dow-1];
4355
4356 } elsif ($f eq 'a') {
4357 $val = $$dmb{'data'}{'wordlist'}{'day_abb'}[$dow-1];
4358
4359 } elsif ($f eq 'A') {
4360 $val = $$dmb{'data'}{'wordlist'}{'day_name'}[$dow-1];
4361
4362 } elsif ($f eq 'w') {
4363 $val = $dow;
4364
4365 } elsif ($f eq 'p') {
4366 my $i = ($h >= 12 ? 1 : 0);
4367 $val = $$dmb{'data'}{'wordlist'}{'ampm'}[$i];
4368
4369 } elsif ($f eq 'Z') {
4370 $val = $$self{'data'}{'abb'};
4371
4372 } elsif ($f eq 'N') {
4373 my $off = $$self{'data'}{'offset'};
4374 $val = $dmb->join('offset',$off);
4375
4376 } elsif ($f eq 'z') {
4377 my $off = $$self{'data'}{'offset'};
4378 $val = $dmb->join('offset',$off);
4379 $val =~ s/://g;
4380 $val =~ s/00$//;
4381
4382 } elsif ($f eq 'E') {
4383 $val = $$dmb{'data'}{'wordlist'}{'nth_dom'}[$d-1];
4384
4385 } elsif ($f eq 's') {
4386 $val = $self->secs_since_1970_GMT();
4387
4388 } elsif ($f eq 'o') {
4389 my $date2 = $self->new_date();
4390 $date2->parse('1970-01-01 00:00:00');
4391 my $delta = $date2->calc($self);
4392 $val = $delta->printf('%sys');
4393
4394 } elsif ($f eq 'l') {
4395 my $d0 = $self->new_date();
4396 my $d1 = $self->new_date();
4397 $d0->parse('-0:6:0:0:0:0:0'); # 6 months ago
4398 $d1->parse('+0:6:0:0:0:0:0'); # in 6 months
4399 $d0 = $d0->value();
4400 $d1 = $d1->value();
4401 my $date = $self->value();
4402 if ($date lt $d0 || $date ge $d1) {
4403 $in = '%b %e %Y' . $in;
4404 } else {
4405 $in = '%b %e %H:%M' . $in;
4406 }
4407 $val = '';
4408
4409 } elsif ($f eq 'c') {
4410 $in = '%a %b %e %H:%M:%S %Y' . $in;
4411 $val = '';
4412
4413 } elsif ($f eq 'C' || $f eq 'u') {
4414 $in = '%a %b %e %H:%M:%S %Z %Y' . $in;
4415 $val = '';
4416
4417 } elsif ($f eq 'g') {
4418 $in = '%a, %d %b %Y %H:%M:%S %Z' . $in;
4419 $val = '';
4420
4421 } elsif ($f eq 'D') {
4422 $in = '%m/%d/%y' . $in;
4423 $val = '';
4424
4425 } elsif ($f eq 'r') {
4426 $in = '%I:%M:%S %p' . $in;
4427 $val = '';
4428
4429 } elsif ($f eq 'R') {
4430 $in = '%H:%M' . $in;
4431 $val = '';
4432
4433 } elsif ($f eq 'T' || $f eq 'X') {
4434 $in = '%H:%M:%S' . $in;
4435 $val = '';
4436
4437 } elsif ($f eq 'V') {
4438 $in = '%m%d%H%M%y' . $in;
4439 $val = '';
4440
4441 } elsif ($f eq 'Q') {
4442 $in = '%Y%m%d' . $in;
4443 $val = '';
4444
4445 } elsif ($f eq 'q') {
4446 $in = '%Y%m%d%H%M%S' . $in;
4447 $val = '';
4448
4449 } elsif ($f eq 'P') {
4450 $in = '%Y%m%d%H:%M:%S' . $in;
4451 $val = '';
4452
4453 } elsif ($f eq 'O') {
4454 $in = '%Y-%m-%dT%H:%M:%S' . $in;
4455 $val = '';
4456
4457 } elsif ($f eq 'F') {
4458 $in = '%A, %B %e, %Y' . $in;
4459 $val = '';
4460
4461 } elsif ($f eq 'K') {
4462 $in = '%Y-%j' . $in;
4463 $val = '';
4464
4465 } elsif ($f eq 'x') {
4466 if ($dmb->_config('dateformat') eq 'US') {
4467 $in = '%m/%d/%y' . $in;
4468 } else {
4469 $in = '%d/%m/%y' . $in;
4470 }
4471 $val = '';
4472
4473 } elsif ($f eq 'J') {
4474 $in = '%G-W%W-%w' . $in;
4475 $val = '';
4476
4477 } elsif ($f eq 'n') {
4478 $val = "\n";
4479
4480 } elsif ($f eq 't') {
4481 $val = "\t";
4482
4483 } else {
4484 $val = $f;
4485 }
4486
4487 if ($val ne '') {
4488 $$self{'data'}{'f'}{$f} = $val;
4489 $out .= $val;
4490 }
4491 }
4492 push(@out,$out);
4493 }
4494
4495 if (wantarray) {
4496 return @out;
4497 } elsif (@out == 1) {
4498 return $out[0];
4499 }
4500
4501 return ''
4502 }
450311.14ms116µs}
# spent 16µs making 1 call to Date::Manip::Date::BEGIN@4186
4504
4505########################################################################
4506# EVENT METHODS
4507
4508sub list_events {
4509 my($self,@args) = @_;
4510 if ($$self{'err'} || ! $$self{'data'}{'set'}) {
4511 warn "WARNING: [list_events] Object must contain a valid date\n";
4512 return undef;
4513 }
4514 my $dmt = $$self{'tz'};
4515 my $dmb = $$dmt{'base'};
4516
4517 # Arguments
4518
4519 my($date,$day,$format);
4520 if (@args && $args[$#args] eq 'dates') {
4521 pop(@args);
4522 $format = 'dates';
4523 } else {
4524 $format = 'std';
4525 }
4526
4527 if (@args && $#args==0 && ref($args[0]) eq 'Date::Manip::Date') {
4528 $date = $args[0];
4529 } elsif (@args && $#args==0 && $args[0]==0) {
4530 $day = 1;
4531 } elsif (@args) {
4532 warn "ERROR: [list_events] unknown argument list\n";
4533 return [];
4534 }
4535
4536 # Get the beginning/end dates we're looking for events in
4537
4538 my($beg,$end);
4539 if ($date) {
4540 $beg = $self;
4541 $end = $date;
4542 } elsif ($day) {
4543 $beg = $self->new_date();
4544 $end = $self->new_date();
4545 my($y,$m,$d) = $self->value();
4546 $beg->set('date',[$y,$m,$d,0,0,0]);
4547 $end->set('date',[$y,$m,$d,23,59,59]);
4548 } else {
4549 $beg = $self;
4550 $end = $self;
4551 }
4552
4553 if ($beg->cmp($end) == 1) {
4554 my $tmp = $beg;
4555 $beg = $end;
4556 $end = $tmp;
4557 }
4558
4559 # We need to get a list of all events which may apply.
4560
4561 my($y0) = $beg->value();
4562 my($y1) = $end->value();
4563 foreach my $y ($y0..$y1) {
4564 $self->_events_year($y);
4565 }
4566
4567 my @events = ();
4568 foreach my $i (keys %{ $$dmb{'data'}{'events'} }) {
4569 my $event = $$dmb{'data'}{'events'}{$i};
4570 my $type = $$event{'type'};
4571 my $name = $$event{'name'};
4572
4573 if ($type eq 'specified') {
4574 my $d0 = $$dmb{'data'}{'events'}{$i}{'beg'};
4575 my $d1 = $$dmb{'data'}{'events'}{$i}{'end'};
4576 push @events,[$d0,$d1,$name];
4577
4578 } elsif ($type eq 'ym' || $type eq 'date') {
4579 foreach my $y ($y0..$y1) {
4580 if (exists $$dmb{'data'}{'events'}{$i}{$y}) {
4581 my($d0,$d1) = @{ $$dmb{'data'}{'events'}{$i}{$y} };
4582 push @events,[$d0,$d1,$name];
4583 }
4584 }
4585
4586 } elsif ($type eq 'recur') {
4587 my $rec = $$dmb{'data'}{'events'}{$i}{'recur'};
4588 my $del = $$dmb{'data'}{'events'}{$i}{'delta'};
4589 my @d = $rec->dates($beg,$end);
4590 foreach my $d0 (@d) {
4591 my $d1 = $d0->calc($del);
4592 push @events,[$d0,$d1,$name];
4593 }
4594 }
4595 }
4596
4597 # Next we need to see which ones apply.
4598
4599 my @tmp;
4600 foreach my $e (@events) {
4601 my($d0,$d1,$name) = @$e;
4602
4603 push(@tmp,$e) if ($beg->cmp($d1) != 1 &&
4604 $end->cmp($d0) != -1);
4605 }
4606
4607 # Now format them...
4608
4609 if ($format eq 'std') {
4610 @events = sort { $$a[0]->cmp($$b[0]) ||
4611 $$a[1]->cmp($$b[1]) ||
4612 $$a[2] cmp $$b[2] } @tmp;
4613
4614 } elsif ($format eq 'dates') {
4615 my $p1s = $self->new_delta();
4616 $p1s->parse('+0:0:0:0:0:0:1');
4617
4618 @events = ();
4619 my (@tmp2);
4620 foreach my $e (@tmp) {
4621 my $name = $$e[2];
4622 if ($$e[0]->cmp($beg) == -1) {
4623 # Event begins before the start
4624 push(@tmp2,[$beg,'+',$name]);
4625 } else {
4626 push(@tmp2,[$$e[0],'+',$name]);
4627 }
4628
4629 my $d1 = $$e[1]->calc($p1s);
4630
4631 if ($d1->cmp($end) == -1) {
4632 # Event ends before the end
4633 push(@tmp2,[$d1,'-',$name]);
4634 }
4635 }
4636
4637 return () if (! @tmp2);
4638 @tmp2 = sort { $$a[0]->cmp($$b[0]) ||
4639 $$a[1] cmp $$b[1] ||
4640 $$a[2] cmp $$b[2] } @tmp2;
4641
4642 # @tmp2 is now:
4643 # ( [ DATE1, OP1, NAME1 ], [ DATE2, OP2, NAME2 ], ... )
4644 # which is sorted by date.
4645
4646 my $d = $tmp2[0]->[0];
4647
4648 if ($beg->cmp($d) != 0) {
4649 push(@events,[$beg]);
4650 }
4651
4652 my %e;
4653 while (1) {
4654
4655 # If the first element is the same date as we're
4656 # currently working with, just perform the operation
4657 # and remove it from the list. If the list is not empty,
4658 # we'll proceed to the next element.
4659
4660 my $d0 = $tmp2[0]->[0];
4661 if ($d->cmp($d0) == 0) {
4662 my $e = shift(@tmp2);
4663 my $op = $$e[1];
4664 my $n = $$e[2];
4665 if ($op eq '+') {
4666 $e{$n} = 1;
4667 } else {
4668 delete $e{$n};
4669 }
4670
4671 next if (@tmp2);
4672 }
4673
4674 # We need to store the existing %e.
4675
4676 my @n = sort keys %e;
4677 push(@events,[$d,@n]);
4678
4679 # If the list is empty, we're done. Otherwise, we need to
4680 # reset the date and continue.
4681
4682 last if (! @tmp2);
4683 $d = $tmp2[0]->[0];
4684 }
4685 }
4686
4687 return @events;
4688}
4689
4690# The events of type date and ym are determined on a year-by-year basis
4691#
4692sub _events_year {
4693 my($self,$y) = @_;
4694 my $dmt = $$self{'tz'};
4695 my $dmb = $$dmt{'base'};
4696 my $tz = $dmt->_now('tz',1);
4697 return if (exists $$dmb{'data'}{'eventyears'}{$y});
4698 $self->_event_objs() if (! $$dmb{'data'}{'eventobjs'});
4699
4700 my $d = $self->new_date();
4701 $d->config('forcedate',"${y}-01-01-00:00:00,$tz");
4702
4703 my $hrM1 = $d->new_delta();
4704 $hrM1->set('delta',[0,0,0,0,0,59,59]);
4705
4706 my $dayM1 = $d->new_delta();
4707 $dayM1->set('delta',[0,0,0,0,23,59,59]);
4708
4709 foreach my $i (keys %{ $$dmb{'data'}{'events'} }) {
4710 my $event = $$dmb{'data'}{'events'}{$i};
4711 my $type = $$event{'type'};
4712
4713 if ($type eq 'ym') {
4714 my $beg = $$event{'beg'};
4715 my $end = $$event{'end'};
4716 my $d0 = $d->new_date();
4717 $d0->parse_date($beg);
4718 $d0->set('time',[0,0,0]);
4719
4720 my $d1;
4721 if ($end) {
4722 $d1 = $d0->new_date();
4723 $d1->parse_date($end);
4724 $d1->set('time',[23,59,59]);
4725 } else {
4726 $d1 = $d0->calc($dayM1);
4727 }
4728 $$dmb{'data'}{'events'}{$i}{$y} = [ $d0,$d1 ];
4729
4730 } elsif ($type eq 'date') {
4731 my $beg = $$event{'beg'};
4732 my $end = $$event{'end'};
4733 my $del = $$event{'delta'};
4734 my $d0 = $d->new_date();
4735 $d0->parse($beg);
4736
4737 my $d1;
4738 if ($end) {
4739 $d1 = $d0->new_date();
4740 $d1->parse($end);
4741 } elsif ($del) {
4742 $d1 = $d0->calc($del);
4743 } else {
4744 $d1 = $d0->calc($hrM1);
4745 }
4746 $$dmb{'data'}{'events'}{$i}{$y} = [ $d0,$d1 ];
4747 }
4748 }
4749}
4750
4751# This parses the raw event list. It only has to be done once.
4752#
4753sub _event_objs {
4754 my($self) = @_;
4755 my $dmt = $$self{'tz'};
4756 my $dmb = $$dmt{'base'};
4757 # Only parse once.
4758 $$dmb{'data'}{'eventobjs'} = 1;
4759
4760 my $hrM1 = $self->new_delta();
4761 $hrM1->set('delta',[0,0,0,0,0,59,59]);
4762
4763 my $M1 = $self->new_delta();
4764 $M1->set('delta',[0,0,0,0,0,0,-1]);
4765
4766 my @tmp = @{ $$dmb{'data'}{'sections'}{'events'} };
4767 my $i = 0;
4768 while (@tmp) {
4769 my $string = shift(@tmp);
4770 my $name = shift(@tmp);
4771 my @event = split(/\s*;\s*/,$string);
4772
4773 if ($#event == 0) {
4774
4775 # YMD/YM
4776
4777 my $d1 = $self->new_date();
4778 my $err = $d1->parse_date($event[0]);
4779 if (! $err) {
4780 if ($$d1{'data'}{'def'}[0] eq '') {
4781 # YM
4782 $$dmb{'data'}{'events'}{$i++} = { 'type' => 'ym',
4783 'name' => $name,
4784 'beg' => $event[0] };
4785 } else {
4786 # YMD
4787 my $d2 = $d1->new_date();
4788 my ($y,$m,$d) = $d1->value();
4789 $d1->set('time',[0,0,0]);
4790 $d2->set('date',[$y,$m,$d,23,59,59]);
4791 $$dmb{'data'}{'events'}{$i++} = { 'type' => 'specified',
4792 'name' => $name,
4793 'beg' => $d1,
4794 'end' => $d2 };
4795 }
4796 next;
4797 }
4798
4799 # Date
4800
4801 $err = $d1->parse($event[0]);
4802 if (! $err) {
4803 if ($$d1{'data'}{'def'}[0] eq '') {
4804 # Date (no year)
4805 $$dmb{'data'}{'events'}{$i++} = { 'type' => 'date',
4806 'name' => $name,
4807 'beg' => $event[0],
4808 'delta' => $hrM1
4809 };
4810 } else {
4811 # Date (year)
4812 my $d2 = $d1->calc($hrM1);
4813 $$dmb{'data'}{'events'}{$i++} = { 'type' => 'specified',
4814 'name' => $name,
4815 'beg' => $d1,
4816 'end' => $d2
4817 };
4818 }
4819 next;
4820 }
4821
4822 # Recur
4823
4824 my $r = $self->new_recur();
4825 $err = $r->parse($event[0]);
4826 if ($err) {
4827 warn "ERROR: invalid event definition (must be Date, YMD, YM, or Recur)\n"
4828 . " $string\n";
4829 next;
4830 }
4831
4832 my @d = $r->dates();
4833 if (@d) {
4834 foreach my $d (@d) {
4835 my $d2 = $d->calc($hrM1);
4836 $$dmb{'data'}{'events'}{$i++} = { 'type' => 'specified',
4837 'name' => $name,
4838 'beg' => $d1,
4839 'end' => $d2
4840 };
4841 }
4842 } else {
4843 $$dmb{'data'}{'events'}{$i++} = { 'type' => 'recur',
4844 'name' => $name,
4845 'recur' => $r,
4846 'delta' => $hrM1
4847 };
4848 }
4849
4850 } elsif ($#event == 1) {
4851 my($o1,$o2) = @event;
4852
4853 # YMD;YMD
4854 # YM;YM
4855
4856 my $d1 = $self->new_date();
4857 my $err = $d1->parse_date($o1);
4858 if (! $err) {
4859 my $d2 = $self->new_date();
4860 $err = $d2->parse_date($o2);
4861 if ($err) {
4862 warn "ERROR: invalid event definition (must be YMD;YMD or YM;YM)\n"
4863 . " $string\n";
4864 next;
4865 } elsif ($$d1{'data'}{'def'}[0] ne $$d2{'data'}{'def'}[0]) {
4866 warn "ERROR: invalid event definition (YMD;YM or YM;YMD not allowed)\n"
4867 . " $string\n";
4868 next;
4869 }
4870
4871 if ($$d1{'data'}{'def'}[0] eq '') {
4872 # YM;YM
4873 $$dmb{'data'}{'events'}{$i++} = { 'type' => 'ym',
4874 'name' => $name,
4875 'beg' => $o1,
4876 'end' => $o2
4877 };
4878 } else {
4879 # YMD;YMD
4880 $d1->set('time',[0,0,0]);
4881 $d2->set('time',[23,59,59]);
4882 $$dmb{'data'}{'events'}{$i++} = { 'type' => 'specified',
4883 'name' => $name,
4884 'beg' => $d1,
4885 'end' => $d2 };
4886 }
4887 next;
4888 }
4889
4890 # Date;Date
4891 # Date;Delta
4892
4893 $err = $d1->parse($o1);
4894 if (! $err) {
4895
4896 my $d2 = $self->new_date();
4897 $err = $d2->parse($o2,'nodelta');
4898
4899 if (! $err) {
4900 # Date;Date
4901 if ($$d1{'data'}{'def'}[0] ne $$d2{'data'}{'def'}[0]) {
4902 warn "ERROR: invalid event definition (year must be absent or\n"
4903 . " included in both dats in Date;Date)\n"
4904 . " $string\n";
4905 next;
4906 }
4907
4908 if ($$d1{'data'}{'def'}[0] eq '') {
4909 # Date (no year)
4910 $$dmb{'data'}{'events'}{$i++} = { 'type' => 'date',
4911 'name' => $name,
4912 'beg' => $o1,
4913 'end' => $o2
4914 };
4915 } else {
4916 # Date (year)
4917 $$dmb{'data'}{'events'}{$i++} = { 'type' => 'specified',
4918 'name' => $name,
4919 'beg' => $d1,
4920 'end' => $d2
4921 };
4922 }
4923 next;
4924 }
4925
4926 # Date;Delta
4927 my $del = $self->new_delta();
4928 $err = $del->parse($o2);
4929
4930 if ($err) {
4931 warn "ERROR: invalid event definition (must be Date;Date or\n"
4932 . " Date;Delta) $string\n";
4933 next;
4934 }
4935
4936 $del = $del->calc($M1);
4937 if ($$d1{'data'}{'def'}[0] eq '') {
4938 # Date (no year)
4939 $$dmb{'data'}{'events'}{$i++} = { 'type' => 'date',
4940 'name' => $name,
4941 'beg' => $o1,
4942 'delta' => $del
4943 };
4944 } else {
4945 # Date (year)
4946 $d2 = $d1->calc($del);
4947 $$dmb{'data'}{'events'}{$i++} = { 'type' => 'specified',
4948 'name' => $name,
4949 'beg' => $d1,
4950 'end' => $d2
4951 };
4952 }
4953 next;
4954 }
4955
4956 # Recur;Delta
4957
4958 my $r = $self->new_recur();
4959 $err = $r->parse($o1);
4960
4961 my $del = $self->new_delta();
4962 if (! $err) {
4963 $err = $del->parse($o2);
4964 }
4965
4966 if ($err) {
4967 warn "ERROR: invalid event definition (must be Date;Date, YMD;YMD, "
4968 . " YM;YM, Date;Delta, or Recur;Delta)\n"
4969 . " $string\n";
4970 next;
4971 }
4972
4973 $del = $del->calc($M1);
4974 my @d = $r->dates();
4975 if (@d) {
4976 foreach my $d1 (@d) {
4977 my $d2 = $d1->calc($del);
4978 $$dmb{'data'}{'events'}{$i++} = { 'type' => 'specified',
4979 'name' => $name,
4980 'beg' => $d1,
4981 'end' => $d2
4982 };
4983 }
4984 } else {
4985 $$dmb{'data'}{'events'}{$i++} = { 'type' => 'recur',
4986 'name' => $name,
4987 'recur' => $r,
4988 'delta' => $del
4989 };
4990 }
4991
4992 } else {
4993 warn "ERROR: invalid event definition\n"
4994 . " $string\n";
4995 next;
4996 }
4997 }
4998}
4999
500013µs1;
5001# Local Variables:
5002# mode: cperl
5003# indent-tabs-mode: nil
5004# cperl-indent-level: 3
5005# cperl-continued-statement-offset: 2
5006# cperl-continued-brace-offset: 0
5007# cperl-brace-offset: 0
5008# cperl-brace-imaginary-offset: 0
5009# cperl-label-offset: 0
5010# End:
 
# spent 26.4ms within Date::Manip::Date::CORE:match which was called 14622 times, avg 2µs/call: # 4872 times (9.47ms+0s) by Date::Manip::Date::_parse_time at line 1618, avg 2µs/call # 2436 times (7.15ms+0s) by Date::Manip::Date::_parse_datetime_iso8601 at line 1206, avg 3µs/call # 2436 times (3.69ms+0s) by Date::Manip::Date::_parse_date_common at line 1697, avg 2µs/call # 2436 times (3.52ms+0s) by Date::Manip::Date::_parse_date_common at line 1682, avg 1µs/call # 2436 times (2.55ms+0s) by Date::Manip::Date::_parse_datetime_other at line 1871, avg 1µs/call # 6 times (19µs+0s) by Date::Manip::Date::_parse_date_other at line 1951, avg 3µs/call
sub Date::Manip::Date::CORE:match; # opcode
# spent 12µs within Date::Manip::Date::CORE:qr which was called 15 times, avg 827ns/call: # once (2µs+0s) by Date::Manip::Date::_other_rx at line 1569 # once (1µs+0s) by Date::Manip::Date::_iso8601_rx at line 1185 # once (1µs+0s) by Date::Manip::Date::_other_rx at line 1468 # once (1µs+0s) by Date::Manip::Date::_other_rx at line 1506 # once (1µs+0s) by Date::Manip::Date::_other_rx at line 1391 # once (900ns+0s) by Date::Manip::Date::_other_rx at line 1459 # once (900ns+0s) by Date::Manip::Date::_iso8601_rx at line 1141 # once (800ns+0s) by Date::Manip::Date::_iso8601_rx at line 1093 # once (700ns+0s) by Date::Manip::Date::_iso8601_rx at line 1183 # once (600ns+0s) by Date::Manip::Date::_other_rx at line 1469 # once (500ns+0s) by Date::Manip::Date::_iso8601_rx at line 1108 # once (500ns+0s) by Date::Manip::Date::_iso8601_rx at line 1146 # once (500ns+0s) by Date::Manip::Date::_other_rx at line 1412 # once (500ns+0s) by Date::Manip::Date::_other_rx at line 1390 # once (500ns+0s) by Date::Manip::Date::_other_rx at line 1477
sub Date::Manip::Date::CORE:qr; # opcode
# spent 36.6ms within Date::Manip::Date::CORE:regcomp which was called 21950 times, avg 2µs/call: # 4872 times (1.68ms+0s) by Date::Manip::Date::_parse_time at line 1618, avg 346ns/call # 2436 times (4.69ms+0s) by Date::Manip::Date::_parse_datetime_iso8601 at line 1206, avg 2µs/call # 2436 times (3.00ms+0s) by Date::Manip::Date::_parse_date_common at line 1697, avg 1µs/call # 2436 times (1.52ms+0s) by Date::Manip::Date::_parse_datetime_other at line 1871, avg 625ns/call # 2436 times (1.36ms+0s) by Date::Manip::Date::_parse_time at line 1632, avg 559ns/call # 2436 times (1.27ms+0s) by Date::Manip::Date::_parse_date_common at line 1682, avg 523ns/call # 2436 times (1.14ms+0s) by Date::Manip::Date::_parse_dow at line 1737, avg 469ns/call # 2436 times (946µs+0s) by Date::Manip::Date::_parse_date at line 430, avg 388ns/call # 6 times (2.71ms+0s) by Date::Manip::Date::_parse_tz at line 1719, avg 452µs/call # 6 times (26µs+0s) by Date::Manip::Date::_parse_date_other at line 1951, avg 4µs/call # once (5.21ms+0s) by Date::Manip::Date::_iso8601_rx at line 1185 # once (5.07ms+0s) by Date::Manip::Date::_other_rx at line 1506 # once (2.51ms+0s) by Date::Manip::Date::_other_rx at line 1391 # once (2.45ms+0s) by Date::Manip::Date::_iso8601_rx at line 1141 # once (1.92ms+0s) by Date::Manip::Date::_other_rx at line 1569 # once (829µs+0s) by Date::Manip::Date::_other_rx at line 1459 # once (137µs+0s) by Date::Manip::Date::_iso8601_rx at line 1093 # once (36µs+0s) by Date::Manip::Date::_other_rx at line 1469 # once (34µs+0s) by Date::Manip::Date::_iso8601_rx at line 1108 # once (23µs+0s) by Date::Manip::Date::_other_rx at line 1412 # once (10µs+0s) by Date::Manip::Date::_iso8601_rx at line 1146 # once (9µs+0s) by Date::Manip::Date::_other_rx at line 1477 # once (8µs+0s) by Date::Manip::Date::_other_rx at line 1390 # once (8µs+0s) by Date::Manip::Date::_other_rx at line 1468
sub Date::Manip::Date::CORE:regcomp; # opcode
# spent 52.7ms within Date::Manip::Date::CORE:subst which was called 26732 times, avg 2µs/call: # 2436 times (28.0ms+0s) by Date::Manip::Date::_parse_time at line 1632, avg 11µs/call # 2436 times (3.76ms+0s) by Date::Manip::Date::_parse_time at line 1638, avg 2µs/call # 2436 times (3.72ms+0s) by Date::Manip::Date::parse at line 154, avg 2µs/call # 2436 times (3.37ms+0s) by Date::Manip::Date::_parse_dow at line 1737, avg 1µs/call # 2436 times (3.00ms+0s) by Date::Manip::Date::_parse_date_common at line 1676, avg 1µs/call # 2436 times (2.78ms+0s) by Date::Manip::Date::_parse_date at line 430, avg 1µs/call # 2436 times (2.68ms+0s) by Date::Manip::Date::_parse_date at line 433, avg 1µs/call # 2436 times (495µs+0s) by Date::Manip::Date::parse at line 155, avg 203ns/call # 2436 times (484µs+0s) by Date::Manip::Date::_parse_date at line 423, avg 199ns/call # 2401 times (2.96ms+0s) by Date::Manip::Date::_parse_dow at line 1749, avg 1µs/call # 2401 times (1.37ms+0s) by Date::Manip::Date::_parse_dow at line 1750, avg 571ns/call # 6 times (64µs+0s) by Date::Manip::Date::_parse_tz at line 1719, avg 11µs/call
sub Date::Manip::Date::CORE:subst; # opcode