← Index
NYTProf Performance Profile   « line view »
For ../dm5dm6_ex3
  Run on Tue Feb 24 07:41:47 2015
Reported on Tue Feb 24 07:41:51 2015

Filename/home/sulbeck/local/lib/perl5/5.20.1/Date/Manip/Date.pm
StatementsExecuted 603899 statements in 515ms
Subroutines
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
24361174.1ms155msDate::Manip::Date::::_parse_timeDate::Manip::Date::_parse_time
24331165.7ms2.21sDate::Manip::Date::::parseDate::Manip::Date::parse
2675011160.2ms60.2msDate::Manip::Date::::CORE:substDate::Manip::Date::CORE:subst (opcode)
24421141.3ms90.7msDate::Manip::Date::::_parse_date_commonDate::Manip::Date::_parse_date_common
24301137.4ms1.70sDate::Manip::Date::::_parse_checkDate::Manip::Date::_parse_check
2196823136.1ms36.1msDate::Manip::Date::::CORE:regcompDate::Manip::Date::CORE:regcomp (opcode)
24301134.0ms105msDate::Manip::Date::::setDate::Manip::Date::set
146406131.1ms31.1msDate::Manip::Date::::CORE:matchDate::Manip::Date::CORE:match (opcode)
24422126.7ms127msDate::Manip::Date::::_parse_dateDate::Manip::Date::_parse_date
24361123.4ms33.8msDate::Manip::Date::::_parse_dowDate::Manip::Date::_parse_dow
24301115.4ms108msDate::Manip::Date::::__parse_checkDate::Manip::Date::__parse_check
24361111.9ms52.8msDate::Manip::Date::::_parse_datetime_iso8601Date::Manip::Date::_parse_datetime_iso8601
2430119.63ms28.6msDate::Manip::Date::::_def_dateDate::Manip::Date::_def_date
4872219.52ms9.52msDate::Manip::Date::::_def_timeDate::Manip::Date::_def_time
2436119.50ms19.1msDate::Manip::Date::::_parse_datetime_otherDate::Manip::Date::_parse_datetime_other
2434228.93ms8.93msDate::Manip::Date::::_initDate::Manip::Date::_init
1118.81ms9.03msDate::Manip::Date::::BEGIN@27Date::Manip::Date::BEGIN@27
2436117.55ms11.2msDate::Manip::Date::::_timeDate::Manip::Date::_time
1116.14ms11.7msDate::Manip::Date::::BEGIN@26Date::Manip::Date::BEGIN@26
2440513.97ms27.8msDate::Manip::Date::::_iso8601_rxDate::Manip::Date::_iso8601_rx (recurses: max depth 1, inclusive time 18.8ms)
111855µs8.43msDate::Manip::Date::::BEGIN@14Date::Manip::Date::BEGIN@14
771349µs10.8msDate::Manip::Date::::_other_rxDate::Manip::Date::_other_rx
11199µs100µsDate::Manip::Date::::BEGIN@20Date::Manip::Date::BEGIN@20
11193µs94µsDate::Manip::Date::::BEGIN@21Date::Manip::Date::BEGIN@21
11182µs218µsDate::Manip::Date::::BEGIN@431Date::Manip::Date::BEGIN@431
61181µs5.58msDate::Manip::Date::::_parse_deltaDate::Manip::Date::_parse_delta
121156µs2.34msDate::Manip::Date::::_parse_date_otherDate::Manip::Date::_parse_date_other
11118µs18µsDate::Manip::Date::::BEGIN@629Date::Manip::Date::BEGIN@629
1515118µs18µsDate::Manip::Date::::CORE:qrDate::Manip::Date::CORE:qr (opcode)
11114µs14µsDate::Manip::Date::::BEGIN@4227Date::Manip::Date::BEGIN@4227
61113µs13µsDate::Manip::Date::::_parse_holidaysDate::Manip::Date::_parse_holidays
1118µs10µsDate::Manip::Date::::BEGIN@1288Date::Manip::Date::BEGIN@1288
1117µs8µsDate::Manip::Date::::BEGIN@3541Date::Manip::Date::BEGIN@3541
1116µs7µsDate::Manip::Date::::BEGIN@3130Date::Manip::Date::BEGIN@3130
1116µs6µsDate::Manip::Date::::BEGIN@2507Date::Manip::Date::BEGIN@2507
1116µs9µsDate::Manip::Date::::BEGIN@18Date::Manip::Date::BEGIN@18
1115µs7µsDate::Manip::Date::::BEGIN@1318Date::Manip::Date::BEGIN@1318
1115µs72µsDate::Manip::Date::::BEGIN@22Date::Manip::Date::BEGIN@22
1114µs16µsDate::Manip::Date::::BEGIN@23Date::Manip::Date::BEGIN@23
1114µs5µsDate::Manip::Date::::BEGIN@3551Date::Manip::Date::BEGIN@3551
1113µs10µsDate::Manip::Date::::BEGIN@19Date::Manip::Date::BEGIN@19
1113µs3µ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::::_parse_tzDate::Manip::Date::_parse_tz
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
14274µs18.43ms
# spent 8.43ms (855µs+7.58) within Date::Manip::Date::BEGIN@14 which was called: # once (855µs+7.58ms) by main::RUNTIME at line 14
use Date::Manip::Obj;
# spent 8.43ms making 1 call to Date::Manip::Date::BEGIN@14
1516µs@ISA = ('Date::Manip::Obj');
16
1717µsrequire 5.010000;
18212µs213µs
# spent 9µ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 9µ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 (3+7) within Date::Manip::Date::BEGIN@19 which was called: # once (3µ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
202106µs2101µs
# spent 100µs (99+1) within Date::Manip::Date::BEGIN@20 which was called: # once (99µs+1µs) by main::RUNTIME at line 20
use integer;
# spent 100µs making 1 call to Date::Manip::Date::BEGIN@20 # spent 1µs making 1 call to integer::import
212101µs296µs
# spent 94µs (93+1) within Date::Manip::Date::BEGIN@21 which was called: # once (93µs+1µs) by main::RUNTIME at line 21
use utf8;
# spent 94µs making 1 call to Date::Manip::Date::BEGIN@21 # spent 1µs making 1 call to utf8::import
22216µs2139µs
# spent 72µs (5+67) within Date::Manip::Date::BEGIN@22 which was called: # once (5µs+67µs) by main::RUNTIME at line 22
use IO::File;
# spent 72µs making 1 call to Date::Manip::Date::BEGIN@22 # spent 67µs making 1 call to Exporter::import
23223µs227µs
# spent 16µs (4+11) within Date::Manip::Date::BEGIN@23 which was called: # once (4µ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
26268µs111.7ms
# spent 11.7ms (6.14+5.61) within Date::Manip::Date::BEGIN@26 which was called: # once (6.14ms+5.61ms) by main::RUNTIME at line 26
use Date::Manip::Base;
# spent 11.7ms making 1 call to Date::Manip::Date::BEGIN@26
272852µs19.03ms
# spent 9.03ms (8.81+224µs) within Date::Manip::Date::BEGIN@27 which was called: # once (8.81ms+224µs) by main::RUNTIME at line 27
use Date::Manip::TZ;
# spent 9.03ms making 1 call to Date::Manip::Date::BEGIN@27
28
291100nsour $VERSION;
301200ns$VERSION='6.49';
3113µs
# spent 3µs within Date::Manip::Date::END which was called: # once (3µ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.93ms within Date::Manip::Date::_init which was called 2434 times, avg 4µs/call: # 2433 times (8.93ms+0s) by Date::Manip::Date::parse at line 103, avg 4µs/call # once (9µs+0s) by Date::Manip::Obj::new at line 162 of Date/Manip/Obj.pm
sub _init {
452434382µs my($self) = @_;
46
472434493µs $$self{'err'} = '';
48
4924349.60ms $$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 2.21s (65.7ms+2.14) within Date::Manip::Date::parse which was called 2433 times, avg 907µs/call: # 2433 times (65.7ms+2.14s) by main::RUNTIME at line 39 of ../dm5dm6_ex3, avg 907µs/call
sub parse {
1022433798µs my($self,$instring,@opts) = @_;
10324334.65ms24338.93ms $self->_init();
# spent 8.93ms making 2433 calls to Date::Manip::Date::_init, avg 4µs/call
1042433281µs my $noupdate = 0;
105
1062433274µs if (! $instring) {
107 $$self{'err'} = '[parse] Empty date string';
108 return 1;
109 }
110
1112433965µs my %opts = map { $_,1 } @opts;
112
1132433442µs my $dmt = $$self{'tz'};
1142433272µs my $dmb = $$dmt{'base'};
115
1162433312µs my($done,$y,$m,$d,$h,$mn,$s,$tzstring,$zone,$abb,$off,$dow,$got_time,
117 $default_time,$firsterr);
118
119 ENCODING:
12024331.76ms243321.2ms foreach my $string ($dmb->_encoding($instring)) {
# spent 21.2ms making 2433 calls to Date::Manip::Base::_encoding, avg 9µs/call
1212436289µs $got_time = 0;
1222436194µs $default_time = 0;
123
124 # Put parse in a simple loop for an easy exit.
1252436222µs PARSE:
126 {
1272436240µs my(@tmp,$tmp);
1282436441µs $$self{'err'} = '';
129
130 # Check the standard date format
131
13224361.75ms243610.7ms $tmp = $dmb->split('date',$string);
# spent 10.7ms making 2436 calls to Date::Manip::Base::split, avg 4µs/call
1332436288µ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
1412436773µs if (! exists $opts{'noiso8601'}) {
14224362.75ms243652.8ms ($done,@tmp) = $self->_parse_datetime_iso8601($string,\$noupdate);
# spent 52.8ms making 2436 calls to Date::Manip::Date::_parse_datetime_iso8601, avg 22µs/call
1432436418µ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
15424367.20ms24364.39ms $string =~ s/(?<!\d),/ /g;
# spent 4.39ms making 2436 calls to Date::Manip::Date::CORE:subst, avg 2µs/call
15524362.69ms2436637µs $string =~ s/,(?!\d)/ /g;
# spent 637µs making 2436 calls to Date::Manip::Date::CORE:subst, avg 262ns/call
156
157 # Some special full date/time formats ('now', 'epoch')
158
1592436637µs if (! exists $opts{'nospecial'}) {
16024362.31ms243619.1ms ($done,@tmp) = $self->_parse_datetime_other($string,\$noupdate);
# spent 19.1ms making 2436 calls to Date::Manip::Date::_parse_datetime_other, avg 8µs/call
1612436299µ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
17024365.46ms2436155ms ($got_time,@tmp) = $self->_parse_time('parse',$string,\$noupdate,%opts);
# spent 155ms making 2436 calls to Date::Manip::Date::_parse_time, avg 64µs/call
17124361.35ms if ($got_time) {
172 ($string,$h,$mn,$s,$tzstring,$zone,$abb,$off) = @tmp;
173 }
174
1752436213µ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
1832436783µs if (! exists $opts{'nodow'}) {
18424363.58ms243633.8ms ($done,@tmp) = $self->_parse_dow($string,\$noupdate);
# spent 33.8ms making 2436 calls to Date::Manip::Date::_parse_dow, avg 14µs/call
1852436608µs if (@tmp) {
1862401522µs if ($done) {
187 ($y,$m,$d) = @tmp;
188 $default_time = 1;
189 last PARSE;
190 } else {
1912401645µs ($string,$dow) = @tmp;
192 }
193 }
194 }
1952436244µ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
21124364.08ms2436127ms (@tmp) = $self->_parse_date($string,$dow,\$noupdate,%opts);
# spent 127ms making 2436 calls to Date::Manip::Date::_parse_date, avg 52µs/call
2122436257µs if (@tmp) {
2132430689µs ($y,$m,$d,$dow) = @tmp;
2142430218µs $default_time = 1;
21524301.24ms last PARSE;
216 }
217
218 # Parse any timezone
219
2206900ns if (! $tzstring) {
221 ($string,@tmp) = $self->_parse_tz($string,\$noupdate);
222 ($tzstring,$zone,$abb,$off) = @tmp if (@tmp);
223 last PARSE if (! $string);
224 }
225
226 # Try the remainder of the string as a date.
227
22862µs if ($tzstring) {
22966µs6183µs (@tmp) = $self->_parse_date($string,$dow,\$noupdate,%opts);
# spent 183µs making 6 calls to Date::Manip::Date::_parse_date, avg 30µs/call
23061µs 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
257610µs65.58ms ($done,@tmp) =
# spent 5.58ms making 6 calls to Date::Manip::Date::_parse_delta, avg 929µ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
26962µs unless (exists $opts{'noholidays'}) {
27067µ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);
2726500ns if (@tmp) {
273 ($y,$m,$d) = @tmp;
274 }
275614µs last PARSE if ($done);
276 }
277
27862µ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
2872436521µs if ($$self{'err'}) {
28862µs if (! $firsterr) {
289 $firsterr = $$self{'err'};
290 }
29162µs next ENCODING;
292 }
293
294 # If we didn't get an error, this is the string to use.
295
2962430871µs last ENCODING;
297 }
298
2992433341µs if ($$self{'err'}) {
3003900ns $$self{'err'} = $firsterr;
30135µs return 1;
302 }
303
304 # Make sure that a time is set
305
3062430264µ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
3202430754µs $$self{'data'}{'set'} = 2;
32124305.54ms24301.70s return $self->_parse_check('parse',$instring,
# spent 1.70s making 2430 calls to Date::Manip::Date::_parse_check, avg 701µ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 127ms (26.7+101) within Date::Manip::Date::_parse_date which was called 2442 times, avg 52µs/call: # 2436 times (26.7ms+100ms) by Date::Manip::Date::parse at line 211, avg 52µs/call # 6 times (61µs+122µs) by Date::Manip::Date::parse at line 229, avg 30µs/call
sub _parse_date {
4162442898µ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
42324422.66ms2442508µs $string =~ s/,/ /g;
# spent 508µs making 2442 calls to Date::Manip::Date::CORE:subst, avg 208ns/call
424
4252442323µs my $dmt = $$self{'tz'};
4262442285µs my $dmb = $$dmt{'base'};
42724421.38ms119µs my $ign = (exists $$dmb{'data'}{'rx'}{'other'}{'ignore'} ?
# spent 19µs making 1 call to Date::Manip::Date::_other_rx
428 $$dmb{'data'}{'rx'}{'other'}{'ignore'} :
429 $self->_other_rx('ignore'));
43024427.92ms48843.92ms $string =~ s/$ign/ /g;
# spent 2.83ms making 2442 calls to Date::Manip::Date::CORE:subst, avg 1µs/call # spent 1.09ms making 2442 calls to Date::Manip::Date::CORE:regcomp, avg 446ns/call
43124445.78ms2443678µs
# spent 218µs (82+135) within Date::Manip::Date::BEGIN@431 which was called: # once (82µs+135µs) by main::RUNTIME at line 431
my $of = $+{'of'};
# spent 460µs making 2442 calls to Tie::Hash::NamedCapture::FETCH, avg 189ns/call # spent 218µs making 1 call to Date::Manip::Date::BEGIN@431
432
43324424.86ms24422.65ms $string =~ s/\s*$//;
# spent 2.65ms making 2442 calls to Date::Manip::Date::CORE:subst, avg 1µs/call
4342442187µs return () if (! $string);
435
4362442287µ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
4454884796µs unless (exists $opts{'nodow'}) {
4462442327µ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
4622442266µs unless (exists $opts{'nocommon'}) {
46324422.57ms244290.7ms (@tmp) = $self->_parse_date_common($string,$noupdate);
# spent 90.7ms making 2442 calls to Date::Manip::Date::_parse_date_common, avg 37µs/call
4642442360µs if (@tmp) {
4652430714µs ($y,$m,$d) = @tmp;
4662430963µs last PARSE;
467 }
468 }
469
470 # Parse less common dates
471
472123µs unless (exists $opts{'noother'}) {
4731213µs122.34ms (@tmp) = $self->_parse_date_other($string,$dow,$of,$noupdate);
# spent 2.34ms making 12 calls to Date::Manip::Date::_parse_date_other, avg 195µs/call
474122µs if (@tmp) {
475 ($y,$m,$d,$dow) = @tmp;
476 last PARSE;
477 }
478 }
479
4801217µs return ();
481 }
482
48324304.46ms 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 my $offset = $dmb->_delta_convert('offset',$off);
524 $z = $dmt->__zone([],$offset,'',$abb,'');
525 if (! $z) {
526 $z = $dmt->__zone([],$offset,$abb,'','');
527 }
528 return 'Invalid zone' if (! $z);
529 } else {
530 $z = $dmt->_now('tz',$noupdate);
531 $noupdate = 1;
532 }
533 my($err,$date) = $dmt->convert_from_gmt([$y,$m,$d,$h,$mn,$s],$z);
534 ($y,$m,$d,$h,$mn,$s) = @$date;
535 last;
536 }
537
538 if (defined($epocho)) {
539 ($y,$m,$d,$h,$mn,$s) = @{ $dmb->secs_since_1970($epocho) };
540 last;
541 }
542
543 # Get y/m/d from:
544 # $y,$m,$d,
545 # $mon_name,$mon_abb
546 # $doy,$nth
547 # $g/$w,$l/$u
548
549 if ($mon_name) {
550 $m = $$dmb{'data'}{'wordmatch'}{'month_name'}{lc($mon_name)};
551 } elsif ($mon_abb) {
552 $m = $$dmb{'data'}{'wordmatch'}{'month_abb'}{lc($mon_abb)};
553 }
554
555 if ($nth) {
556 $d = $$dmb{'data'}{'wordmatch'}{'nth'}{lc($nth)};
557 }
558
559 if ($doy) {
560 $y = $dmt->_now('y',$noupdate) if (! $y);
561 $noupdate = 1;
562 ($y,$m,$d) = @{ $dmb->day_of_year($y,$doy) };
563
564 } elsif ($g) {
565 $y = $dmt->_now('y',$noupdate) if (! $y);
566 $noupdate = 1;
567 ($y,$m,$d) = @{ $dmb->_week_of_year($g,$w,1) };
568
569 } elsif ($l) {
570 $y = $dmt->_now('y',$noupdate) if (! $y);
571 $noupdate = 1;
572 ($y,$m,$d) = @{ $dmb->_week_of_year($l,$u,7) };
573
574 } elsif ($m) {
575 ($y,$m,$d) = $self->_def_date($y,$m,$d,\$noupdate);
576 }
577
578 # Get h/mn/s from:
579 # $h,$mn,$s,$ampm
580
581 if (defined($h)) {
582 ($h,$mn,$s) = $self->_def_time($h,$mn,$s,\$noupdate);
583 }
584
585 if ($ampm) {
586 if ($$dmb{'data'}{'wordmatch'}{'ampm'}{lc($ampm)} == 2) {
587 # pm times
588 $h+=12 unless ($h==12);
589 } else {
590 # am times
591 $h=0 if ($h==12);
592 }
593 }
594
595 # Get dow from:
596 # $dow_name,$dow_abb,$dow_char,$dow_num
597
598 if ($dow_name) {
599 $dow_num = $$dmb{'data'}{'wordmatch'}{'day_name'}{lc($dow_name)};
600 } elsif ($dow_abb) {
601 $dow_num = $$dmb{'data'}{'wordmatch'}{'day_abb'}{lc($dow_abb)};
602 } elsif ($dow_char) {
603 $dow_num = $$dmb{'data'}{'wordmatch'}{'day_char'}{lc($dow_char)};
604 }
605
606 last;
607 }
608
609 if (! $m) {
610 ($y,$m,$d) = $dmt->_now('now',$noupdate);
611 $noupdate = 1;
612 }
613 if (! defined($h)) {
614 ($h,$mn,$s) = (0,0,0);
615 }
616
617 $$self{'data'}{'set'} = 2;
618 $err = $self->_parse_check('parse_format',$string,
619 $y,$m,$d,$h,$mn,$s,$dow_num,
620 $tzstring,$zone,$abb,$off);
621
622 if (wantarray) {
623 my %tmp = %{ dclone(\%+) };
624 return ($err,%tmp);
625 }
626 return $err;
627}
628
629
# spent 18µs within Date::Manip::Date::BEGIN@629 which was called: # once (18µs+0s) by main::RUNTIME at line 930
BEGIN {
63013µs my %y_form = map { $_,1 } qw( Y y s o G L );
63113µs my %m_form = map { $_,1 } qw( m f b h B j s o W U );
63212µs my %d_form = map { $_,1 } qw( j d e E s o W U );
63311µs my %h_form = map { $_,1 } qw( H I k i s o );
6341900ns my %mn_form = map { $_,1 } qw( M s o );
6351800ns my %s_form = map { $_,1 } qw( S s o );
636
63711µs my %dow_form = map { $_,1 } qw( v a A w );
6381700ns my %am_form = map { $_,1 } qw( p s o );
6391800ns my %z_form = map { $_,1 } qw( Z z N );
6401700ns my %mon_form = map { $_,1 } qw( b h B );
64115µs my %day_form = map { $_,1 } qw( v a A );
642
643 sub _format_regexp {
644 my($self,$format) = @_;
645 my $dmt = $$self{'tz'};
646 my $dmb = $$dmt{'base'};
647
648 if (exists $$dmb{'data'}{'format'}{$format}) {
649 return @{ $$dmb{'data'}{'format'}{$format} };
650 }
651
652 my $re;
653 my $err;
654 my($y,$m,$d,$h,$mn,$s) = (0,0,0,0,0,0);
655 my($dow,$ampm,$zone,$G,$W,$L,$U) = (0,0,0,0,0,0,0);
656
657 while ($format) {
658 last if ($format eq '%');
659
660 if ($format =~ s/^([^%]+)//) {
661 $re .= $1;
662 next;
663 }
664
665 $format =~ s/^%(.)//;
666 my $f = $1;
667
668 if (exists $y_form{$f}) {
669 if ($y) {
670 $err = 'Year specified multiple times';
671 last;
672 }
673 $y = 1;
674 }
675
676 if (exists $m_form{$f}) {
677 if ($m) {
678 $err = 'Month specified multiple times';
679 last;
680 }
681 $m = 1;
682 }
683
684 if (exists $d_form{$f}) {
685 if ($d) {
686 $err = 'Day specified multiple times';
687 last;
688 }
689 $d = 1;
690 }
691
692 if (exists $h_form{$f}) {
693 if ($h) {
694 $err = 'Hour specified multiple times';
695 last;
696 }
697 $h = 1;
698 }
699
700 if (exists $mn_form{$f}) {
701 if ($mn) {
702 $err = 'Minutes specified multiple times';
703 last;
704 }
705 $mn = 1;
706 }
707
708 if (exists $s_form{$f}) {
709 if ($s) {
710 $err = 'Seconds specified multiple times';
711 last;
712 }
713 $s = 1;
714 }
715
716 if (exists $dow_form{$f}) {
717 if ($dow) {
718 $err = 'Day-of-week specified multiple times';
719 last;
720 }
721 $dow = 1;
722 }
723
724 if (exists $am_form{$f}) {
725 if ($ampm) {
726 $err = 'AM/PM specified multiple times';
727 last;
728 }
729 $ampm = 1;
730 }
731
732 if (exists $z_form{$f}) {
733 if ($zone) {
734 $err = 'Zone specified multiple times';
735 last;
736 }
737 $zone = 1;
738 }
739
740 if ($f eq 'G') {
741 if ($G) {
742 $err = 'G specified multiple times';
743 last;
744 }
745 $G = 1;
746
747 } elsif ($f eq 'W') {
748 if ($W) {
749 $err = 'W specified multiple times';
750 last;
751 }
752 $W = 1;
753
754 } elsif ($f eq 'L') {
755 if ($L) {
756 $err = 'L specified multiple times';
757 last;
758 }
759 $L = 1;
760
761 } elsif ($f eq 'U') {
762 if ($U) {
763 $err = 'U specified multiple times';
764 last;
765 }
766 $U = 1;
767 }
768
769 ###
770
771 if ($f eq 'Y') {
772 $re .= '(?<y>\d\d\d\d)';
773
774 } elsif ($f eq 'y') {
775 $re .= '(?<y>\d\d)';
776
777 } elsif ($f eq 'm') {
778 $re .= '(?<m>\d\d)';
779
780 } elsif ($f eq 'f') {
781 $re .= '(?:(?<m>\d\d)| ?(?<m>\d))';
782
783 } elsif (exists $mon_form{$f}) {
784 my $abb = $$dmb{'data'}{'rx'}{'month_abb'}[0];
785 my $nam = $$dmb{'data'}{'rx'}{'month_name'}[0];
786 $re .= "(?:(?<mon_name>$nam)|(?<mon_abb>$abb))";
787
788 } elsif ($f eq 'j') {
789 $re .= '(?<doy>\d\d\d)';
790
791 } elsif ($f eq 'd') {
792 $re .= '(?<d>\d\d)';
793
794 } elsif ($f eq 'e') {
795 $re .= '(?:(?<d>\d\d)| ?(?<d>\d))';
796
797 } elsif (exists $day_form{$f}) {
798 my $abb = $$dmb{'data'}{'rx'}{'day_abb'}[0];
799 my $name = $$dmb{'data'}{'rx'}{'day_name'}[0];
800 my $char = $$dmb{'data'}{'rx'}{'day_char'}[0];
801 $re .= "(?:(?<dow_name>$name)|(?<dow_abb>$abb)|(?<dow_char>$char))";
802
803 } elsif ($f eq 'w') {
804 $re .= '(?<dow_num>[1-7])';
805
806 } elsif ($f eq 'E') {
807 my $nth = $$dmb{'data'}{'rx'}{'nth'}[0];
808 $re .= "(?<nth>$nth)"
809
810 } elsif ($f eq 'H' || $f eq 'I') {
811 $re .= '(?<h>\d\d)';
812
813 } elsif ($f eq 'k' || $f eq 'i') {
814 $re .= '(?:(?<h>\d\d)| ?(?<h>\d))';
815
816 } elsif ($f eq 'p') {
817 my $ampm = $$dmb{data}{rx}{ampm}[0];
818 $re .= "(?<ampm>$ampm)";
819
820 } elsif ($f eq 'M') {
821 $re .= '(?<mn>\d\d)';
822
823 } elsif ($f eq 'S') {
824 $re .= '(?<s>\d\d)';
825
826 } elsif (exists $z_form{$f}) {
827 $re .= $dmt->_zrx('zrx');
828
829 } elsif ($f eq 's') {
830 $re .= '(?<epochs>\d+)';
831
832 } elsif ($f eq 'o') {
833 $re .= '(?<epocho>\d+)';
834
835 } elsif ($f eq 'G') {
836 $re .= '(?<g>\d\d\d\d)';
837
838 } elsif ($f eq 'W') {
839 $re .= '(?<w>\d\d)';
840
841 } elsif ($f eq 'L') {
842 $re .= '(?<l>\d\d\d\d)';
843
844 } elsif ($f eq 'U') {
845 $re .= '(?<u>\d\d)';
846
847 } elsif ($f eq 'c') {
848 $format = '%a %b %e %H:%M:%S %Y' . $format;
849
850 } elsif ($f eq 'C' || $f eq 'u') {
851 $format = '%a %b %e %H:%M:%S %Z %Y' . $format;
852
853 } elsif ($f eq 'g') {
854 $format = '%a, %d %b %Y %H:%M:%S %Z' . $format;
855
856 } elsif ($f eq 'D') {
857 $format = '%m/%d/%y' . $format;
858
859 } elsif ($f eq 'r') {
860 $format = '%I:%M:%S %p' . $format;
861
862 } elsif ($f eq 'R') {
863 $format = '%H:%M' . $format;
864
865 } elsif ($f eq 'T' || $f eq 'X') {
866 $format = '%H:%M:%S' . $format;
867
868 } elsif ($f eq 'V') {
869 $format = '%m%d%H%M%y' . $format;
870
871 } elsif ($f eq 'Q') {
872 $format = '%Y%m%d' . $format;
873
874 } elsif ($f eq 'q') {
875 $format = '%Y%m%d%H%M%S' . $format;
876
877 } elsif ($f eq 'P') {
878 $format = '%Y%m%d%H:%M:%S' . $format;
879
880 } elsif ($f eq 'O') {
881 $format = '%Y\\-%m\\-%dT%H:%M:%S' . $format;
882
883 } elsif ($f eq 'F') {
884 $format = '%A, %B %e, %Y' . $format;
885
886 } elsif ($f eq 'K') {
887 $format = '%Y-%j' . $format;
888
889 } elsif ($f eq 'J') {
890 $format = '%G-W%W-%w' . $format;
891
892 } elsif ($f eq 'x') {
893 if ($dmb->_config('dateformat') eq 'US') {
894 $format = '%m/%d/%y' . $format;
895 } else {
896 $format = '%d/%m/%y' . $format;
897 }
898
899 } elsif ($f eq 't') {
900 $re .= "\t";
901
902 } elsif ($f eq '%') {
903 $re .= '%';
904
905 } elsif ($f eq '+') {
906 $re .= '\\+';
907 }
908 }
909
910 if ($m != $d) {
911 $err = 'Date not fully specified';
912 } elsif ( ($h || $mn || $s) && (! $h || ! $mn) ) {
913 $err = 'Time not fully specified';
914 } elsif ($ampm && ! $h) {
915 $err = 'Time not fully specified';
916 } elsif ($G != $W) {
917 $err = 'G/W must both be specified';
918 } elsif ($L != $U) {
919 $err = 'L/U must both be specified';
920 }
921
922 if ($err) {
923 $$dmb{'data'}{'format'}{$format} = [$err];
924 return ($err);
925 }
926
927 $$dmb{'data'}{'format'}{$format} = [0, qr/$re/i];
928 return @{ $$dmb{'data'}{'format'}{$format} };
929 }
9301876µs118µs}
# spent 18µs making 1 call to Date::Manip::Date::BEGIN@629
931
932########################################################################
933# DATE FORMATS
934########################################################################
935
936
# spent 1.70s (37.4ms+1.66) within Date::Manip::Date::_parse_check which was called 2430 times, avg 701µs/call: # 2430 times (37.4ms+1.66s) by Date::Manip::Date::parse at line 321, avg 701µs/call
sub _parse_check {
93724301.42ms my($self,$caller,$instring,
938 $y,$m,$d,$h,$mn,$s,$dow,$tzstring,$zone,$abb,$off) = @_;
9392430360µs my $dmt = $$self{'tz'};
9402430401µs my $dmb = $$dmt{'base'};
941
942 # Check day_of_week for validity BEFORE converting 24:00:00 to the
943 # next day
944
9452430487µs if ($dow) {
94624013.39ms24017.26ms my $tmp = $dmb->day_of_week([$y,$m,$d]);
# spent 7.26ms making 2401 calls to Date::Manip::Base::day_of_week, avg 3µs/call
9472401684µs if ($tmp != $dow) {
948 $$self{'err'} = "[$caller] Day of week invalid";
949 return 1;
950 }
951 }
952
953 # Handle 24:00:00 times.
954
9552430252µs if ($h == 24) {
956 ($h,$mn,$s) = (0,0,0);
957 ($y,$m,$d) = @{ $dmb->calc_date_days([$y,$m,$d],1) };
958 }
959
96024303.23ms243028.0ms if (! $dmb->check([$y,$m,$d,$h,$mn,$s])) {
# spent 28.0ms making 2430 calls to Date::Manip::Base::check, avg 12µs/call
961 $$self{'err'} = "[$caller] Invalid date";
962 return 1;
963 }
96424301.53ms my $date = [$y,$m,$d,$h,$mn,$s];
965
966 #
967 # We need to check that the date is valid in a timezone. The
968 # timezone may be referred to with $zone, $abb, or $off, and
969 # unfortunately, $abb MAY be the name of an abbrevation OR a
970 # zone in a few cases.
971 #
972
9732430204µs my $zonename;
9742430661µs my $abbrev = (defined $abb ? lc($abb) : '');
97524301.96ms242488.6ms my $offset = (defined $off ? $dmb->_delta_convert('offset',$off) : '');
# spent 88.6ms making 2424 calls to Date::Manip::Base::_delta_convert, avg 37µs/call
9762430241µs my @tmp;
977
9782430867µs if (defined($zone)) {
979 $zonename = $dmt->_zone($zone);
980 if ($zonename) {
981 @tmp = $self->__parse_check($date,$zonename,$off,$abb);
982 }
983
984 } elsif (defined($abb) || defined($off)) {
985
98624302.29ms24301.33s $zonename = $dmt->__zone($date,$offset,'',$abbrev,'');
# spent 1.33s making 2430 calls to Date::Manip::TZ::__zone, avg 547µs/call
98724302.91ms2430108ms if ($zonename) {
# spent 108ms making 2430 calls to Date::Manip::Date::__parse_check, avg 44µs/call
988 @tmp = $self->__parse_check($date,$zonename,$off,$abb);
989 }
990
9912430622µs if (! @tmp && defined($abb)) {
992 my $tmp = $dmt->_zone($abb);
993 if ($tmp) {
994 $zonename = $tmp;
995 @tmp = $self->__parse_check($date,$zonename,$off,undef);
996 }
997 }
998
999 } else {
1000 $zonename = $dmt->_now('tz');
1001 if ($zonename) {
1002 @tmp = $self->__parse_check($date,$zonename,$off,$abb);
1003 }
1004 }
1005
10062430226µs if (! $zonename) {
1007 if (defined($zone)) {
1008 $$self{'err'} = "[$caller] Unable to determine timezone: $zone";
1009 } else {
1010 $$self{'err'} = "[$caller] Unable to determine timezone";
1011 }
1012 return 1;
1013 }
1014
10152430289µs if (! @tmp) {
1016 $$self{'err'} = "[$caller] Invalid timezone";
1017 return 1;
1018 }
1019
1020 # Store the date
1021
10222430595µs my($a,$o,$isdst) = @tmp;
1023
102424301.84ms2430105ms $self->set('zdate',$zonename,$date,$isdst);
# spent 105ms making 2430 calls to Date::Manip::Date::set, avg 43µs/call
10252430468µs return 1 if ($$self{'err'});
1026
10272430632µs $$self{'data'}{'in'} = $instring;
10282430304µs $$self{'data'}{'zin'} = $zone if (defined($zone));
1029
103024303.54ms return 0;
1031}
1032
1033
# spent 108ms (15.4+92.3) within Date::Manip::Date::__parse_check which was called 2430 times, avg 44µs/call: # 2430 times (15.4ms+92.3ms) by Date::Manip::Date::_parse_check at line 987, avg 44µs/call
sub __parse_check {
10342430843µs my($self,$date,$zonename,$off,$abb) = @_;
10352430515µs my $dmt = $$self{'tz'};
10362430341µs my $dmb = $$dmt{'base'};
1037
103824302.07ms242443.8ms if (defined ($off)) {
# spent 43.8ms making 2424 calls to Date::Manip::Base::split, avg 18µs/call
1039 $off = $dmb->split('offset',$off);
1040 }
1041
10422430600µs foreach my $isdst (0,1) {
104324302.05ms243048.5ms my $per = $dmt->date_period($date,$zonename,1,$isdst);
# spent 48.5ms making 2430 calls to Date::Manip::TZ::date_period, avg 20µs/call
10442430307µs next if (! $per);
10452430383µs my $a = $$per[4];
10462430335µs my $o = $$per[3];
1047
1048 # If $abb is defined, it must match.
10492430324µs next if (defined $abb && lc($a) ne lc($abb));
1050
1051 # If $off is defined, it must match.
10522430472µs if (defined ($off)) {
105324241.21ms next if ($$off[0] != $$o[0] ||
1054 $$off[1] != $$o[1] ||
1055 $$off[2] != $$o[2]);
1056 }
1057
105824304.08ms return ($a,$o,$isdst);
1059 }
1060 return ();
1061}
1062
1063# Set up the regular expressions for ISO 8601 parsing. Returns the
1064# requested regexp. $rx can be:
1065# cdate : regular expression for a complete date
1066# tdate : regular expression for a truncated date
1067# ctime : regular expression for a complete time
1068# ttime : regular expression for a truncated time
1069# date : regular expression for a date only
1070# time : regular expression for a time only
1071# UNDEF : regular expression for a valid date and/or time
1072#
1073# Date matches are:
1074# y m d doy w dow yod c
1075# Time matches are:
1076# h h24 mn s fh fm
1077#
1078
# spent 27.8ms (3.97+23.8) within Date::Manip::Date::_iso8601_rx which was called 2440 times, avg 11µs/call: # 2436 times (3.87ms+23.9ms) by Date::Manip::Date::_parse_datetime_iso8601 at line 1231, avg 11µs/call # once (4µs+-4µs) by Date::Manip::Date::_iso8601_rx at line 1211 # once (34µs+-34µs) by Date::Manip::Date::_iso8601_rx at line 1210 # once (2µs+-2µs) by Date::Manip::Date::_iso8601_rx at line 1209 # once (63µs+-63µs) by Date::Manip::Date::_iso8601_rx at line 1208
sub _iso8601_rx {
10792440352µs my($self,$rx) = @_;
10802440366µs my $dmt = $$self{'tz'};
10812440379µs my $dmb = $$dmt{'base'};
1082
108324404.55ms return $$dmb{'data'}{'rx'}{'iso'}{$rx}
1084 if (exists $$dmb{'data'}{'rx'}{'iso'}{$rx});
1085
108632µs if ($rx eq 'cdate' || $rx eq 'tdate') {
1087
10881200ns my $y4 = '(?<y>\d\d\d\d)';
10891300ns my $y2 = '(?<y>\d\d)';
10901200ns my $m = '(?<m>0[1-9]|1[0-2])';
10911200ns my $d = '(?<d>0[1-9]|[12][0-9]|3[01])';
10921100ns 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])';
10931300ns my $w = '(?<w>0[1-9]|[1-4][0-9]|5[0-3])';
10941100ns my $dow = '(?<dow>[1-7])';
10951100ns my $yod = '(?<yod>\d)';
10961100ns my $cc = '(?<c>\d\d)';
1097
1098113µs my $cdaterx =
1099 "${y4}${m}${d}|" . # CCYYMMDD
1100 "${y4}\\-${m}\\-${d}|" . # CCYY-MM-DD
1101 "\\-${y2}${m}${d}|" . # -YYMMDD
1102 "\\-${y2}\\-${m}\\-${d}|" . # -YY-MM-DD
1103 "\\-?${y2}${m}${d}|" . # YYMMDD
1104 "\\-?${y2}\\-${m}\\-${d}|" . # YY-MM-DD
1105 "\\-\\-${m}\\-?${d}|" . # --MM-DD --MMDD
1106 "\\-\\-\\-${d}|" . # ---DD
1107
1108 "${y4}\\-?${doy}|" . # CCYY-DoY CCYYDoY
1109 "\\-?${y2}\\-?${doy}|" . # YY-DoY -YY-DoY
1110 # YYDoY -YYDoY
1111 "\\-${doy}|" . # -DoY
1112
1113 "${y4}W${w}${dow}|" . # CCYYWwwD
1114 "${y4}\\-W${w}\\-${dow}|" . # CCYY-Www-D
1115 "\\-?${y2}W${w}${dow}|" . # YYWwwD -YYWwwD
1116 "\\-?${y2}\\-W${w}\\-${dow}|" . # YY-Www-D -YY-Www-D
1117
1118 "\\-?${yod}W${w}${dow}|" . # YWwwD -YWwwD
1119 "\\-?${yod}\\-W${w}\\-${dow}|" . # Y-Www-D -Y-Www-D
1120 "\\-W${w}\\-?${dow}|" . # -Www-D -WwwD
1121 "\\-W\\-${dow}|" . # -W-D
1122 "\\-\\-\\-${dow}"; # ---D
11231168µs2156µs $cdaterx = qr/(?:$cdaterx)/i;
# spent 154µs making 1 call to Date::Manip::Date::CORE:regcomp # spent 2µs making 1 call to Date::Manip::Date::CORE:qr
1124
112514µs my $tdaterx =
1126 "${y4}\\-${m}|" . # CCYY-MM
1127 "${y4}|" . # CCYY
1128 "\\-${y2}\\-?${m}|" . # -YY-MM -YYMM
1129 "\\-${y2}|" . # -YY
1130 "\\-\\-${m}|" . # --MM
1131
1132 "${y4}\\-?W${w}|" . # CCYYWww CCYY-Www
1133 "\\-?${y2}\\-?W${w}|" . # YY-Www YYWww
1134 # -YY-Www -YYWww
1135 "\\-?W${w}|" . # -Www Www
1136
1137 "${cc}"; # CC
1138149µs235µs $tdaterx = qr/(?:$tdaterx)/i;
# spent 35µs making 1 call to Date::Manip::Date::CORE:regcomp # spent 600ns making 1 call to Date::Manip::Date::CORE:qr
1139
114013µs $$dmb{'data'}{'rx'}{'iso'}{'cdate'} = $cdaterx;
114111µs $$dmb{'data'}{'rx'}{'iso'}{'tdate'} = $tdaterx;
1142
1143 } elsif ($rx eq 'ctime' || $rx eq 'ttime') {
1144
11451200ns my $hh = '(?<h>[0-1][0-9]|2[0-3])';
11461100ns my $mn = '(?<mn>[0-5][0-9])';
11471200ns my $ss = '(?<s>[0-5][0-9])';
11481100ns my $h24a = '(?<h24>24(?::00){0,2})';
11491100ns my $h24b = '(?<h24>24(?:00){0,2})';
11501100ns my $h = '(?<h>[0-9])';
1151
115210s my $fh = '(?:[\.,](?<fh>\d*))'; # fractional hours (keep)
11531100ns my $fm = '(?:[\.,](?<fm>\d*))'; # fractional seconds (keep)
11541100ns my $fs = '(?:[\.,]\d*)'; # fractional hours (discard)
1155
115612µs115.7ms my $zrx = $dmt->_zrx('zrx');
# spent 15.7ms making 1 call to Date::Manip::TZ::_zrx
1157
115818µs my $ctimerx =
1159 "${hh}${mn}${ss}${fs}?|" . # HHMNSS[,S+]
1160 "${hh}:${mn}:${ss}${fs}?|" . # HH:MN:SS[,S+]
1161 "${hh}:?${mn}${fm}|" . # HH:MN,M+ HHMN,M+
1162 "${hh}${fh}|" . # HH,H+
1163 "\\-${mn}:?${ss}${fs}?|" . # -MN:SS[,S+] -MNSS[,S+]
1164 "\\-${mn}${fm}|" . # -MN,M+
1165 "\\-\\-${ss}${fs}?|" . # --SS[,S+]
1166 "${hh}:?${mn}|" . # HH:MN HHMN
1167 "${h24a}|" . # 24:00:00 24:00 24
1168 "${h24b}|" . # 240000 2400
1169 "${h}:${mn}:${ss}${fs}?|" . # H:MN:SS[,S+]
1170 "${h}:${mn}${fm}"; # H:MN,M+
117112.76ms22.75ms $ctimerx = qr/(?:$ctimerx)(?:\s*$zrx)?/;
# spent 2.74ms making 1 call to Date::Manip::Date::CORE:regcomp # spent 1µs making 1 call to Date::Manip::Date::CORE:qr
1172
117312µs my $ttimerx =
1174 "${hh}|" . # HH
1175 "\\-${mn}"; # -MN
1176115µs212µs $ttimerx = qr/(?:$ttimerx)/;
# spent 11µs making 1 call to Date::Manip::Date::CORE:regcomp # spent 400ns making 1 call to Date::Manip::Date::CORE:qr
1177
117811µs $$dmb{'data'}{'rx'}{'iso'}{'ctime'} = $ctimerx;
117912µs $$dmb{'data'}{'rx'}{'iso'}{'ttime'} = $ttimerx;
1180
1181 } elsif ($rx eq 'date') {
1182
1183 my $cdaterx = $self->_iso8601_rx('cdate');
1184 my $tdaterx = $self->_iso8601_rx('tdate');
1185 $$dmb{'data'}{'rx'}{'iso'}{'date'} = qr/(?:$cdaterx|$tdaterx)/;
1186
1187 } elsif ($rx eq 'time') {
1188
1189 my $ctimerx = $self->_iso8601_rx('ctime');
1190 my $ttimerx = $self->_iso8601_rx('ttime');
1191 $$dmb{'data'}{'rx'}{'iso'}{'time'} = qr/(?:$ctimerx|$ttimerx)/;
1192
1193 } elsif ($rx eq 'fulldate') {
1194
1195 # A parseable string contains:
1196 # a complete date and complete time
1197 # a complete date and truncated time
1198 # a truncated date
1199 # a complete time
1200 # a truncated time
1201
1202 # If the string contains both a time and date, they may be adjacent
1203 # or separated by:
1204 # whitespace
1205 # T (which must be followed by a number)
1206 # a dash
1207
1208113µs10s my $cdaterx = $self->_iso8601_rx('cdate');
# spent 254µs making 1 call to Date::Manip::Date::_iso8601_rx, recursion: max depth 1, sum of overlapping time 254µs
120911µ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
12101900ns10s my $ctimerx = $self->_iso8601_rx('ctime');
# spent 18.5ms making 1 call to Date::Manip::Date::_iso8601_rx, recursion: max depth 1, sum of overlapping time 18.5ms
121112µ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
1212
121312µs1700ns my $sep = qr/(?:T|\-|\s*)/i;
# spent 700ns making 1 call to Date::Manip::Date::CORE:qr
1214
121515.13ms25.10ms my $daterx = qr/^\s*(?: $cdaterx(?:$sep(?:$ctimerx|$ttimerx))? |
# spent 5.10ms making 1 call to Date::Manip::Date::CORE:regcomp # spent 1µs making 1 call to Date::Manip::Date::CORE:qr
1216 $tdaterx |
1217 $ctimerx |
1218 $ttimerx
1219 )\s*$/x;
1220
122112µs $$dmb{'data'}{'rx'}{'iso'}{'fulldate'} = $daterx;
1222 }
1223
122439µs return $$dmb{'data'}{'rx'}{'iso'}{$rx};
1225}
1226
1227
# spent 52.8ms (11.9+41.0) within Date::Manip::Date::_parse_datetime_iso8601 which was called 2436 times, avg 22µs/call: # 2436 times (11.9ms+41.0ms) by Date::Manip::Date::parse at line 142, avg 22µs/call
sub _parse_datetime_iso8601 {
12282436514µs my($self,$string,$noupdate) = @_;
12292436393µs my $dmt = $$self{'tz'};
12302436338µs my $dmb = $$dmt{'base'};
123124361.47ms243627.8ms my $daterx = $self->_iso8601_rx('fulldate');
# spent 27.8ms making 2436 calls to Date::Manip::Date::_iso8601_rx, avg 11µs/call
1232
12332436287µs my($y,$m,$d,$h,$mn,$s,$tzstring,$zone,$abb,$off);
1234 my($doy,$dow,$yod,$c,$w,$fh,$fm,$h24);
1235
1236243618.0ms487213.2ms if ($string =~ $daterx) {
# spent 8.04ms making 2436 calls to Date::Manip::Date::CORE:match, avg 3µs/call # spent 5.16ms making 2436 calls to Date::Manip::Date::CORE:regcomp, avg 2µs/call
1237 ($y,$m,$d,$h,$mn,$s,$doy,$dow,$yod,$c,$w,$fh,$fm,$h24,
1238 $tzstring,$zone,$abb,$off) =
1239 @+{qw(y m d h mn s doy dow yod c w fh fm h24 tzstring zone abb off)};
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
1250 ($h,$mn,$s) = $self->_time($h,$mn,$s,$fh,$fm,$h24,undef,$noupdate);
1251 } else {
125224363.69ms return (0);
1253 }
1254
1255 return (1,$y,$m,$d,$h,$mn,$s,$tzstring,$zone,$abb,$off);
1256}
1257
1258sub _parse_date_iso8601 {
1259 my($self,$string,$noupdate) = @_;
1260 my $dmt = $$self{'tz'};
1261 my $dmb = $$dmt{'base'};
1262 my $daterx = $self->_iso8601_rx('date');
1263
1264 my($y,$m,$d);
1265 my($doy,$dow,$yod,$c,$w);
1266
1267 if ($string =~ /^$daterx$/) {
1268 ($y,$m,$d,$doy,$dow,$yod,$c,$w) =
1269 @+{qw(y m d doy dow yod c w)};
1270
1271 if (defined $w || defined $dow) {
1272 ($y,$m,$d) = $self->_def_date_dow($y,$w,$dow,$noupdate);
1273 } elsif (defined $doy) {
1274 ($y,$m,$d) = $self->_def_date_doy($y,$doy,$noupdate);
1275 } else {
1276 $y = $c . '00' if (defined $c);
1277 ($y,$m,$d) = $self->_def_date($y,$m,$d,$noupdate);
1278 }
1279 } else {
1280 return (0);
1281 }
1282
1283 return (1,$y,$m,$d);
1284}
1285
1286# Handle all of the time fields.
1287#
1288298µs212µs
# spent 10µs (8+2) within Date::Manip::Date::BEGIN@1288 which was called: # once (8µs+2µs) by main::RUNTIME at line 1288
no integer;
# spent 10µs making 1 call to Date::Manip::Date::BEGIN@1288 # spent 2µs making 1 call to integer::unimport
1289
# spent 11.2ms (7.55+3.65) within Date::Manip::Date::_time which was called 2436 times, avg 5µs/call: # 2436 times (7.55ms+3.65ms) by Date::Manip::Date::_parse_time at line 1678, avg 5µs/call
sub _time {
129024361.03ms my($self,$h,$mn,$s,$fh,$fm,$h24,$ampm,$noupdate) = @_;
1291
12922436293µs if (defined($ampm) && $ampm) {
1293 my $dmt = $$self{'tz'};
1294 my $dmb = $$dmt{'base'};
1295 if ($$dmb{'data'}{'wordmatch'}{'ampm'}{lc($ampm)} == 2) {
1296 # pm times
1297 $h+=12 unless ($h==12);
1298 } else {
1299 # am times
1300 $h=0 if ($h==12);
1301 }
1302 }
1303
13042436639µs if (defined $h24) {
1305 return(24,0,0);
1306 } elsif (defined $fh && $fh ne "") {
1307 $fh = "0.$fh";
1308 $s = int($fh * 3600);
1309 $mn = int($s/60);
1310 $s -= $mn*60;
1311 } elsif (defined $fm && $fm ne "") {
1312 $fm = "0.$fm";
1313 $s = int($fm*60);
1314 }
131524362.22ms24363.65ms ($h,$mn,$s) = $self->_def_time($h,$mn,$s,$noupdate);
# spent 3.65ms making 2436 calls to Date::Manip::Date::_def_time, avg 1µs/call
131624362.93ms return($h,$mn,$s);
1317}
131823.44ms28µs
# spent 7µs (5+2) within Date::Manip::Date::BEGIN@1318 which was called: # once (5µs+2µs) by main::RUNTIME at line 1318
use integer;
# spent 7µs making 1 call to Date::Manip::Date::BEGIN@1318 # spent 2µs making 1 call to integer::import
1319
1320# Set up the regular expressions for other date and time formats. Returns the
1321# requested regexp.
1322#
1323
# spent 10.8ms (349µs+10.4) within Date::Manip::Date::_other_rx which was called 7 times, avg 1.54ms/call: # once (50µs+4.88ms) by Date::Manip::Date::_parse_datetime_other at line 1897 # once (56µs+2.51ms) by Date::Manip::Date::_parse_time at line 1658 # once (122µs+2.09ms) by Date::Manip::Date::_parse_date_other at line 1984 # once (84µs+880µs) by Date::Manip::Date::_parse_date_common at line 1723 # once (17µs+49µs) by Date::Manip::Date::_parse_dow at line 1764 # once (11µs+22µs) by Date::Manip::Date::_parse_date_common at line 1708 # once (9µs+10µs) by Date::Manip::Date::_parse_date at line 427
sub _other_rx {
132472µs my($self,$rx) = @_;
132572µs my $dmt = $$self{'tz'};
132672µs my $dmb = $$dmt{'base'};
132771µs $rx = '_' if (! defined $rx);
1328
132979µs if ($rx eq 'time') {
1330
13311300ns my $h24 = '(?<h>2[0-3]|1[0-9]|0?[0-9])'; # 0-23 00-23
13321400ns my $h12 = '(?<h>1[0-2]|0?[1-9])'; # 1-12 01-12
13331300ns my $mn = '(?<mn>[0-5][0-9])'; # 00-59
13341300ns my $ss = '(?<s>[0-5][0-9])'; # 00-59
1335
1336 # how to express fractions
1337
13381200ns my($f1,$f2,$sepfr);
133912µs if (exists $$dmb{'data'}{'rx'}{'sepfr'} &&
1340 $$dmb{'data'}{'rx'}{'sepfr'}) {
1341 $sepfr = $$dmb{'data'}{'rx'}{'sepfr'};
1342 } else {
13431600ns $sepfr = '';
1344 }
1345
13461500ns if ($sepfr) {
1347 $f1 = "(?:[.,]|$sepfr)";
1348 $f2 = "(?:[.,:]|$sepfr)";
1349 } else {
13501400ns $f1 = "[.,]";
13511300ns $f2 = "[.,:]";
1352 }
13531700ns my $fh = "(?:$f1(?<fh>\\d*))"; # fractional hours (keep)
13541600ns my $fm = "(?:$f1(?<fm>\\d*))"; # fractional minutes (keep)
13551400ns my $fs = "(?:$f2\\d*)"; # fractional seconds
1356
1357 # AM/PM
1358
13591200ns my($ampm);
136012µs if (exists $$dmb{'data'}{'rx'}{'ampm'}) {
1361 $ampm = "(?:\\s*(?<ampm>$$dmb{data}{rx}{ampm}[0]))";
1362 }
1363
1364 # H:MN and MN:S separators
1365
13661900ns my @hm = ("\Q:\E");
13671300ns my @ms = ("\Q:\E");
136812µs16µs if ($dmb->_config('periodtimesep')) {
# spent 6µs making 1 call to Date::Manip::TZ_Base::_config
1369 push(@hm,"\Q.\E");
1370 push(@ms,"\Q.\E");
1371 }
137212µs if (exists $$dmb{'data'}{'rx'}{'sephm'} &&
1373 defined $$dmb{'data'}{'rx'}{'sephm'} &&
1374 exists $$dmb{'data'}{'rx'}{'sepms'} &&
1375 defined $$dmb{'data'}{'rx'}{'sepms'}) {
1376 push(@hm,@{ $$dmb{'data'}{'rx'}{'sephm'} });
1377 push(@ms,@{ $$dmb{'data'}{'rx'}{'sepms'} });
1378 }
1379
1380 # How to express the time
1381 # matches = (H, FH, MN, FMN, S, AM, TZSTRING, ZONE, ABB, OFF, ABB)
1382
13831500ns my $timerx;
1384
138512µs for (my $i=0; $i<=$#hm; $i++) {
13861300ns my $hm = $hm[$i];
13871200ns my $ms = $ms[$i];
138812µs $timerx .= "${h12}$hm${mn}$ms${ss}${fs}?${ampm}?|" # H12:MN:SS[,S+] [AM]
1389 if ($ampm);
139012µs $timerx .= "${h24}$hm${mn}$ms${ss}${fs}?|" . # H24:MN:SS[,S+]
1391 "(?<h>24)$hm(?<mn>00)$ms(?<s>00)|"; # 24:00:00
1392 }
139311µs for (my $i=0; $i<=$#hm; $i++) {
13941300ns my $hm = $hm[$i];
13951300ns my $ms = $ms[$i];
13961900ns $timerx .= "${h12}$hm${mn}${fm}${ampm}?|" # H12:MN,M+ [AM]
1397 if ($ampm);
139812µs $timerx .= "${h24}$hm${mn}${fm}|"; # H24:MN,M+
1399 }
140011µs for (my $i=0; $i<=$#hm; $i++) {
14011400ns my $hm = $hm[$i];
14021200ns my $ms = $ms[$i];
140311µs $timerx .= "${h12}$hm${mn}${ampm}?|" # H12:MN [AM]
1404 if ($ampm);
140511µs $timerx .= "${h24}$hm${mn}|" . # H24:MN
1406 "(?<h>24)$hm(?<mn>00)|"; # 24:00
1407 }
1408
140911µs $timerx .= "${h12}${fh}${ampm}|" # H12,H+ AM
1410 if ($ampm);
1411
14121500ns $timerx .= "${h12}${ampm}|" if ($ampm); # H12 AM
1413
14141300ns $timerx .= "${h24}${fh}|"; # H24,H+
1415
14161500ns chop($timerx); # remove trailing pipe
1417
14181900ns11µs my $zrx = $dmt->_zrx('zrx');
# spent 1µs making 1 call to Date::Manip::TZ::_zrx
14191900ns my $at = $$dmb{'data'}{'rx'}{'at'};
1420112µs29µs my $atrx = qr/(?:^|\s+)(?:$at)\s+/;
# spent 8µs making 1 call to Date::Manip::Date::CORE:regcomp # spent 600ns making 1 call to Date::Manip::Date::CORE:qr
142112.50ms22.49ms $timerx = qr/(?:$atrx|^|\s+)(?:$timerx)(?:\s*$zrx)?(?:\s+|$)/i;
# spent 2.49ms making 1 call to Date::Manip::Date::CORE:regcomp # spent 800ns making 1 call to Date::Manip::Date::CORE:qr
1422
142313µs $$dmb{'data'}{'rx'}{'other'}{$rx} = $timerx;
1424
1425 } elsif ($rx eq 'common_1') {
1426
1427 # These are of the format M/D/Y
1428
1429 # Do NOT replace <m> and <d> with a regular expression to
1430 # match 1-12 since the DateFormat config may reverse the two.
14311300ns my $y4 = '(?<y>\d\d\d\d)';
14321400ns my $y2 = '(?<y>\d\d)';
14331200ns my $m = '(?<m>\d\d?)';
14341300ns my $d = '(?<d>\d\d?)';
14351200ns my $sep = '(?<sep>[\s\.\/\-])';
1436
143712µs my $daterx =
1438 "${m}${sep}${d}\\k<sep>$y4|" . # M/D/YYYY
1439 "${m}${sep}${d}\\k<sep>$y2|" . # M/D/YY
1440 "${m}${sep}${d}"; # M/D
1441
1442125µs222µs $daterx = qr/^\s*(?:$daterx)\s*$/;
# spent 21µs making 1 call to Date::Manip::Date::CORE:regcomp # spent 700ns making 1 call to Date::Manip::Date::CORE:qr
144311µs $$dmb{'data'}{'rx'}{'other'}{$rx} = $daterx;
1444
1445 } elsif ($rx eq 'common_2') {
1446
14471900ns my $abb = $$dmb{'data'}{'rx'}{'month_abb'}[0];
14481900ns my $nam = $$dmb{'data'}{'rx'}{'month_name'}[0];
1449
14501300ns my $y4 = '(?<y>\d\d\d\d)';
14511200ns my $y2 = '(?<y>\d\d)';
14521200ns my $m = '(?<m>\d\d?)';
14531300ns my $d = '(?<d>\d\d?)';
14541200ns my $dd = '(?<d>\d\d)';
145512µs my $mmm = "(?:(?<mmm>$abb)|(?<month>$nam))";
14561100ns my $sep = '(?<sep>[\s\.\/\-])';
1457
1458124µs my $daterx =
1459 "${y4}${sep}${m}\\k<sep>$d|" . # YYYY/M/D
1460
1461 "${mmm}\\s*${dd}\\s*${y4}|" . # mmmDDYYYY
1462 "${mmm}\\s*${dd}\\s*${y2}|" . # mmmDDYY
1463 "${mmm}\\s*${d}|" . # mmmD
1464 "${d}\\s*${mmm}\\s*${y4}|" . # DmmmYYYY
1465 "${d}\\s*${mmm}\\s*${y2}|" . # DmmmYY
1466 "${d}\\s*${mmm}|" . # Dmmm
1467 "${y4}\\s*${mmm}\\s*${d}|" . # YYYYmmmD
1468
1469 "${mmm}${sep}${d}\\k<sep>${y4}|" . # mmm/D/YYYY
1470 "${mmm}${sep}${d}\\k<sep>${y2}|" . # mmm/D/YY
1471 "${mmm}${sep}${d}|" . # mmm/D
1472 "${d}${sep}${mmm}\\k<sep>${y4}|" . # D/mmm/YYYY
1473 "${d}${sep}${mmm}\\k<sep>${y2}|" . # D/mmm/YY
1474 "${d}${sep}${mmm}|" . # D/mmm
1475 "${y4}${sep}${mmm}\\k<sep>${d}|" . # YYYY/mmm/D
1476
1477 "${mmm}${sep}?${d}\\s+${y2}|" . # mmmD YY mmm/D YY
1478 "${mmm}${sep}?${d}\\s+${y4}|" . # mmmD YYYY mmm/D YYYY
1479 "${d}${sep}?${mmm}\\s+${y2}|" . # Dmmm YY D/mmm YY
1480 "${d}${sep}?${mmm}\\s+${y4}|" . # Dmmm YYYY D/mmm YYYY
1481
1482 "${y2}\\s+${mmm}${sep}?${d}|" . # YY mmmD YY mmm/D
1483 "${y4}\\s+${mmm}${sep}?${d}|" . # YYYY mmmD YYYY mmm/D
1484 "${y2}\\s+${d}${sep}?${mmm}|" . # YY Dmmm YY D/mmm
1485 "${y4}\\s+${d}${sep}?${mmm}|" . # YYYY Dmmm YYYY D/mmm
1486
1487 "${y4}:${m}:${d}"; # YYYY:MM:DD
1488
14891931µs2880µs $daterx = qr/^\s*(?:$daterx)\s*$/i;
# spent 879µs making 1 call to Date::Manip::Date::CORE:regcomp # spent 1µs making 1 call to Date::Manip::Date::CORE:qr
149012µs $$dmb{'data'}{'rx'}{'other'}{$rx} = $daterx;
1491
1492 } elsif ($rx eq 'dow') {
1493
149412µs my $day_abb = $$dmb{'data'}{'rx'}{'day_abb'}[0];
149512µs my $day_name = $$dmb{'data'}{'rx'}{'day_name'}[0];
1496
149711µs my $on = $$dmb{'data'}{'rx'}{'on'};
1498116µs213µs my $onrx = qr/(?:^|\s+)(?:$on)\s+/;
# spent 8µs making 1 call to Date::Manip::Date::CORE:regcomp # spent 5µs making 1 call to Date::Manip::Date::CORE:qr
1499141µs236µs my $dowrx = qr/(?:$onrx|^|\s+)(?<dow>$day_name|$day_abb)($|\s+)/i;
# spent 35µs making 1 call to Date::Manip::Date::CORE:regcomp # spent 700ns making 1 call to Date::Manip::Date::CORE:qr
1500
150112µs $$dmb{'data'}{'rx'}{'other'}{$rx} = $dowrx;
1502
1503 } elsif ($rx eq 'ignore') {
1504
15051800ns my $of = $$dmb{'data'}{'rx'}{'of'};
1506
1507115µs210µs my $ignrx = qr/(?:^|\s+)(?<of>$of)(\s+|$)/;
# spent 9µs making 1 call to Date::Manip::Date::CORE:regcomp # spent 600ns making 1 call to Date::Manip::Date::CORE:qr
150811µs $$dmb{'data'}{'rx'}{'other'}{$rx} = $ignrx;
1509
1510 } elsif ($rx eq 'miscdatetime') {
1511
151211µs my $special = $$dmb{'data'}{'rx'}{'offset_time'}[0];
1513
151411µs $special = "(?<special>$special)";
15151600ns my $secs = "(?<epoch>[-+]?\\d+)";
15161800ns my $abb = $$dmb{'data'}{'rx'}{'month_abb'}[0];
15171600ns my $mmm = "(?<mmm>$abb)";
15181100ns my $y4 = '(?<y>\d\d\d\d)';
15191100ns my $dd = '(?<d>\d\d)';
15201100ns my $h24 = '(?<h>2[0-3]|[01][0-9])'; # 00-23
15211100ns my $mn = '(?<mn>[0-5][0-9])'; # 00-59
15221100ns my $ss = '(?<s>[0-5][0-9])'; # 00-59
152312µs12µs my $offrx = $dmt->_zrx('offrx');
# spent 2µs making 1 call to Date::Manip::TZ::_zrx
15241700ns1700ns my $zrx = $dmt->_zrx('zrx');
# spent 700ns making 1 call to Date::Manip::TZ::_zrx
1525
1526119µs my $daterx =
1527 "${special}|" . # now
1528 "${special}\\s+${zrx}|" . # now EDT
1529
1530 "epoch\\s+$secs|" . # epoch SECS
1531 "epoch\\s+$secs\\s+${zrx}|" . # epoch SECS EDT
1532
1533 "${dd}\\/${mmm}\\/${y4}:${h24}:${mn}:${ss}\\s*${offrx}";
1534 # Common log format: 10/Oct/2000:13:55:36 -0700
1535
153614.89ms24.88ms $daterx = qr/^\s*(?:$daterx)\s*$/i;
# spent 4.87ms making 1 call to Date::Manip::Date::CORE:regcomp # spent 900ns making 1 call to Date::Manip::Date::CORE:qr
153714µs $$dmb{'data'}{'rx'}{'other'}{$rx} = $daterx;
1538
1539 } elsif ($rx eq 'misc') {
1540
154112µs my $abb = $$dmb{'data'}{'rx'}{'month_abb'}[0];
154211µs my $nam = $$dmb{'data'}{'rx'}{'month_name'}[0];
15431900ns my $next = $$dmb{'data'}{'rx'}{'nextprev'}[0];
15441800ns my $last = $$dmb{'data'}{'rx'}{'last'};
15451900ns my $yf = $$dmb{data}{rx}{fields}[1];
15461700ns my $mf = $$dmb{data}{rx}{fields}[2];
154712µs my $wf = $$dmb{data}{rx}{fields}[3];
15481500ns my $df = $$dmb{data}{rx}{fields}[4];
154911µs my $nth = $$dmb{'data'}{'rx'}{'nth'}[0];
155011µs my $nth_wom = $$dmb{'data'}{'rx'}{'nth_wom'}[0];
155111µs my $special = $$dmb{'data'}{'rx'}{'offset_date'}[0];
1552
15531300ns my $y = '(?:(?<y>\d\d\d\d)|(?<y>\d\d))';
155412µs my $mmm = "(?:(?<mmm>$abb)|(?<month>$nam))";
15551800ns $next = "(?<next>$next)";
15561800ns $last = "(?<last>$last)";
15571500ns $yf = "(?<field_y>$yf)";
15581600ns $mf = "(?<field_m>$mf)";
15591300ns $wf = "(?<field_w>$wf)";
15601300ns $df = "(?<field_d>$df)";
15611900ns my $fld = "(?:$yf|$mf|$wf)";
156212µs $nth = "(?<nth>$nth)";
15631900ns $nth_wom = "(?<nth>$nth_wom)";
156411µs $special = "(?<special>$special)";
1565
1566126µs my $daterx =
1567 "${mmm}\\s+${nth}\\s*$y?|" . # Dec 1st [1970]
1568 "${nth}\\s+${mmm}\\s*$y?|" . # 1st Dec [1970]
1569 "$y\\s+${mmm}\\s+${nth}|" . # 1970 Dec 1st
1570 "$y\\s+${nth}\\s+${mmm}|" . # 1970 1st Dec
1571
1572 "${next}\\s+${fld}|" . # next year, next month, next week
1573 "${next}|" . # next friday
1574
1575 "${last}\\s+${mmm}\\s*$y?|" . # last friday in october 95
1576 "${last}\\s+${df}\\s+${mmm}\\s*$y?|" .
1577 # last day in october 95
1578 "${last}\\s*$y?|" . # last friday in 95
1579
1580 "${nth_wom}\\s+${mmm}\\s*$y?|" .
1581 # nth DoW in MMM [YYYY]
1582 "${nth}\\s*$y?|" . # nth DoW in [YYYY]
1583
1584 "${nth}\\s+$df\\s+${mmm}\\s*$y?|" .
1585 # nth day in MMM [YYYY]
1586
1587 "${nth}\\s+${wf}\\s*$y?|" . # DoW Nth week [YYYY]
1588 "${wf}\\s+(?<n>\\d+)\\s*$y?|" . # DoW week N [YYYY]
1589
1590 "${special}|" . # today, tomorrow
1591 "${special}\\s+${wf}|" . # today week
1592 # British: same as 1 week from today
1593
1594 "${nth}|" . # nth
1595
1596 "${wf}"; # monday week
1597 # British: same as 'in 1 week on monday'
1598
159912.15ms22.09ms $daterx = qr/^\s*(?:$daterx)\s*$/i;
# spent 2.09ms making 1 call to Date::Manip::Date::CORE:regcomp # spent 2µs making 1 call to Date::Manip::Date::CORE:qr
160012µs $$dmb{'data'}{'rx'}{'other'}{$rx} = $daterx;
1601
1602 }
1603
1604724µs return $$dmb{'data'}{'rx'}{'other'}{$rx};
1605}
1606
1607
# spent 155ms (74.1+80.9) within Date::Manip::Date::_parse_time which was called 2436 times, avg 64µs/call: # 2436 times (74.1ms+80.9ms) by Date::Manip::Date::parse at line 170, avg 64µs/call
sub _parse_time {
16082436962µs my($self,$caller,$string,$noupdate,%opts) = @_;
16092436355µs my $dmt = $$self{'tz'};
16102436333µs my $dmb = $$dmt{'base'};
1611
16122436265µs my($timerx,$h,$mn,$s,$fh,$fm,$h24,$ampm,$tzstring,$zone,$abb,$off);
16132436242µs my $got_time = 0;
1614
1615 # Check for ISO 8601 time
1616 #
1617 # This is only called via. parse_time (parse_date uses a regexp
1618 # that matches a full ISO 8601 date/time instead of parsing them
1619 # separately. Since some ISO 8601 times are a substring of non-ISO
1620 # 8601 times (i.e. 12:30 is a substring of '12:30 PM'), we need to
1621 # match entire strings here.
1622
16232436353µs if ($caller eq 'parse_time') {
1624 $timerx = (exists $$dmb{'data'}{'rx'}{'iso'}{'time'} ?
1625 $$dmb{'data'}{'rx'}{'iso'}{'time'} :
1626 $self->_iso8601_rx('time'));
1627
1628 if (! exists $opts{'noiso8601'}) {
1629 if ($string =~ s/^\s*$timerx\s*$//) {
1630 ($h,$fh,$mn,$fm,$s,$ampm,$tzstring,$zone,$abb,$off) =
1631 @+{qw(h fh mn fm s ampm tzstring zone abb off)};
1632
1633 ($h,$mn,$s) = $self->_def_time($h,$mn,$s,$noupdate);
1634 $h24 = 1 if ($h == 24 && $mn == 0 && $s == 0);
1635 $string =~ s/\s*$//;
1636 $got_time = 1;
1637 }
1638 }
1639 }
1640
1641 # Make time substitutions (i.e. noon => 12:00:00)
1642
16432436973µs if (! $got_time &&
1644 ! exists $opts{'noother'}) {
164524361.32ms my @rx = @{ $$dmb{'data'}{'rx'}{'times'} };
16462436512µs shift(@rx);
164724361.10ms foreach my $rx (@rx) {
1648487223.3ms974413.9ms if ($string =~ $rx) {
# spent 12.1ms making 4872 calls to Date::Manip::Date::CORE:match, avg 2µs/call # spent 1.86ms making 4872 calls to Date::Manip::Date::CORE:regcomp, avg 383ns/call
1649 my $repl = $$dmb{'data'}{'wordmatch'}{'times'}{lc($1)};
1650 $string =~ s/$rx/$repl/g;
1651 }
1652 }
1653 }
1654
1655 # Check to see if there is a time in the string
1656
16572436653µs if (! $got_time) {
165824361.80ms12.56ms $timerx = (exists $$dmb{'data'}{'rx'}{'other'}{'time'} ?
# spent 2.56ms making 1 call to Date::Manip::Date::_other_rx
1659 $$dmb{'data'}{'rx'}{'other'}{'time'} :
1660 $self->_other_rx('time'));
1661
1662243640.2ms487235.5ms if ($string =~ s/$timerx/ /) {
# spent 34.0ms making 2436 calls to Date::Manip::Date::CORE:subst, avg 14µs/call # spent 1.49ms making 2436 calls to Date::Manip::Date::CORE:regcomp, avg 611ns/call
1663243642.6ms243607.86ms ($h,$fh,$mn,$fm,$s,$ampm,$tzstring,$zone,$abb,$off) =
# spent 7.86ms making 24360 calls to Tie::Hash::NamedCapture::FETCH, avg 323ns/call
1664 @+{qw(h fh mn fm s ampm tzstring zone abb off)};
1665
166624363.09ms24365.87ms ($h,$mn,$s) = $self->_def_time($h,$mn,$s,$noupdate);
# spent 5.87ms making 2436 calls to Date::Manip::Date::_def_time, avg 2µs/call
16672436593µs $h24 = 1 if ($h == 24 && $mn == 0 && $s == 0);
166824366.43ms24364.03ms $string =~ s/\s*$//;
# spent 4.03ms making 2436 calls to Date::Manip::Date::CORE:subst, avg 2µs/call
16692436515µs $got_time = 1;
1670 }
1671 }
1672
1673 # If we called this from $date->parse()
1674 # returns the string and a list of time components
1675
16762436476µs if ($caller eq 'parse') {
16772436250µs if ($got_time) {
167824362.53ms243611.2ms ($h,$mn,$s) = $self->_time($h,$mn,$s,$fh,$fm,$h24,$ampm,$noupdate);
# spent 11.2ms making 2436 calls to Date::Manip::Date::_time, avg 5µs/call
167924364.92ms return ($got_time,$string,$h,$mn,$s,$tzstring,$zone,$abb,$off);
1680 } else {
1681 return (0);
1682 }
1683 }
1684
1685 # If we called this from $date->parse_time()
1686
1687 if (! $got_time || $string) {
1688 $$self{'err'} = "[$caller] Invalid time string";
1689 return ();
1690 }
1691
1692 ($h,$mn,$s) = $self->_time($h,$mn,$s,$fh,$fm,$h24,$ampm,$noupdate);
1693 return ($h,$mn,$s,$tzstring,$zone,$abb,$off);
1694}
1695
1696# Parse common dates
1697
# spent 90.7ms (41.3+49.4) within Date::Manip::Date::_parse_date_common which was called 2442 times, avg 37µs/call: # 2442 times (41.3ms+49.4ms) by Date::Manip::Date::_parse_date at line 463, avg 37µs/call
sub _parse_date_common {
16982442439µs my($self,$string,$noupdate) = @_;
16992442388µs my $dmt = $$self{'tz'};
17002442291µs my $dmb = $$dmt{'base'};
1701
1702 # Since we want whitespace to be used as a separator, turn all
1703 # whitespace into single spaces. This is necessary since the
1704 # regexps do backreferences to make sure that separators are
1705 # not mixed.
170624425.57ms24423.23ms $string =~ s/\s+/ /g;
# spent 3.23ms making 2442 calls to Date::Manip::Date::CORE:subst, avg 1µs/call
1707
170824421.42ms133µs my $daterx = (exists $$dmb{'data'}{'rx'}{'other'}{'common_1'} ?
# spent 33µs making 1 call to Date::Manip::Date::_other_rx
1709 $$dmb{'data'}{'rx'}{'other'}{'common_1'} :
1710 $self->_other_rx('common_1'));
1711
171224429.99ms48845.51ms if ($string =~ $daterx) {
# spent 3.95ms making 2442 calls to Date::Manip::Date::CORE:match, avg 2µs/call # spent 1.56ms making 2442 calls to Date::Manip::Date::CORE:regcomp, avg 638ns/call
1713 my($y,$m,$d) = @+{qw(y m d)};
1714
1715 if ($dmb->_config('dateformat') ne 'US') {
1716 ($m,$d) = ($d,$m);
1717 }
1718
1719 ($y,$m,$d) = $self->_def_date($y,$m,$d,$noupdate);
1720 return($y,$m,$d);
1721 }
1722
172324421.49ms1964µs $daterx = (exists $$dmb{'data'}{'rx'}{'other'}{'common_2'} ?
# spent 964µs making 1 call to Date::Manip::Date::_other_rx
1724 $$dmb{'data'}{'rx'}{'other'}{'common_2'} :
1725 $self->_other_rx('common_2'));
1726
1727244211.8ms48847.49ms if ($string =~ $daterx) {
# spent 4.12ms making 2442 calls to Date::Manip::Date::CORE:match, avg 2µs/call # spent 3.37ms making 2442 calls to Date::Manip::Date::CORE:regcomp, avg 1µs/call
1728243020.9ms121503.54ms my($y,$m,$d,$mmm,$month) = @+{qw(y m d mmm month)};
# spent 3.54ms making 12150 calls to Tie::Hash::NamedCapture::FETCH, avg 291ns/call
1729
173024301.67ms if ($mmm) {
1731 $m = $$dmb{'data'}{'wordmatch'}{'month_abb'}{lc($mmm)};
1732 } elsif ($month) {
1733 $m = $$dmb{'data'}{'wordmatch'}{'month_name'}{lc($month)};
1734 }
1735
173624303.21ms243028.6ms ($y,$m,$d) = $self->_def_date($y,$m,$d,$noupdate);
# spent 28.6ms making 2430 calls to Date::Manip::Date::_def_date, avg 12µs/call
173724304.10ms return($y,$m,$d);
1738 }
1739
17401215µs return ();
1741}
1742
1743sub _parse_tz {
1744 my($self,$string,$noupdate) = @_;
1745 my $dmt = $$self{'tz'};
1746 my($tzstring,$zone,$abb,$off);
1747
1748 my $rx = $dmt->_zrx('zrx');
1749 if ($string =~ s/(?:^|\s)$rx(?:$|\s)/ /) {
1750 ($tzstring,$zone,$abb,$off) = @+{qw(tzstring zone abb off)};
1751 return($string,$tzstring,$zone,$abb,$off);
1752 }
1753 return($string);
1754}
1755
1756
# spent 33.8ms (23.4+10.4) within Date::Manip::Date::_parse_dow which was called 2436 times, avg 14µs/call: # 2436 times (23.4ms+10.4ms) by Date::Manip::Date::parse at line 184, avg 14µs/call
sub _parse_dow {
17572436425µs my($self,$string,$noupdate) = @_;
17582436346µs my $dmt = $$self{'tz'};
17592436290µs my $dmb = $$dmt{'base'};
17602436199µs my($y,$m,$d,$dow);
1761
1762 # Remove the day of week
1763
176424361.55ms166µs my $rx = (exists $$dmb{'data'}{'rx'}{'other'}{'dow'} ?
# spent 66µs making 1 call to Date::Manip::Date::_other_rx
1765 $$dmb{'data'}{'rx'}{'other'}{'dow'} :
1766 $self->_other_rx('dow'));
176724369.79ms48724.98ms if ($string =~ s/$rx/ /) {
# spent 3.61ms making 2436 calls to Date::Manip::Date::CORE:subst, avg 1µs/call # spent 1.36ms making 2436 calls to Date::Manip::Date::CORE:regcomp, avg 560ns/call
176824015.65ms2401991µs $dow = $+{'dow'};
# spent 991µs making 2401 calls to Tie::Hash::NamedCapture::FETCH, avg 413ns/call
17692401741µs $dow = lc($dow);
1770
177124012.15ms $dow = $$dmb{'data'}{'wordmatch'}{'day_abb'}{$dow}
1772 if (exists $$dmb{'data'}{'wordmatch'}{'day_abb'}{$dow});
177324011.36ms $dow = $$dmb{'data'}{'wordmatch'}{'day_name'}{$dow}
1774 if (exists $$dmb{'data'}{'wordmatch'}{'day_name'}{$dow});
1775 } else {
17763548µs return (0);
1777 }
1778
177924015.32ms24013.01ms $string =~ s/\s*$//;
# spent 3.01ms making 2401 calls to Date::Manip::Date::CORE:subst, avg 1µs/call
178024013.65ms24011.37ms $string =~ s/^\s*//;
# spent 1.37ms making 2401 calls to Date::Manip::Date::CORE:subst, avg 570ns/call
1781
178224013.50ms return (0,$string,$dow) if ($string);
1783
1784 # Handle the simple DoW format
1785
1786 ($y,$m,$d) = $self->_def_date($y,$m,$d,$noupdate);
1787
1788 my($w,$dow1);
1789
1790 ($y,$w) = $dmb->week_of_year([$y,$m,$d]); # week of year
1791 ($y,$m,$d) = @{ $dmb->week_of_year($y,$w) }; # first day
1792 $dow1 = $dmb->day_of_week([$y,$m,$d]); # DoW of first day
1793 $dow1 -= 7 if ($dow1 > $dow);
1794 ($y,$m,$d) = @{ $dmb->calc_date_days([$y,$m,$d],$dow-$dow1) };
1795
1796 return(1,$y,$m,$d);
1797}
1798
1799
# 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 {
180062µs my($self,$string,$noupdate) = @_;
180163µs my $dmt = $$self{'tz'};
180262µs my $dmb = $$dmt{'base'};
18036700ns my($y,$m,$d);
1804
1805610µs if (! exists $$dmb{'data'}{'rx'}{'holidays'}) {
1806 return (0);
1807 }
1808
1809 $string =~ s/\s*$//;
1810 $string =~ s/^\s*//;
1811
1812 my $rx = $$dmb{'data'}{'rx'}{'holidays'};
1813 if ($string =~ $rx) {
1814 my $hol;
1815 ($y,$hol) = @+{qw(y holiday)};
1816 $y = $dmt->_now('y',$noupdate) if (! $y);
1817 $y += 0;
1818
1819 $self->_holidays($y,2);
1820 return (0) if (! exists $$dmb{'data'}{'holidays'}{'dates'}{$y});
1821 foreach my $m (keys %{ $$dmb{'data'}{'holidays'}{'dates'}{$y} }) {
1822 foreach my $d (keys %{ $$dmb{'data'}{'holidays'}{'dates'}{$y}{$m} }) {
1823 foreach my $nam (@{ $$dmb{'data'}{'holidays'}{'dates'}{$y}{$m}{$d} }) {
1824 if (lc($nam) eq lc($hol)) {
1825 return(1,$y,$m,$d);
1826 }
1827 }
1828 }
1829 }
1830 }
1831
1832 return (0);
1833}
1834
1835
# spent 5.58ms (81µs+5.50) within Date::Manip::Date::_parse_delta which was called 6 times, avg 929µs/call: # 6 times (81µs+5.50ms) by Date::Manip::Date::parse at line 257, avg 929µs/call
sub _parse_delta {
183663µs my($self,$string,$dow,$got_time,$h,$mn,$s,$noupdate) = @_;
183762µs my $dmt = $$self{'tz'};
183861µs my $dmb = $$dmt{'base'};
18396600ns my($y,$m,$d);
1840
1841610µs62.93ms my $delta = $self->new_delta();
# spent 2.93ms making 6 calls to Date::Manip::Obj::new_delta, avg 488µs/call
184265µs62.25ms my $err = $delta->parse($string);
# spent 2.25ms making 6 calls to Date::Manip::Delta::parse, avg 375µs/call
1843612µs6274µs my $tz = $dmt->_now('tz');
# spent 274µs making 6 calls to Date::Manip::TZ_Base::_now, avg 46µs/call
184464µs643µs my $isdst = $dmt->_now('isdst');
# spent 43µs making 6 calls to Date::Manip::TZ_Base::_now, avg 7µs/call
1845
18466900ns if (! $err) {
1847 my($dy,$dm,$dw,$dd,$dh,$dmn,$ds) = @{ $$delta{'data'}{'delta'} };
1848
1849 if ($got_time &&
1850 ($dh != 0 || $dmn != 0 || $ds != 0)) {
1851 $$self{'err'} = '[parse] Two times entered or implied';
1852 return (1);
1853 }
1854
1855 if ($got_time) {
1856 ($y,$m,$d) = $self->_def_date($y,$m,$d,$noupdate);
1857 } else {
1858 ($y,$m,$d,$h,$mn,$s) = $dmt->_now('now',$$noupdate);
1859 $$noupdate = 1;
1860 }
1861
1862 my $business = $$delta{'data'}{'business'};
1863
1864 my($date2,$offset,$abbrev);
1865 ($err,$date2,$offset,$isdst,$abbrev) =
1866 $self->__calc_date_delta([$y,$m,$d,$h,$mn,$s],
1867 [$dy,$dm,$dw,$dd,$dh,$dmn,$ds],
1868 0,$business,$tz,$isdst);
1869 ($y,$m,$d,$h,$mn,$s) = @$date2;
1870
1871 if ($dow) {
1872 if ($dd != 0 || $dh != 0 || $dmn != 0 || $ds != 0) {
1873 $$self{'err'} = '[parse] Day of week not allowed';
1874 return (1);
1875 }
1876
1877 my($w,$dow1);
1878
1879 ($y,$w) = $dmb->week_of_year([$y,$m,$d]); # week of year
1880 ($y,$m,$d) = @{ $dmb->week_of_year($y,$w) }; # first day
1881 $dow1 = $dmb->day_of_week([$y,$m,$d]); # DoW of first day
1882 $dow1 -= 7 if ($dow1 > $dow);
1883 ($y,$m,$d) = @{ $dmb->calc_date_days([$y,$m,$d],$dow-$dow1) };
1884 }
1885
1886 return (1,$y,$m,$d,$h,$mn,$s);
1887 }
1888
1889631µs return (0);
1890}
1891
1892
# spent 19.1ms (9.50+9.59) within Date::Manip::Date::_parse_datetime_other which was called 2436 times, avg 8µs/call: # 2436 times (9.50ms+9.59ms) by Date::Manip::Date::parse at line 160, avg 8µs/call
sub _parse_datetime_other {
18932436479µs my($self,$string,$noupdate) = @_;
18942436399µs my $dmt = $$self{'tz'};
18952436338µs my $dmb = $$dmt{'base'};
1896
189724361.77ms14.93ms my $rx = (exists $$dmb{'data'}{'rx'}{'other'}{'miscdatetime'} ?
# spent 4.93ms making 1 call to Date::Manip::Date::_other_rx
1898 $$dmb{'data'}{'rx'}{'other'}{'miscdatetime'} :
1899 $self->_other_rx('miscdatetime'));
1900
190124369.49ms48724.66ms if ($string =~ $rx) {
# spent 2.91ms making 2436 calls to Date::Manip::Date::CORE:match, avg 1µs/call # spent 1.76ms making 2436 calls to Date::Manip::Date::CORE:regcomp, avg 721ns/call
1902 my ($special,$epoch,$y,$mmm,$d,$h,$mn,$s,$tzstring,$zone,$abb,$off) =
1903 @+{qw(special epoch y mmm d h mn s tzstring zone abb off)};
1904
1905 if (defined($special)) {
1906 my $delta = $$dmb{'data'}{'wordmatch'}{'offset_time'}{lc($special)};
1907 my @delta = @{ $dmb->split('delta',$delta) };
1908 my @date = $dmt->_now('now',$$noupdate);
1909 my $tz = $dmt->_now('tz');
1910 my $isdst = $dmt->_now('isdst');
1911 $$noupdate = 1;
1912
1913 my($err,$date2,$offset,$abbrev);
1914 ($err,$date2,$offset,$isdst,$abbrev) =
1915 $self->__calc_date_delta([@date],[@delta],0,0,$tz,$isdst);
1916
1917 if ($tzstring) {
1918
1919 $date2 = [] if (! defined $date2);
1920 my $offset = (defined $off ? $dmb->_delta_convert('offset',$off) : '');
1921 $zone = (defined $zone ? lc($zone) : '');
1922 my $abbrev = (defined $abb ? lc($abb) : '');
1923
1924 # In some cases, a valid abbreviation is also a valid timezone
1925 my $tmp = $dmt->__zone($date2,$offset,$zone,$abbrev,'');
1926 if (! $tmp && $abbrev && ! $zone) {
1927 $abbrev = $dmt->_zone($abbrev);
1928 $tmp = $dmt->__zone($date2,$offset,$abbrev,'','') if ($abbrev);
1929 }
1930 $zone = $tmp;
1931
1932 return (0) if (! $zone);
1933
1934 my(@tmp) = $dmt->_convert('_parse_datetime_other',$date2,$tz,$zone);
1935 $date2 = $tmp[1];
1936 }
1937
1938 @date = @$date2;
1939
1940 return (1,@date,$tzstring,$zone,$abb,$off);
1941
1942 } elsif (defined($epoch)) {
1943 my $date = [1970,1,1,0,0,0];
1944 my @delta = (0,0,$epoch);
1945 $date = $dmb->calc_date_time($date,\@delta);
1946 my($err);
1947 if ($tzstring) {
1948
1949 my $offset = (defined $off ? $dmb->_delta_convert('offset',$off) : '');
1950 $zone = (defined $zone ? lc($zone) : '');
1951 my $abbrev = (defined $abb ? lc($abb) : '');
1952
1953 # In some cases, a valid abbreviation is also a valid timezone
1954 my $tmp = $dmt->__zone($date,$offset,$zone,$abbrev,'');
1955 if (! $tmp && $abbrev && ! $zone) {
1956 $abbrev = $dmt->_zone($abbrev);
1957 $tmp = $dmt->__zone($date,$offset,$abbrev,'','') if ($abbrev);
1958 }
1959 $zone = $tmp;
1960
1961 return (0) if (! $zone);
1962
1963 ($err,$date) = $dmt->convert_from_gmt($date,$zone);
1964 } else {
1965 ($err,$date) = $dmt->convert_from_gmt($date);
1966 }
1967 return (1,@$date,$tzstring,$zone,$abb,$off);
1968
1969 } elsif (defined($y)) {
1970 my $m = $$dmb{'data'}{'wordmatch'}{'month_abb'}{lc($mmm)};
1971 return (1,$y,$m,$d,$h,$mn,$s,$tzstring,$zone,$abb,$off);
1972 }
1973 }
1974
197524364.32ms return (0);
1976}
1977
1978
# spent 2.34ms (56µs+2.28) within Date::Manip::Date::_parse_date_other which was called 12 times, avg 195µs/call: # 12 times (56µs+2.28ms) by Date::Manip::Date::_parse_date at line 473, avg 195µs/call
sub _parse_date_other {
1979124µs my($self,$string,$dow,$of,$noupdate) = @_;
1980122µs my $dmt = $$self{'tz'};
1981122µs my $dmb = $$dmt{'base'};
1982121µs my($y,$m,$d,$h,$mn,$s);
1983
19841210µs12.21ms my $rx = (exists $$dmb{'data'}{'rx'}{'other'}{'misc'} ?
# spent 2.21ms making 1 call to Date::Manip::Date::_other_rx
1985 $$dmb{'data'}{'rx'}{'other'}{'misc'} :
1986 $self->_other_rx('misc'));
1987
1988122µs my($mmm,$month,$nextprev,$last,$field_y,$field_m,$field_w,$field_d,$nth);
1989 my($special,$got_m,$n,$got_y);
1990
19911294µs2470µs if ($string =~ $rx) {
# spent 41µs making 12 calls to Date::Manip::Date::CORE:regcomp, avg 3µs/call # spent 29µs making 12 calls to Date::Manip::Date::CORE:match, avg 2µs/call
1992 ($y,$mmm,$month,$nextprev,$last,$field_y,$field_m,$field_w,$field_d,$nth,
1993 $special,$n) =
1994 @+{qw(y mmm month next last field_y field_m field_w field_d
1995 nth special n)};
1996
1997 if (defined($y)) {
1998 $y = $dmt->_fix_year($y);
1999 $got_y = 1;
2000 return () if (! $y);
2001 } else {
2002 $y = $dmt->_now('y',$$noupdate);
2003 $$noupdate = 1;
2004 $got_y = 0;
2005 $$self{'data'}{'def'}[0] = '';
2006 }
2007
2008 if (defined($mmm)) {
2009 $m = $$dmb{'data'}{'wordmatch'}{'month_abb'}{lc($mmm)};
2010 $got_m = 1;
2011 } elsif ($month) {
2012 $m = $$dmb{'data'}{'wordmatch'}{'month_name'}{lc($month)};
2013 $got_m = 1;
2014 }
2015
2016 if ($nth) {
2017 $nth = $$dmb{'data'}{'wordmatch'}{'nth'}{lc($nth)};
2018 }
2019
2020 if ($got_m && $nth && ! $dow) {
2021 # Dec 1st 1970
2022 # 1st Dec 1970
2023 # 1970 Dec 1st
2024 # 1970 1st Dec
2025
2026 $d = $nth;
2027
2028 } elsif ($nextprev) {
2029
2030 my $next = 0;
2031 my $sign = -1;
2032 if ($$dmb{'data'}{'wordmatch'}{'nextprev'}{lc($nextprev)} == 1) {
2033 $next = 1;
2034 $sign = 1;
2035 }
2036
2037 if ($field_y || $field_m || $field_w) {
2038 # next/prev year/month/week
2039
2040 my(@delta);
2041 if ($field_y) {
2042 @delta = ($sign*1,0,0,0,0,0,0);
2043 } elsif ($field_m) {
2044 @delta = (0,$sign*1,0,0,0,0,0);
2045 } else {
2046 @delta = (0,0,$sign*1,0,0,0,0);
2047 }
2048
2049 my @now = $dmt->_now('now',$$noupdate);
2050 my $tz = $dmt->_now('tz');
2051 my $isdst = $dmt->_now('isdst');
2052 $$noupdate = 1;
2053
2054 my($err,$offset,$abbrev,$date2);
2055 ($err,$date2,$offset,$isdst,$abbrev) =
2056 $self->__calc_date_delta([@now],[@delta],0,0,$tz,$isdst);
2057 ($y,$m,$d,$h,$mn,$s) = @$date2;
2058
2059 } elsif ($dow) {
2060 # next/prev friday
2061
2062 my @now = $dmt->_now('now',$$noupdate);
2063 $$noupdate = 1;
2064 ($y,$m,$d,$h,$mn,$s) = @{ $self->__next_prev(\@now,$next,$dow,0) };
2065 $dow = 0;
2066
2067 } else {
2068 return ();
2069 }
2070
2071 } elsif ($last) {
2072
2073 if ($field_d && $got_m) {
2074 # last day in october 95
2075
2076 $d = $dmb->days_in_month($y,$m);
2077
2078 } elsif ($dow && $got_m) {
2079 # last friday in october 95
2080
2081 $d = $dmb->days_in_month($y,$m);
2082 ($y,$m,$d,$h,$mn,$s) =
2083 @{ $self->__next_prev([$y,$m,$d,0,0,0],0,$dow,1) };
2084 $dow = 0;
2085
2086 } elsif ($dow) {
2087 # last friday in 95
2088
2089 ($y,$m,$d,$h,$mn,$s) =
2090 @{ $self->__next_prev([$y,12,31,0,0,0],0,$dow,0) };
2091
2092 } else {
2093 return ();
2094 }
2095
2096 } elsif ($nth && $dow && ! $field_w) {
2097
2098 if ($got_m) {
2099 if ($of) {
2100 # nth DoW of MMM [YYYY]
2101 return () if ($nth > 5);
2102
2103 $d = 1;
2104 ($y,$m,$d,$h,$mn,$s) =
2105 @{ $self->__next_prev([$y,$m,1,0,0,0],1,$dow,1) };
2106 my $m2 = $m;
2107 ($y,$m2,$d) = @{ $dmb->calc_date_days([$y,$m,$d],7*($nth-1)) }
2108 if ($nth > 1);
2109 return () if (! $m2 || $m2 != $m);
2110
2111 } else {
2112 # DoW, nth MMM [YYYY] (i.e. Sunday, 9th Dec 2008)
2113 $d = $nth;
2114 }
2115
2116 } else {
2117 # nth DoW [in YYYY]
2118
2119 ($y,$m,$d,$h,$mn,$s) = @{ $self->__next_prev([$y,1,1,0,0,0],1,$dow,1) };
2120 ($y,$m,$d) = @{ $dmb->calc_date_days([$y,$m,$d],7*($nth-1)) }
2121 if ($nth > 1);
2122 }
2123
2124 } elsif ($field_w && $dow) {
2125
2126 if (defined($n) || $nth) {
2127 # sunday week 22 in 1996
2128 # sunday 22nd week in 1996
2129
2130 $n = $nth if ($nth);
2131 return () if (! $n);
2132 ($y,$m,$d) = @{ $dmb->week_of_year($y,$n) };
2133 ($y,$m,$d) = @{ $self->__next_prev([$y,$m,$d,0,0,0],1,$dow,1) };
2134
2135 } else {
2136 # DoW week
2137
2138 ($y,$m,$d) = $dmt->_now('now',$$noupdate);
2139 $$noupdate = 1;
2140 my $tmp = $dmb->_config('firstday');
2141 ($y,$m,$d) = @{ $self->__next_prev([$y,$m,$d,0,0,0],1,$tmp,0) };
2142 ($y,$m,$d) = @{ $self->__next_prev([$y,$m,$d,0,0,0],1,$dow,1) };
2143 }
2144
2145 } elsif ($nth && ! $got_y) {
2146 # 'in one week' makes it here too so return nothing in that case so it
2147 # drops through to the deltas.
2148 return () if ($field_d || $field_w || $field_m || $field_y);
2149 ($y,$m,$d) = $dmt->_now('now',$$noupdate);
2150 $$noupdate = 1;
2151 $d = $nth;
2152
2153 } elsif ($special) {
2154
2155 my $delta = $$dmb{'data'}{'wordmatch'}{'offset_date'}{lc($special)};
2156 my @delta = @{ $dmb->split('delta',$delta) };
2157 ($y,$m,$d) = $dmt->_now('now',$$noupdate);
2158 my $tz = $dmt->_now('tz');
2159 my $isdst = $dmt->_now('isdst');
2160 $$noupdate = 1;
2161 my($err,$offset,$abbrev,$date2);
2162 ($err,$date2,$offset,$isdst,$abbrev) =
2163 $self->__calc_date_delta([$y,$m,$d,0,0,0],[@delta],0,0,$tz,$isdst);
2164 ($y,$m,$d) = @$date2;
2165
2166 if ($field_w) {
2167 ($y,$m,$d) = @{ $dmb->calc_date_days([$y,$m,$d],7) };
2168 }
2169 }
2170
2171 } else {
21721217µs return ();
2173 }
2174
2175 return($y,$m,$d,$dow);
2176}
2177
2178# Supply defaults for missing values (Y/M/D)
2179
# spent 28.6ms (9.63+19.0) within Date::Manip::Date::_def_date which was called 2430 times, avg 12µs/call: # 2430 times (9.63ms+19.0ms) by Date::Manip::Date::_parse_date_common at line 1736, avg 12µs/call
sub _def_date {
21802430782µs my($self,$y,$m,$d,$noupdate) = @_;
21812430288µs $y = '' if (! defined $y);
21822430176µs $m = '' if (! defined $m);
21832430183µs $d = '' if (! defined $d);
21842430218µs my $defined = 0;
21852430292µs my $dmt = $$self{'tz'};
21862430307µs my $dmb = $$dmt{'base'};
2187
2188 # If year was not specified, defaults to current year.
2189 #
2190 # We'll also fix the year (turn 2-digit into 4-digit).
2191
21922430622µs if ($y eq '') {
2193 $y = $dmt->_now('y',$$noupdate);
2194 $$noupdate = 1;
2195 $$self{'data'}{'def'}[0] = '';
2196 } else {
219724302.18ms243019.0ms $y = $dmt->_fix_year($y);
# spent 19.0ms making 2430 calls to Date::Manip::TZ_Base::_fix_year, avg 8µs/call
21982430397µs $defined = 1;
2199 }
2200
2201 # If the month was not specifed, but the year was, a default of
2202 # 01 is supplied (this is a truncated date).
2203 #
2204 # If neither was specified, month defaults to the current month.
2205
22062430663µs if ($m ne '') {
2207 $defined = 1;
2208 } elsif ($defined) {
2209 $m = 1;
2210 $$self{'data'}{'def'}[1] = 1;
2211 } else {
2212 $m = $dmt->_now('m',$$noupdate);
2213 $$noupdate = 1;
2214 $$self{'data'}{'def'}[1] = '';
2215 }
2216
2217 # If the day was not specified, but the year or month was, a default
2218 # of 01 is supplied (this is a truncated date).
2219 #
2220 # If none were specified, it default to the current day.
2221
22222430325µs if ($d ne '') {
2223 $defined = 1;
2224 } elsif ($defined) {
2225 $d = 1;
2226 $$self{'data'}{'def'}[2] = 1;
2227 } else {
2228 $d = $dmt->_now('d',$$noupdate);
2229 $$noupdate = 1;
2230 $$self{'data'}{'def'}[2] = '';
2231 }
2232
223324303.24ms return($y,$m,$d);
2234}
2235
2236# Supply defaults for missing values (Y/DoY)
2237sub _def_date_doy {
2238 my($self,$y,$doy,$noupdate) = @_;
2239 $y = '' if (! defined $y);
2240 my $dmt = $$self{'tz'};
2241 my $dmb = $$dmt{'base'};
2242
2243 # If year was not specified, defaults to current year.
2244 #
2245 # We'll also fix the year (turn 2-digit into 4-digit).
2246
2247 if ($y eq '') {
2248 $y = $dmt->_now('y',$$noupdate);
2249 $$noupdate = 1;
2250 $$self{'data'}{'def'}[0] = '';
2251 } else {
2252 $y = $dmt->_fix_year($y);
2253 }
2254
2255 # DoY must be specified.
2256
2257 my($m,$d);
2258 my $ymd = $dmb->day_of_year($y,$doy);
2259
2260 return @$ymd;
2261}
2262
2263# Supply defaults for missing values (YY/Www/D) and (Y/Www/D)
2264sub _def_date_dow {
2265 my($self,$y,$w,$dow,$noupdate) = @_;
2266 $y = '' if (! defined $y);
2267 $w = '' if (! defined $w);
2268 $dow = '' if (! defined $dow);
2269 my $dmt = $$self{'tz'};
2270 my $dmb = $$dmt{'base'};
2271
2272 # If year was not specified, defaults to current year.
2273 #
2274 # If it was specified and is a single digit, it is the
2275 # year in the current decade.
2276 #
2277 # We'll also fix the year (turn 2-digit into 4-digit).
2278
2279 if ($y ne '') {
2280 if (length($y) == 1) {
2281 my $tmp = $dmt->_now('y',$$noupdate);
2282 $tmp =~ s/.$/$y/;
2283 $y = $tmp;
2284 $$noupdate = 1;
2285
2286 } else {
2287 $y = $dmt->_fix_year($y);
2288
2289 }
2290
2291 } else {
2292 $y = $dmt->_now('y',$$noupdate);
2293 $$noupdate = 1;
2294 $$self{'data'}{'def'}[0] = '';
2295 }
2296
2297 # If week was not specified, it defaults to the current
2298 # week. Get the first day of the week.
2299
2300 my($m,$d);
2301 if ($w ne '') {
2302 ($y,$m,$d) = @{ $dmb->week_of_year($y,$w) };
2303 } else {
2304 my($nowy,$nowm,$nowd) = $dmt->_now('now',$$noupdate);
2305 $$noupdate = 1;
2306 my $noww;
2307 ($nowy,$noww) = $dmb->week_of_year([$nowy,$nowm,$nowd]);
2308 ($y,$m,$d) = @{ $dmb->week_of_year($nowy,$noww) };
2309 }
2310
2311 # Handle the DoW
2312
2313 if ($dow eq '') {
2314 $dow = 1;
2315 }
2316 my $n = $dmb->days_in_month($y,$m);
2317 $d += ($dow-1);
2318 if ($d > $n) {
2319 $m++;
2320 if ($m==13) {
2321 $y++;
2322 $m = 1;
2323 }
2324 $d = $d-$n;
2325 }
2326
2327 return($y,$m,$d);
2328}
2329
2330# Supply defaults for missing values (HH:MN:SS)
2331
# spent 9.52ms within Date::Manip::Date::_def_time which was called 4872 times, avg 2µs/call: # 2436 times (5.87ms+0s) by Date::Manip::Date::_parse_time at line 1666, avg 2µs/call # 2436 times (3.65ms+0s) by Date::Manip::Date::_time at line 1315, avg 1µs/call
sub _def_time {
233248721.31ms my($self,$h,$m,$s,$noupdate) = @_;
23334872497µs $h = '' if (! defined $h);
23344872294µs $m = '' if (! defined $m);
23354872277µs $s = '' if (! defined $s);
23364872467µs my $defined = 0;
23374872642µs my $dmt = $$self{'tz'};
23384872576µs my $dmb = $$dmt{'base'};
2339
2340 # If no time was specified, defaults to 00:00:00.
2341
23424872563µs if ($h eq '' &&
2343 $m eq '' &&
2344 $s eq '') {
2345 $$self{'data'}{'def'}[3] = 1;
2346 $$self{'data'}{'def'}[4] = 1;
2347 $$self{'data'}{'def'}[5] = 1;
2348 return(0,0,0);
2349 }
2350
2351 # If hour was not specified, defaults to current hour.
2352
23534872771µs if ($h ne '') {
2354 $defined = 1;
2355 } else {
2356 $h = $dmt->_now('h',$$noupdate);
2357 $$noupdate = 1;
2358 $$self{'data'}{'def'}[3] = '';
2359 }
2360
2361 # If the minute was not specifed, but the hour was, a default of
2362 # 00 is supplied (this is a truncated time).
2363 #
2364 # If neither was specified, minute defaults to the current minute.
2365
23664872532µs if ($m ne '') {
2367 $defined = 1;
2368 } elsif ($defined) {
2369 $m = 0;
2370 $$self{'data'}{'def'}[4] = 1;
2371 } else {
2372 $m = $dmt->_now('mn',$$noupdate);
2373 $$noupdate = 1;
2374 $$self{'data'}{'def'}[4] = '';
2375 }
2376
2377 # If the second was not specified (either the hour or the minute were),
2378 # a default of 00 is supplied (this is a truncated time).
2379
23804872458µs if ($s eq '') {
2381 $s = 0;
2382 $$self{'data'}{'def'}[5] = 1;
2383 }
2384
238548726.41ms return($h,$m,$s);
2386}
2387
2388########################################################################
2389# OTHER DATE METHODS
2390########################################################################
2391
2392# Gets the date in the parsed timezone (if $type = ''), local timezone
2393# (if $type = 'local') or GMT timezone (if $type = 'gmt').
2394#
2395# Gets the string value in scalar context, the split value in list
2396# context.
2397#
2398sub value {
2399 my($self,$type) = @_;
2400 my $dmt = $$self{'tz'};
2401 my $dmb = $$dmt{'base'};
2402 my $date;
2403
2404 while (1) {
2405 if (! $$self{'data'}{'set'}) {
2406 $$self{'err'} = '[value] Object does not contain a date';
2407 last;
2408 }
2409
2410 $type = '' if (! $type);
2411
2412 if ($type eq 'gmt') {
2413
2414 if (! @{ $$self{'data'}{'gmt'} }) {
2415 my $zone = $$self{'data'}{'tz'};
2416 my $date = $$self{'data'}{'date'};
2417
2418 if ($zone eq 'Etc/GMT') {
2419 $$self{'data'}{'gmt'} = $date;
2420
2421 } else {
2422 my $isdst = $$self{'data'}{'isdst'};
2423 my($err,$d) = $dmt->convert_to_gmt($date,$zone,$isdst);
2424 if ($err) {
2425 $$self{'err'} = '[value] Unable to convert date to GMT';
2426 last;
2427 }
2428 $$self{'data'}{'gmt'} = $d;
2429 }
2430 }
2431 $date = $$self{'data'}{'gmt'};
2432
2433 } elsif ($type eq 'local') {
2434
2435 if (! @{ $$self{'data'}{'loc'} }) {
2436 my $zone = $$self{'data'}{'tz'};
2437 $date = $$self{'data'}{'date'};
2438 my $local = $dmt->_now('tz',1);
2439
2440 if ($zone eq $local) {
2441 $$self{'data'}{'loc'} = $date;
2442
2443 } else {
2444 my $isdst = $$self{'data'}{'isdst'};
2445 my($err,$d) = $dmt->convert_to_local($date,$zone,$isdst);
2446 if ($err) {
2447 $$self{'err'} = '[value] Unable to convert date to localtime';
2448 last;
2449 }
2450 $$self{'data'}{'loc'} = $d;
2451 }
2452 }
2453 $date = $$self{'data'}{'loc'};
2454
2455 } else {
2456
2457 $date = $$self{'data'}{'date'};
2458
2459 }
2460
2461 last;
2462 }
2463
2464 if ($$self{'err'}) {
2465 if (wantarray) {
2466 return ();
2467 } else {
2468 return '';
2469 }
2470 }
2471
2472 if (wantarray) {
2473 return @$date;
2474 } else {
2475 return $dmb->join('date',$date);
2476 }
2477}
2478
2479sub cmp {
2480 my($self,$date) = @_;
2481 if ($$self{'err'} || ! $$self{'data'}{'set'}) {
2482 warn "WARNING: [cmp] Arguments must be valid dates: date1\n";
2483 return undef;
2484 }
2485
2486 if (! ref($date) eq 'Date::Manip::Date') {
2487 warn "WARNING: [cmp] Argument must be a Date::Manip::Date object\n";
2488 return undef;
2489 }
2490 if ($$date{'err'} || ! $$date{'data'}{'set'}) {
2491 warn "WARNING: [cmp] Arguments must be valid dates: date2\n";
2492 return undef;
2493 }
2494
2495 my($d1,$d2);
2496 if ($$self{'data'}{'tz'} eq $$date{'data'}{'tz'}) {
2497 $d1 = $self->value();
2498 $d2 = $date->value();
2499 } else {
2500 $d1 = $self->value('gmt');
2501 $d2 = $date->value('gmt');
2502 }
2503
2504 return ($d1 cmp $d2);
2505}
2506
2507
# spent 6µs within Date::Manip::Date::BEGIN@2507 which was called: # once (6µs+0s) by main::RUNTIME at line 2727
BEGIN {
250817µs my %field = qw(y 0 m 1 d 2 h 3 mn 4 s 5);
2509
2510
# spent 105ms (34.0+70.6) within Date::Manip::Date::set which was called 2430 times, avg 43µs/call: # 2430 times (34.0ms+70.6ms) by Date::Manip::Date::_parse_check at line 1024, avg 43µs/call
sub set {
25112430909µs my($self,$field,@val) = @_;
25122430529µs $field = lc($field);
25132430503µs my $dmt = $$self{'tz'};
25142430378µs my $dmb = $$dmt{'base'};
2515
2516 # Make sure $self includes a valid date (unless the entire date is
2517 # being set, in which case it doesn't matter).
2518
25192430561µs my $date = [];
25202430242µs my(@def,$tz,$isdst);
2521
25222430586µs if ($field eq 'zdate') {
2523 # If {data}{set} = 2, we want to preserve the defaults. Also, we've
2524 # already initialized.
2525 #
2526 # It is only set in the parse routines which means that this was
2527 # called via _parse_check.
2528
25292430799µs $self->_init() if ($$self{'data'}{'set'} != 2);
253024301.54ms @def = @{ $$self{'data'}{'def'} };
2531
2532 } elsif ($field eq 'date') {
2533 if ($$self{'data'}{'set'} && ! $$self{'err'}) {
2534 $tz = $$self{'data'}{'tz'};
2535 } else {
2536 $tz = $dmt->_now('tz',1);
2537 }
2538 $self->_init();
2539 @def = @{ $$self{'data'}{'def'} };
2540
2541 } else {
2542 return 1 if ($$self{'err'} || ! $$self{'data'}{'set'});
2543 $date = $$self{'data'}{'date'};
2544 $tz = $$self{'data'}{'tz'};
2545 $isdst = $$self{'data'}{'isdst'};
2546 @def = @{ $$self{'data'}{'def'} };
2547 $self->_init();
2548 }
2549
2550 # Check the arguments
2551
25522430263µs my($err,$new_tz,$new_date,$new_time);
2553
25542430878µs if ($field eq 'date') {
2555
2556 if ($#val == 0) {
2557 # date,DATE
2558 $new_date = $val[0];
2559 } elsif ($#val == 1) {
2560 # date,DATE,ISDST
2561 ($new_date,$isdst) = @val;
2562 } else {
2563 $err = 1;
2564 }
2565 for (my $i=0; $i<=5; $i++) {
2566 $def[$i] = 0 if ($def[$i]);
2567 }
2568
2569 } elsif ($field eq 'time') {
2570
2571 if ($#val == 0) {
2572 # time,TIME
2573 $new_time = $val[0];
2574 } elsif ($#val == 1) {
2575 # time,TIME,ISDST
2576 ($new_time,$isdst) = @val;
2577 } else {
2578 $err = 1;
2579 }
2580 $def[3] = 0 if ($def[3]);
2581 $def[4] = 0 if ($def[4]);
2582 $def[5] = 0 if ($def[5]);
2583
2584 } elsif ($field eq 'zdate') {
2585
258624301.70ms if ($#val == 0) {
2587 # zdate,DATE
2588 $new_date = $val[0];
2589 } elsif ($#val == 1 && ($val[1] eq '0' || $val[1] eq '1')) {
2590 # zdate,DATE,ISDST
2591 ($new_date,$isdst) = @val;
2592 } elsif ($#val == 1) {
2593 # zdate,ZONE,DATE
2594 ($new_tz,$new_date) = @val;
2595 } elsif ($#val == 2) {
2596 # zdate,ZONE,DATE,ISDST
2597 ($new_tz,$new_date,$isdst) = @val;
2598 } else {
2599 $err = 1;
2600 }
260124303.04ms for (my $i=0; $i<=5; $i++) {
2602 $def[$i] = 0 if ($def[$i]);
2603 }
26042430382µs $tz = $dmt->_now('tz',1) if (! $new_tz);
2605
2606 } elsif ($field eq 'zone') {
2607
2608 if ($#val == -1) {
2609 # zone
2610 } elsif ($#val == 0 && ($val[0] eq '0' || $val[0] eq '1')) {
2611 # zone,ISDST
2612 $isdst = $val[0];
2613 } elsif ($#val == 0) {
2614 # zone,ZONE
2615 $new_tz = $val[0];
2616 } elsif ($#val == 1) {
2617 # zone,ZONE,ISDST
2618 ($new_tz,$isdst) = @val;
2619 } else {
2620 $err = 1;
2621 }
2622 $tz = $dmt->_now('tz',1) if (! $new_tz);
2623
2624 } elsif (exists $field{$field}) {
2625
2626 my $i = $field{$field};
2627 my $val;
2628 if ($#val == 0) {
2629 $val = $val[0];
2630 } elsif ($#val == 1) {
2631 ($val,$isdst) = @val;
2632 } else {
2633 $err = 1;
2634 }
2635
2636 $$date[$i] = $val;
2637 $def[$i] = 0 if ($def[$i]);
2638
2639 } else {
2640
2641 $err = 2;
2642
2643 }
2644
26452430200µs if ($err) {
2646 if ($err == 1) {
2647 $$self{'err'} = '[set] Invalid arguments';
2648 } else {
2649 $$self{'err'} = '[set] Invalid field';
2650 }
2651 return 1;
2652 }
2653
2654 # Handle the arguments (it can be a zone or an offset)
2655
26562430418µs if ($new_tz) {
265724301.45ms24303.30ms my $tmp = $dmt->_zone($new_tz);
# spent 3.30ms making 2430 calls to Date::Manip::TZ::_zone, avg 1µs/call
26582430648µs if ($tmp) {
2659 # A zone/alias
2660 $tz = $tmp;
2661
2662 } else {
2663 # An offset
2664
2665 my $dstflag = '';
2666 $dstflag = ($isdst ? 'dstonly' : 'stdonly') if (defined $isdst);
2667
2668 $tz = $dmb->__zone($date,lc($new_tz),'',$dstflag);
2669
2670 if (! $tz) {
2671 $$self{'err'} = "[set] Invalid timezone argument: $new_tz";
2672 return 1;
2673 }
2674 }
2675 }
2676
26772430665µs if ($new_date) {
267824301.91ms243027.5ms if ($dmb->check($new_date)) {
# spent 27.5ms making 2430 calls to Date::Manip::Base::check, avg 11µs/call
2679 $date = $new_date;
2680 } else {
2681 $$self{'err'} = '[set] Invalid date argument';
2682 return 1;
2683 }
2684 }
2685
26862430201µs if ($new_time) {
2687 if ($dmb->check_time($new_time)) {
2688 $$date[3] = $$new_time[0];
2689 $$date[4] = $$new_time[1];
2690 $$date[5] = $$new_time[2];
2691 } else {
2692 $$self{'err'} = '[set] Invalid time argument';
2693 return 1;
2694 }
2695 }
2696
2697 # Check the date/timezone combination
2698
26992430248µs my($abb,$off);
27002430515µs if ($tz eq 'etc/gmt') {
27012300ns $abb = 'GMT';
270221µs $off = [0,0,0];
27032300ns $isdst = 0;
2704 } else {
270524281.66ms242839.8ms my $per = $dmt->date_period($date,$tz,1,$isdst);
# spent 39.8ms making 2428 calls to Date::Manip::TZ::date_period, avg 16µs/call
27062428254µs if (! $per) {
2707 $$self{'err'} = '[set] Invalid date/timezone';
2708 return 1;
2709 }
27102428380µs $isdst = $$per[5];
27112428338µs $abb = $$per[4];
27122428557µs $off = $$per[3];
2713 }
2714
2715 # Set the information
2716
27172430691µs $$self{'data'}{'set'} = 1;
27182430717µs $$self{'data'}{'date'} = $date;
27192430563µs $$self{'data'}{'tz'} = $tz;
27202430759µs $$self{'data'}{'isdst'} = $isdst;
27212430474µs $$self{'data'}{'offset'}= $off;
27222430453µs $$self{'data'}{'abb'} = $abb;
272324301.78ms $$self{'data'}{'def'} = [ @def ];
2724
272524303.82ms return 0;
2726 }
27271864µs16µs}
# spent 6µs making 1 call to Date::Manip::Date::BEGIN@2507
2728
2729########################################################################
2730# NEXT/PREV METHODS
2731
2732sub prev {
2733 my($self,@args) = @_;
2734 return 1 if ($$self{'err'} || ! $$self{'data'}{'set'});
2735 my $date = $$self{'data'}{'date'};
2736
2737 $date = $self->__next_prev($date,0,@args);
2738
2739 return 1 if (! defined($date));
2740 $self->set('date',$date);
2741 return 0;
2742}
2743
2744sub next {
2745 my($self,@args) = @_;
2746 return 1 if ($$self{'err'} || ! $$self{'data'}{'set'});
2747 my $date = $$self{'data'}{'date'};
2748
2749 $date = $self->__next_prev($date,1,@args);
2750
2751 return 1 if (! defined($date));
2752 $self->set('date',$date);
2753 return 0;
2754}
2755
2756sub __next_prev {
2757 my($self,$date,$next,$dow,$curr,$time) = @_;
2758
2759 my ($caller,$sign,$prev);
2760 if ($next) {
2761 $caller = 'next';
2762 $sign = 1;
2763 $prev = 0;
2764 } else {
2765 $caller = 'prev';
2766 $sign = -1;
2767 $prev = 1;
2768 }
2769
2770 my $dmt = $$self{'tz'};
2771 my $dmb = $$dmt{'base'};
2772 my $orig = [ @$date ];
2773
2774 # Check the time (if any)
2775
2776 if (defined($time)) {
2777 if ($dow) {
2778 # $time will refer to a full [H,MN,S]
2779 my($err,$h,$mn,$s) = $dmb->_hms_fields({ 'out' => 'list' },$time);
2780 if ($err) {
2781 $$self{'err'} = "[$caller] invalid time argument";
2782 return undef;
2783 }
2784 $time = [$h,$mn,$s];
2785 } else {
2786 # $time may have leading undefs
2787 my @tmp = @$time;
2788 if ($#tmp != 2) {
2789 $$self{'err'} = "[$caller] invalid time argument";
2790 return undef;
2791 }
2792 my($h,$mn,$s) = @$time;
2793 if (defined($h)) {
2794 $mn = 0 if (! defined($mn));
2795 $s = 0 if (! defined($s));
2796 } elsif (defined($mn)) {
2797 $s = 0 if (! defined($s));
2798 } else {
2799 $s = 0 if (! defined($s));
2800 }
2801 $time = [$h,$mn,$s];
2802 }
2803 }
2804
2805 # Find the next DoW
2806
2807 if ($dow) {
2808
2809 if (! $dmb->_is_int($dow,1,7)) {
2810 $$self{'err'} = "[$caller] Invalid DOW: $dow";
2811 return undef;
2812 }
2813
2814 # Find the next/previous occurrence of DoW
2815
2816 my $curr_dow = $dmb->day_of_week($date);
2817 my $adjust = 0;
2818
2819 if ($dow == $curr_dow) {
2820 $adjust = 1 if ($curr == 0);
2821
2822 } else {
2823 my $num;
2824 if ($next) {
2825 # force $dow to be more than $curr_dow
2826 $dow += 7 if ($dow<$curr_dow);
2827 $num = $dow - $curr_dow;
2828 } else {
2829 # force $dow to be less than $curr_dow
2830 $dow -= 7 if ($dow>$curr_dow);
2831 $num = $curr_dow - $dow;
2832 $num *= -1;
2833 }
2834
2835 # Add/subtract $num days
2836 $date = $dmb->calc_date_days($date,$num);
2837 }
2838
2839 if (defined($time)) {
2840 my ($y,$m,$d,$h,$mn,$s) = @$date;
2841 ($h,$mn,$s) = @$time;
2842 $date = [$y,$m,$d,$h,$mn,$s];
2843 }
2844
2845 my $cmp = $dmb->cmp($orig,$date);
2846 $adjust = 1 if ($curr == 2 && $cmp != -1*$sign);
2847
2848 if ($adjust) {
2849 # Add/subtract 1 week
2850 $date = $dmb->calc_date_days($date,$sign*7);
2851 }
2852
2853 return $date;
2854 }
2855
2856 # Find the next Time
2857
2858 if (defined($time)) {
2859
2860 my ($h,$mn,$s) = @$time;
2861 my $orig = [ @$date ];
2862
2863 my $cmp;
2864 if (defined $h) {
2865 # Find next/prev HH:MN:SS
2866
2867 @$date[3..5] = @$time;
2868 $cmp = $dmb->cmp($orig,$date);
2869 if ($cmp == -1) {
2870 if ($prev) {
2871 $date = $dmb->calc_date_days($date,-1);
2872 }
2873 } elsif ($cmp == 1) {
2874 if ($next) {
2875 $date = $dmb->calc_date_days($date,1);
2876 }
2877 } else {
2878 if (! $curr) {
2879 $date = $dmb->calc_date_days($date,$sign);
2880 }
2881 }
2882
2883 } elsif (defined $mn) {
2884 # Find next/prev MN:SS
2885
2886 @$date[4..5] = @$time[1..2];
2887
2888 $cmp = $dmb->cmp($orig,$date);
2889 if ($cmp == -1) {
2890 if ($prev) {
2891 $date = $dmb->calc_date_time($date,[-1,0,0]);
2892 }
2893 } elsif ($cmp == 1) {
2894 if ($next) {
2895 $date = $dmb->calc_date_time($date,[1,0,0]);
2896 }
2897 } else {
2898 if (! $curr) {
2899 $date = $dmb->calc_date_time($date,[$sign,0,0]);
2900 }
2901 }
2902
2903 } else {
2904 # Find next/prev SS
2905
2906 $$date[5] = $$time[2];
2907
2908 $cmp = $dmb->cmp($orig,$date);
2909 if ($cmp == -1) {
2910 if ($prev) {
2911 $date = $dmb->calc_date_time($date,[0,-1,0]);
2912 }
2913 } elsif ($cmp == 1) {
2914 if ($next) {
2915 $date = $dmb->calc_date_time($date,[0,1,0]);
2916 }
2917 } else {
2918 if (! $curr) {
2919 $date = $dmb->calc_date_time($date,[0,$sign,0]);
2920 }
2921 }
2922 }
2923
2924 return $date;
2925 }
2926
2927 $$self{'err'} = "[$caller] Either DoW or time (or both) required";
2928 return undef;
2929}
2930
2931########################################################################
2932# CALC METHOD
2933
2934sub calc {
2935 my($self,$obj,@args) = @_;
2936
2937 if (ref($obj) eq 'Date::Manip::Date') {
2938 return $self->_calc_date_date($obj,@args);
2939
2940 } elsif (ref($obj) eq 'Date::Manip::Delta') {
2941 return $self->_calc_date_delta($obj,@args);
2942
2943 } else {
2944 return undef;
2945 }
2946}
2947
2948sub _calc_date_date {
2949 my($self,$date,@args) = @_;
2950 my $ret = $self->new_delta();
2951
2952 if ($$self{'err'} || ! $$self{'data'}{'set'}) {
2953 $$ret{'err'} = '[calc] First object invalid (date)';
2954 return $ret;
2955 }
2956
2957 if ($$date{'err'} || ! $$date{'data'}{'set'}) {
2958 $$ret{'err'} = '[calc] Second object invalid (date)';
2959 return $ret;
2960 }
2961
2962 # Handle subtract/mode arguments
2963
2964 my($subtract,$mode);
2965
2966 if ($#args == -1) {
2967 ($subtract,$mode) = (0,'');
2968 } elsif ($#args == 0) {
2969 if ($args[0] eq '0' || $args[0] eq '1') {
2970 ($subtract,$mode) = ($args[0],'');
2971 } else {
2972 ($subtract,$mode) = (0,$args[0]);
2973 }
2974
2975 } elsif ($#args == 1) {
2976 ($subtract,$mode) = @args;
2977 } else {
2978 $$ret{'err'} = '[calc] Invalid arguments';
2979 return $ret;
2980 }
2981 $mode = 'exact' if (! $mode);
2982
2983 if ($mode !~ /^(business|bsemi|bapprox|approx|semi|exact)$/i) {
2984 $$ret{'err'} = '[calc] Invalid mode argument';
2985 return $ret;
2986 }
2987
2988 # if business mode
2989 # dates must be in the same timezone
2990 # use dates in that zone
2991 #
2992 # otherwise if both dates are in the same timezone && approx/semi mode
2993 # use the dates in that zone
2994 #
2995 # otherwise
2996 # convert to gmt
2997 # use those dates
2998
2999 my($date1,$date2,$tz1,$isdst1,$tz2,$isdst2);
3000 if ($mode eq 'business' || $mode eq 'bapprox' || $mode eq 'bsemi') {
3001 if ($$self{'data'}{'tz'} eq $$date{'data'}{'tz'}) {
3002 $date1 = [ $self->value() ];
3003 $date2 = [ $date->value() ];
3004 $tz1 = $$self{'data'}{'tz'};
3005 $tz2 = $tz1;
3006 $isdst1 = $$self{'data'}{'isdst'};
3007 $isdst2 = $$date{'data'}{'isdst'};
3008 } else {
3009 $$ret{'err'} = '[calc] Dates must be in the same timezone for ' .
3010 'business mode calculations';
3011 return $ret;
3012 }
3013
3014 } elsif (($mode eq 'approx' || $mode eq 'semi') &&
3015 $$self{'data'}{'tz'} eq $$date{'data'}{'tz'}) {
3016 $date1 = [ $self->value() ];
3017 $date2 = [ $date->value() ];
3018 $tz1 = $$self{'data'}{'tz'};
3019 $tz2 = $tz1;
3020 $isdst1 = $$self{'data'}{'isdst'};
3021 $isdst2 = $$date{'data'}{'isdst'};
3022
3023 } else {
3024 $date1 = [ $self->value('gmt') ];
3025 $date2 = [ $date->value('gmt') ];
3026 $tz1 = 'GMT';
3027 $tz2 = $tz1;
3028 $isdst1 = 0;
3029 $isdst2 = 0;
3030 }
3031
3032 # Do the calculation
3033
3034 my(@delta);
3035 if ($subtract) {
3036 if ($mode eq 'business' || $mode eq 'exact' || $subtract == 2) {
3037 @delta = @{ $self->__calc_date_date($mode,$date2,$tz2,$isdst2,
3038 $date1,$tz1,$isdst1) };
3039 } else {
3040 @delta = @{ $self->__calc_date_date($mode,$date1,$tz1,$isdst1,
3041 $date2,$tz2,$isdst2) };
3042 @delta = map { -1*$_ } @delta;
3043 }
3044 } else {
3045 @delta = @{ $self->__calc_date_date($mode,$date1,$tz1,$isdst1,
3046 $date2,$tz2,$isdst2) };
3047 }
3048
3049 # Save the delta
3050
3051 if ($mode eq 'business' || $mode eq 'bapprox' || $mode eq 'bsemi') {
3052 $ret->set('business',\@delta);
3053 } else {
3054 $ret->set('delta',\@delta);
3055 }
3056 return $ret;
3057}
3058
3059sub __calc_date_date {
3060 my($self,$mode,$date1,$tz1,$isdst1,$date2,$tz2,$isdst2) = @_;
3061 my $dmt = $$self{'tz'};
3062 my $dmb = $$dmt{'base'};
3063
3064 my($dy,$dm,$dw,$dd,$dh,$dmn,$ds) = (0,0,0,0,0,0,0);
3065
3066 if ($mode eq 'approx' || $mode eq 'bapprox') {
3067 my($y1,$m1,$d1,$h1,$mn1,$s1) = @$date1;
3068 my($y2,$m2,$d2,$h2,$mn2,$s2) = @$date2;
3069 $dy = $y2-$y1;
3070 $dm = $m2-$m1;
3071
3072 if ($dy || $dm) {
3073 # If $d1 is greater than the number of days allowed in the
3074 # month $y2/$m2, set it equal to the number of days. In other
3075 # words:
3076 # Jan 31 2006 to Feb 28 2008 = 2 years 1 month
3077 #
3078 my $dim = $dmb->days_in_month($y2,$m2);
3079 $d1 = $dim if ($d1 > $dim);
3080
3081 $date1 = [$y2,$m2,$d1,$h1,$mn1,$s1];
3082 }
3083 }
3084
3085 if ($mode eq 'semi' || $mode eq 'approx') {
3086
3087 # Calculate the number of weeks/days apart (temporarily ignoring
3088 # DST effects).
3089
3090 $dd = $dmb->days_since_1BC($date2) -
3091 $dmb->days_since_1BC($date1);
3092 $dw = int($dd/7);
3093 $dd -= $dw*7;
3094
3095 # Adding $dd to $date1 gives: ($y2,$m2,$d2, $h1,$mn1,$s1)
3096 # Make sure this is valid (taking into account DST effects).
3097 # If it isn't, make it valid.
3098
3099 if ($dw || $dd) {
3100 my($y1,$m1,$d1,$h1,$mn1,$s1) = @$date1;
3101 my($y2,$m2,$d2,$h2,$mn2,$s2) = @$date2;
3102 $date1 = [$y2,$m2,$d2,$h1,$mn1,$s1];
3103 }
3104 if ($dy || $dm || $dw || $dd) {
3105 my $force = ( ($dw > 0 || $dd > 0) ? 1 : -1 );
3106 my($off,$isdst,$abb);
3107 ($date1,$off,$isdst,$abb) =
3108 $self->_calc_date_check_dst($date1,$tz2,$isdst2,$force);
3109 }
3110 }
3111
3112 if ($mode eq 'bsemi' || $mode eq 'bapprox') {
3113 # Calculate the number of weeks. Ignore the days
3114 # part. Also, since there are no DST effects, we don't
3115 # have to check for validity.
3116
3117 $dd = $dmb->days_since_1BC($date2) -
3118 $dmb->days_since_1BC($date1);
3119 $dw = int($dd/7);
3120 $dd = 0;
3121 $date1 = $dmb->calc_date_days($date1,$dw*7);
3122 }
3123
3124 if ($mode eq 'exact' || $mode eq 'semi' || $mode eq 'approx') {
3125 my $sec1 = $dmb->secs_since_1970($date1);
3126 my $sec2 = $dmb->secs_since_1970($date2);
3127 $ds = $sec2 - $sec1;
3128
3129 {
31302840µs28µs
# spent 7µs (6+1) within Date::Manip::Date::BEGIN@3130 which was called: # once (6µs+1µs) by main::RUNTIME at line 3130
no integer;
# spent 7µs making 1 call to Date::Manip::Date::BEGIN@3130 # spent 1µs making 1 call to integer::unimport
3131 $dh = int($ds/3600);
3132 $ds -= $dh*3600;
3133 }
3134 $dmn = int($ds/60);
3135 $ds -= $dmn*60;
3136 }
3137
3138 if ($mode eq 'business' || $mode eq 'bsemi' || $mode eq 'bapprox') {
3139
3140 # Make sure both are work days
3141
3142 $date1 = $self->__nextprev_business_day(0,0,1,$date1);
3143 $date2 = $self->__nextprev_business_day(0,0,1,$date2);
3144
3145 my($y1,$m1,$d1,$h1,$mn1,$s1) = @$date1;
3146 my($y2,$m2,$d2,$h2,$mn2,$s2) = @$date2;
3147
3148 # Find out which direction we need to move $date1 to get to $date2
3149
3150 my $dir = 0;
3151 if ($y1 < $y2) {
3152 $dir = 1;
3153 } elsif ($y1 > $y2) {
3154 $dir = -1;
3155 } elsif ($m1 < $m2) {
3156 $dir = 1;
3157 } elsif ($m1 > $m2) {
3158 $dir = -1;
3159 } elsif ($d1 < $d2) {
3160 $dir = 1;
3161 } elsif ($d1 > $d2) {
3162 $dir = -1;
3163 }
3164
3165 # Now do the day part (to get to the same day)
3166
3167 $dd = 0;
3168 while ($dir) {
3169 ($y1,$m1,$d1) = @{ $dmb->calc_date_days([$y1,$m1,$d1],$dir) };
3170 $dd += $dir if ($self->__is_business_day([$y1,$m1,$d1,0,0,0],0));
3171 $dir = 0 if ($y1 == $y2 && $m1 == $m2 && $d1 == $d2);
3172 }
3173
3174 # Both dates are now on a business day, and during business
3175 # hours, so do the hr/min/sec part trivially
3176
3177 $dh = $h2-$h1;
3178 $dmn = $mn2-$mn1;
3179 $ds = $s2-$s1;
3180 }
3181
3182 return [ $dy,$dm,$dw,$dd,$dh,$dmn,$ds ];
3183}
3184
3185sub _calc_date_delta {
3186 my($self,$delta,$subtract) = @_;
3187 my $ret = $self->new_date();
3188
3189 if ($$self{'err'} || ! $$self{'data'}{'set'}) {
3190 $$ret{'err'} = '[calc] Date object invalid';
3191 return $ret;
3192 }
3193
3194 if ($$delta{'err'}) {
3195 $$ret{'err'} = '[calc] Delta object invalid';
3196 return $ret;
3197 }
3198
3199 # Get the date/delta fields
3200
3201 $subtract = 0 if (! $subtract);
3202 my @delta = @{ $$delta{'data'}{'delta'} };
3203 my @date = @{ $$self{'data'}{'date'} };
3204 my $business = $$delta{'data'}{'business'};
3205 my $tz = $$self{'data'}{'tz'};
3206 my $isdst = $$self{'data'}{'isdst'};
3207
3208 my($err,$date2,$offset,$abbrev);
3209 ($err,$date2,$offset,$isdst,$abbrev) =
3210 $self->__calc_date_delta([@date],[@delta],$subtract,$business,$tz,$isdst);
3211
3212 if ($err) {
3213 $$ret{'err'} = '[calc] Unable to perform calculation';
3214 } else {
3215 $$ret{'data'}{'set'} = 1;
3216 $$ret{'data'}{'date'} = $date2;
3217 $$ret{'data'}{'tz'} = $tz;
3218 $$ret{'data'}{'isdst'} = $isdst;
3219 $$ret{'data'}{'offset'}= $offset;
3220 $$ret{'data'}{'abb'} = $abbrev;
3221 }
3222 return $ret;
3223}
3224
3225sub __calc_date_delta {
3226 my($self,$date,$delta,$subtract,$business,$tz,$isdst) = @_;
3227
3228 my ($dy,$dm,$dw,$dd,$dh,$dmn,$ds) = @$delta;
3229 my @date = @$date;
3230
3231 my ($err,$date2,$offset,$abbrev);
3232
3233 # In business mode, daylight saving time is ignored, so days are
3234 # of a constant, known length, so they'll be done in the exact
3235 # function. Otherwise, they'll be done in the approximate function.
3236 #
3237 # Also in business mode, if $subtract = 2, then the starting date
3238 # must be a business date or an error occurs.
3239
3240 my($dd_exact,$dd_approx);
3241 if ($business) {
3242 $dd_exact = $dd;
3243 $dd_approx = 0;
3244
3245 if ($subtract == 2 && ! $self->__is_business_day($date,1)) {
3246 return (1);
3247 }
3248
3249 } else {
3250 $dd_exact = 0;
3251 $dd_approx = $dd;
3252 }
3253
3254 if ($subtract == 2 && ($dy || $dm || $dw || $dd_approx)) {
3255 # For subtract=2:
3256 # DATE = RET + DELTA
3257 #
3258 # The delta consisists of an approximate part (which is added first)
3259 # and an exact part (added second):
3260 # DATE = RET + DELTA(approx) + DELTA(exact)
3261 # DATE = RET' + DELTA(exact)
3262 # where RET' = RET + DELTA(approx)
3263 #
3264 # For an exact delta, subtract==2 and subtract==1 are equivalent,
3265 # so this can be written:
3266 # DATE - DELTA(exact) = RET'
3267 #
3268 # So the inverse subtract only needs include the approximate
3269 # portion of the delta.
3270
3271 ($err,$date2,$offset,$isdst,$abbrev) =
3272 $self->__calc_date_delta_exact([@date],[-1*$dd_exact,-1*$dh,-1*$dmn,-1*$ds],
3273 $business,$tz,$isdst);
3274
3275 ($err,$date2,$offset,$isdst,$abbrev) =
3276 $self->__calc_date_delta_inverse($date2,[$dy,$dm,$dw,$dd_approx],
3277 $business,$tz,$isdst)
3278 if (! $err);
3279
3280 } else {
3281 # We'll add the approximate part, followed by the exact part.
3282 # After the approximate part, we need to make sure we're on
3283 # a valid business day in business mode.
3284
3285 ($dy,$dm,$dw,$dd_exact,$dd_approx,$dh,$dmn,$ds) =
3286 map { -1*$_ } ($dy,$dm,$dw,$dd_exact,$dd_approx,$dh,$dmn,$ds)
3287 if ($subtract);
3288 @$date2 = @date;
3289
3290 if ($dy || $dm || $dw || $dd) {
3291 ($err,$date2,$offset,$isdst,$abbrev) =
3292 $self->__calc_date_delta_approx($date2,[$dy,$dm,$dw,$dd_approx],
3293 $business,$tz,$isdst);
3294 } elsif ($business) {
3295 $date2 = $self->__nextprev_business_day(0,0,1,$date2);
3296 }
3297
3298 ($err,$date2,$offset,$isdst,$abbrev) =
3299 $self->__calc_date_delta_exact($date2,[$dd_exact,$dh,$dmn,$ds],
3300 $business,$tz,$isdst)
3301 if (! $err && ($dd_exact || $dh || $dmn || $ds));
3302 }
3303
3304 return($err,$date2,$offset,$isdst,$abbrev);
3305}
3306
3307# Do the inverse part of a calculation.
3308#
3309# $delta = [$dy,$dm,$dw,$dd]
3310#
3311sub __calc_date_delta_inverse {
3312 my($self,$date,$delta,$business,$tz,$isdst) = @_;
3313 my $dmt = $$self{'tz'};
3314 my $dmb = $$dmt{'base'};
3315 my @date2;
3316
3317 # Given: DATE1, DELTA
3318 # Find: DATE2
3319 # where DATE2 + DELTA = DATE1
3320 #
3321 # Start with:
3322 # DATE2 = DATE1 - DELTA
3323 #
3324 # if (DATE2+DELTA < DATE1)
3325 # while (1)
3326 # DATE2 = DATE2 + 1 day
3327 # if DATE2+DELTA < DATE1
3328 # next
3329 # elsif DATE2+DELTA > DATE1
3330 # return ERROR
3331 # else
3332 # return DATE2
3333 # done
3334 #
3335 # elsif (DATE2+DELTA > DATE1)
3336 # while (1)
3337 # DATE2 = DATE2 - 1 day
3338 # if DATE2+DELTA > DATE1
3339 # next
3340 # elsif DATE2+DELTA < DATE1
3341 # return ERROR
3342 # else
3343 # return DATE2
3344 # done
3345 #
3346 # else
3347 # return DATE2
3348
3349 if ($business) {
3350
3351 my $date1 = $date;
3352 my ($err,$date2,$off,$isd,$abb,@del,$tmp,$cmp);
3353 @del = map { $_*-1 } @$delta;
3354
3355 ($err,$date2,$off,$isd,$abb) =
3356 $self->__calc_date_delta_approx($date,[@del],$business,$tz,$isdst);
3357
3358 ($err,$tmp,$off,$isd,$abb) =
3359 $self->__calc_date_delta_approx($date2,$delta,$business,$tz,$isdst);
3360
3361 $cmp = $self->_cmp_date($tmp,$date1);
3362
3363 if ($cmp < 0) {
3364 while (1) {
3365 $date2 = $self->__nextprev_business_day(0,1,0,$date2);
3366 ($err,$tmp,$off,$isd,$abb) =
3367 $self->__calc_date_delta_approx($date2,$delta,$business,$tz,$isdst);
3368 $cmp = $self->_cmp_date($tmp,$date1);
3369 if ($cmp < 0) {
3370 next;
3371 } elsif ($cmp > 0) {
3372 return (1);
3373 } else {
3374 last;
3375 }
3376 }
3377
3378 } elsif ($cmp > 0) {
3379 while (1) {
3380 $date2 = $self->__nextprev_business_day(1,1,0,$date2);
3381 ($err,$tmp,$off,$isd,$abb) =
3382 $self->__calc_date_delta_approx($date2,$delta,$business,$tz,$isdst);
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;
3395
3396 } else {
3397
3398 my @tmp = @$date[0..2]; # [y,m,d]
3399 my @hms = @$date[3..5]; # [h,m,s]
3400 my $date1 = [@tmp];
3401
3402 my $date2 = $dmb->_calc_date_ymwd($date1,$delta,1);
3403 my $tmp = $dmb->_calc_date_ymwd($date2,$delta);
3404 my $cmp = $self->_cmp_date($tmp,$date1);
3405
3406 if ($cmp < 0) {
3407 while (1) {
3408 $date2 = $dmb->calc_date_days($date2,1);
3409 $tmp = $dmb->_calc_date_ymwd($date2,$delta);
3410 $cmp = $self->_cmp_date($tmp,$date1);
3411 if ($cmp < 0) {
3412 next;
3413 } elsif ($cmp > 0) {
3414 return (1);
3415 } else {
3416 last;
3417 }
3418 }
3419
3420 } elsif ($cmp > 0) {
3421 while (1) {
3422 $date2 = $dmb->calc_date_days($date2,-1);
3423 $tmp = $dmb->_calc_date_ymwd($date2,$delta);
3424 $cmp = $self->_cmp_date($tmp,$date1);
3425 if ($cmp > 0) {
3426 next;
3427 } elsif ($cmp < 0) {
3428 return (1);
3429 } else {
3430 last;
3431 }
3432 }
3433 }
3434
3435 @date2 = (@$date2,@hms);
3436 }
3437
3438 # Make sure DATE2 is valid (within DST constraints) and
3439 # return it.
3440
3441 my($date2,$abb,$off,$err);
3442 ($date2,$off,$isdst,$abb) = $self->_calc_date_check_dst([@date2],$tz,$isdst,0);
3443
3444 return (1) if (! defined($date2));
3445 return (0,$date2,$off,$isdst,$abb);
3446}
3447
3448sub _cmp_date {
3449 my($self,$date0,$date1) = @_;
3450 return ($$date0[0] <=> $$date1[0] ||
3451 $$date0[1] <=> $$date1[1] ||
3452 $$date0[2] <=> $$date1[2]);
3453}
3454
3455# Do the approximate part of a calculation.
3456#
3457sub __calc_date_delta_approx {
3458 my($self,$date,$delta,$business,$tz,$isdst) = @_;
3459
3460 my $dmt = $$self{'tz'};
3461 my $dmb = $$dmt{'base'};
3462 my($y,$m,$d,$h,$mn,$s) = @$date;
3463 my($dy,$dm,$dw,$dd) = @$delta;
3464
3465 #
3466 # Do the year/month part.
3467 #
3468 # If we are past the last day of a month, move the date back to
3469 # the last day of the month. i.e. Jan 31 + 1 month = Feb 28.
3470 #
3471
3472 $y += $dy if ($dy);
3473 $dmb->_mod_add(-12,$dm,\$m,\$y) # -12 means 1-12 instead of 0-11
3474 if ($dm);
3475
3476 my $dim = $dmb->days_in_month($y,$m);
3477 $d = $dim if ($d > $dim);
3478
3479 #
3480 # Do the week part.
3481 #
3482 # The week is treated as 7 days for both business and non-business
3483 # calculations.
3484 #
3485 # In a business calculation, make sure we're on a business date.
3486 #
3487
3488 if ($business) {
3489 ($y,$m,$d) = @{ $dmb->calc_date_days([$y,$m,$d],$dw*7) } if ($dw);
3490 ($y,$m,$d,$h,$mn,$s) =
3491 @{ $self->__nextprev_business_day(0,0,1,[$y,$m,$d,$h,$mn,$s]) };
3492 } else {
3493 $dd += $dw*7;
3494 }
3495
3496 #
3497 # Now do the day part. $dd is always 0 in business calculations.
3498 #
3499
3500 if ($dd) {
3501 ($y,$m,$d) = @{ $dmb->calc_date_days([$y,$m,$d],$dd) };
3502 }
3503
3504 #
3505 # At this point, we need to make sure that we're a valid date
3506 # (within the constraints of DST).
3507 #
3508 # If it is not valid in this offset, try the other one. If neither
3509 # works, then we want the the date to be 24 hours later than the
3510 # previous day at this time (if $dd > 0) or 24 hours earlier than
3511 # the next day at this time (if $dd < 0). We'll use the 24 hour
3512 # definition even for business days, but then we'll double check
3513 # that the resulting date is a business date.
3514 #
3515
3516 my $force = ( ($dd > 0 || $dw > 0 || $dm > 0 || $dy > 0) ? 1 : -1 );
3517 my($off,$abb);
3518 ($date,$off,$isdst,$abb) =
3519 $self->_calc_date_check_dst([$y,$m,$d,$h,$mn,$s],$tz,$isdst,$force);
3520 return (0,$date,$off,$isdst,$abb);
3521}
3522
3523# Do the exact part of a calculation.
3524#
3525sub __calc_date_delta_exact {
3526 my($self,$date,$delta,$business,$tz,$isdst) = @_;
3527 my $dmt = $$self{'tz'};
3528 my $dmb = $$dmt{'base'};
3529
3530 if ($business) {
3531
3532 # Simplify hours/minutes/seconds where the day length is defined
3533 # by the start/end of the business day.
3534
3535 my ($dd,$dh,$dmn,$ds) = @$delta;
3536 my ($y,$m,$d,$h,$mn,$s)= @$date;
3537 my ($hbeg,$mbeg,$sbeg) = @{ $$dmb{'data'}{'calc'}{'workdaybeg'} };
3538 my ($hend,$mend,$send) = @{ $$dmb{'data'}{'calc'}{'workdayend'} };
3539 my $bdlen = $$dmb{'data'}{'len'}{'bdlength'};
3540
3541233µs29µs
# spent 8µs (7+1) within Date::Manip::Date::BEGIN@3541 which was called: # once (7µs+1µs) by main::RUNTIME at line 3541
no integer;
# spent 8µs making 1 call to Date::Manip::Date::BEGIN@3541 # spent 1µs making 1 call to integer::unimport
3542 my $tmp;
3543 $ds += $dh*3600 + $dmn*60;
3544 $tmp = int($ds/$bdlen);
3545 $dd += $tmp;
3546 $ds -= $tmp*$bdlen;
3547 $dh = int($ds/3600);
3548 $ds -= $dh*3600;
3549 $dmn = int($ds/60);
3550 $ds -= $dmn*60;
355122.35ms26µs
# spent 5µs (4+900ns) within Date::Manip::Date::BEGIN@3551 which was called: # once (4µs+900ns) by main::RUNTIME at line 3551
use integer;
# spent 5µs making 1 call to Date::Manip::Date::BEGIN@3551 # spent 900ns making 1 call to integer::import
3552
3553 if ($dd) {
3554 my $prev = 0;
3555 if ($dd < 1) {
3556 $prev = 1;
3557 $dd *= -1;
3558 }
3559
3560 ($y,$m,$d,$h,$mn,$s) =
3561 @{ $self->__nextprev_business_day($prev,$dd,0,[$y,$m,$d,$h,$mn,$s]) };
3562 }
3563
3564 # At this point, we're adding less than a day for the
3565 # hours/minutes/seconds part AND we know that the current
3566 # day is during business hours.
3567 #
3568 # We'll add them (without affecting days... we'll need to
3569 # test things by hand to make sure we should or shouldn't
3570 # do that.
3571
3572 $dmb->_mod_add(60,$ds,\$s,\$mn);
3573 $dmb->_mod_add(60,$dmn,\$mn,\$h);
3574 $h += $dh;
3575 # Note: it's possible that $h > 23 at this point or $h < 0
3576
3577 if ($h > $hend ||
3578 ($h == $hend && $mn > $mend) ||
3579 ($h == $hend && $mn == $mend && $s > $send) ||
3580 ($h == $hend && $mn == $mend && $s == $send)) {
3581
3582 # We've gone past the end of the business day.
3583
3584 my $t2 = $dmb->calc_time_time([$h,$mn,$s],[$hend,$mend,$send],1);
3585
3586 while (1) {
3587 ($y,$m,$d) = @{ $dmb->calc_date_days([$y,$m,$d],1) };
3588 last if ($self->__is_business_day([$y,$m,$d,$h,$mn,$s]));
3589 }
3590
3591 ($h,$mn,$s) = @{ $dmb->calc_time_time([$hbeg,$mbeg,$sbeg],$t2) };
3592
3593 } elsif ($h < $hbeg ||
3594 ($h == $hbeg && $mn < $mbeg) ||
3595 ($h == $hbeg && $mn == $mbeg && $s < $sbeg)) {
3596
3597 # We've gone back past the start of the business day.
3598
3599 my $t2 = $dmb->calc_time_time([$hbeg,$mbeg,$sbeg],[$h,$mn,$s],1);
3600
3601 while (1) {
3602 ($y,$m,$d) = @{ $dmb->calc_date_days([$y,$m,$d],-1) };
3603 last if ($self->__is_business_day([$y,$m,$d,$h,$mn,$s]));
3604 }
3605
3606 ($h,$mn,$s) = @{ $dmb->calc_time_time([$hend,$mend,$send],$t2,1) };
3607 }
3608
3609 # Now make sure that the date is valid within DST constraints.
3610
3611 my $force = ( ($dd > 0 || $dh > 0 || $dmn > 0 || $ds > 0) ? 1 : -1 );
3612 my($off,$abb);
3613 ($date,$off,$isdst,$abb) =
3614 $self->_calc_date_check_dst([$y,$m,$d,$h,$mn,$s],$tz,$isdst,$force);
3615 return (0,$date,$off,$isdst,$abb);
3616
3617 } else {
3618
3619 # Convert to GTM
3620 # Do the calculation
3621 # Convert back
3622
3623 my ($dd,$dh,$dm,$ds) = @$delta; # $dd is always 0
3624 my $del = [$dh,$dm,$ds];
3625 my ($err,$offset,$abbrev);
3626
3627 ($err,$date,$offset,$isdst,$abbrev) =
3628 $dmt->_convert('__calc_date_delta_exact',$date,$tz,'GMT',$isdst);
3629
3630 $date = $dmb->calc_date_time($date,$del,0);
3631
3632 ($err,$date,$offset,$isdst,$abbrev) =
3633 $dmt->_convert('__calc_date_delta_exact',$date,'GMT',$tz,$isdst);
3634
3635 return($err,$date,$offset,$isdst,$abbrev);
3636 }
3637}
3638
3639# This checks to see which time (STD or DST) a date is in. It checks
3640# $isdst first, and the other value (1-$isdst) second.
3641#
3642# If the date is found in either time, it is returned.
3643#
3644# If the date is NOT found, then we got here by adding/subtracting 1 day
3645# from a different value, and we've obtained an invalid value. In this
3646# case, if $force = 0, then return nothing.
3647#
3648# If $force = 1, then go to the previous day and add 24 hours. If force
3649# is -1, then go to the next day and subtract 24 hours.
3650#
3651# Returns:
3652# ($date,$off,$isdst,$abb)
3653# or
3654# (undef)
3655#
3656sub _calc_date_check_dst {
3657 my($self,$date,$tz,$isdst,$force) = @_;
3658 my $dmt = $$self{'tz'};
3659 my $dmb = $$dmt{'base'};
3660 my($abb,$off,$err);
3661
3662 # Try the date as is in both ISDST and 1-ISDST times
3663
3664 my $per = $dmt->date_period($date,$tz,1,$isdst);
3665 if ($per) {
3666 $abb = $$per[4];
3667 $off = $$per[3];
3668 return($date,$off,$isdst,$abb);
3669 }
3670
3671 $per = $dmt->date_period($date,$tz,1,1-$isdst);
3672 if ($per) {
3673 $isdst = 1-$isdst;
3674 $abb = $$per[4];
3675 $off = $$per[3];
3676 return($date,$off,$isdst,$abb);
3677 }
3678
3679 # If we made it here, the date is invalid in this timezone.
3680 # Either return undef, or add/subtract a day from the date
3681 # and find out what time period we're in (all we care about
3682 # is the ISDST value).
3683
3684 if (! $force) {
3685 return(undef);
3686 }
3687
3688 my($dd);
3689 if ($force > 0) {
3690 $date = $dmb->calc_date_days($date,-1);
3691 $dd = 1;
3692 } else {
3693 $date = $dmb->calc_date_days($date,+1);
3694 $dd = -1;
3695 }
3696
3697 $per = $dmt->date_period($date,$tz,1,$isdst);
3698 $isdst = (1-$isdst) if (! $per);
3699
3700 # Now, convert it to GMT, add/subtract 24 hours, and convert
3701 # it back.
3702
3703 ($err,$date,$off,$isdst,$abb) = $dmt->convert_to_gmt($date,$tz,$isdst);
3704 $date = $dmb->calc_date_days($date,$dd);
3705 ($err,$date,$off,$isdst,$abb) = $dmt->convert_from_gmt($date,$tz);
3706
3707 return($date,$off,$isdst,$abb);
3708}
3709
3710########################################################################
3711# MISC METHODS
3712
3713sub secs_since_1970_GMT {
3714 my($self,$secs) = @_;
3715
3716 my $dmt = $$self{'tz'};
3717 my $dmb = $$dmt{'base'};
3718
3719 if (defined $secs) {
3720 my $date = $dmb->secs_since_1970($secs);
3721 my $err;
3722 ($err,$date) = $dmt->convert_from_gmt($date);
3723 return 1 if ($err);
3724 $self->set('date',$date);
3725 return 0;
3726 }
3727
3728 my @date = $self->value('gmt');
3729 $secs = $dmb->secs_since_1970(\@date);
3730 return $secs;
3731}
3732
3733sub week_of_year {
3734 my($self,$first) = @_;
3735 if ($$self{'err'} || ! $$self{'data'}{'set'}) {
3736 warn "WARNING: [week_of_year] Object must contain a valid date\n";
3737 return undef;
3738 }
3739
3740 my $dmt = $$self{'tz'};
3741 my $dmb = $$dmt{'base'};
3742 my $date = $$self{'data'}{'date'};
3743 my $y = $$date[0];
3744
3745 my($day,$dow,$doy,$f);
3746 $doy = $dmb->day_of_year($date);
3747
3748 # The date in January which must belong to the first week, and
3749 # it's DayOfWeek.
3750 if ($dmb->_config('jan1week1')) {
3751 $day=1;
3752 } else {
3753 $day=4;
3754 }
3755 $dow = $dmb->day_of_week([$y,1,$day]);
3756
3757 # The start DayOfWeek. If $first is passed in, use it. Otherwise,
3758 # use FirstDay.
3759
3760 if (! $first) {
3761 $first = $dmb->_config('firstday');
3762 }
3763
3764 # Find the pseudo-date of the first day of the first week (it may
3765 # be negative meaning it occurs last year).
3766
3767 $first -= 7 if ($first > $dow);
3768 $day -= ($dow-$first);
3769
3770 return 0 if ($day>$doy); # Day is in last week of previous year
3771 return (($doy-$day)/7 + 1);
3772}
3773
3774sub complete {
3775 my($self,$field) = @_;
3776 if ($$self{'err'} || ! $$self{'data'}{'set'}) {
3777 warn "WARNING: [complete] Object must contain a valid date\n";
3778 return undef;
3779 }
3780
3781 if (! $field) {
3782 return 1 if (! $$self{'data'}{'def'}[1] &&
3783 ! $$self{'data'}{'def'}[2] &&
3784 ! $$self{'data'}{'def'}[3] &&
3785 ! $$self{'data'}{'def'}[4] &&
3786 ! $$self{'data'}{'def'}[5]);
3787 return 0;
3788 }
3789
3790 if ($field eq 'm') {
3791 return 1 if (! $$self{'data'}{'def'}[1]);
3792 }
3793
3794 if ($field eq 'd') {
3795 return 1 if (! $$self{'data'}{'def'}[2]);
3796 }
3797
3798 if ($field eq 'h') {
3799 return 1 if (! $$self{'data'}{'def'}[3]);
3800 }
3801
3802 if ($field eq 'mn') {
3803 return 1 if (! $$self{'data'}{'def'}[4]);
3804 }
3805
3806 if ($field eq 's') {
3807 return 1 if (! $$self{'data'}{'def'}[5]);
3808 }
3809 return 0;
3810}
3811
3812sub convert {
3813 my($self,$zone) = @_;
3814 if ($$self{'err'} || ! $$self{'data'}{'set'}) {
3815 warn "WARNING: [convert] Object must contain a valid date\n";
3816 return 1;
3817 }
3818 my $dmt = $$self{'tz'};
3819 my $dmb = $$dmt{'base'};
3820
3821 my $zonename = $dmt->_zone($zone);
3822
3823 if (! $zonename) {
3824 $$self{'err'} = "[convert] Unable to determine timezone: $zone";
3825 return 1;
3826 }
3827
3828 my $date0 = $$self{'data'}{'date'};
3829 my $zone0 = $$self{'data'}{'tz'};
3830 my $isdst0 = $$self{'data'}{'isdst'};
3831
3832 my($err,$date,$off,$isdst,$abb) = $dmt->convert($date0,$zone0,$zonename,$isdst0);
3833
3834 if ($err) {
3835 $$self{'err'} = '[convert] Unable to convert date to new timezone';
3836 return 1;
3837 }
3838
3839 $self->_init();
3840 $$self{'data'}{'date'} = $date;
3841 $$self{'data'}{'tz'} = $zonename;
3842 $$self{'data'}{'isdst'} = $isdst;
3843 $$self{'data'}{'offset'} = $off;
3844 $$self{'data'}{'abb'} = $abb;
3845 $$self{'data'}{'set'} = 1;
3846
3847 return 0;
3848}
3849
3850########################################################################
3851# BUSINESS DAY METHODS
3852
3853sub is_business_day {
3854 my($self,$checktime) = @_;
3855 if ($$self{'err'} || ! $$self{'data'}{'set'}) {
3856 warn "WARNING: [is_business_day] Object must contain a valid date\n";
3857 return undef;
3858 }
3859 my $date = $$self{'data'}{'date'};
3860 return $self->__is_business_day($date,$checktime);
3861}
3862
3863sub __is_business_day {
3864 my($self,$date,$checktime) = @_;
3865 my($y,$m,$d,$h,$mn,$s) = @$date;
3866
3867 my $dmt = $$self{'tz'};
3868 my $dmb = $$dmt{'base'};
3869
3870 # Return 0 if it's a weekend.
3871
3872 my $dow = $dmb->day_of_week([$y,$m,$d]);
3873 return 0 if ($dow < $dmb->_config('workweekbeg') ||
3874 $dow > $dmb->_config('workweekend'));
3875
3876 # Return 0 if it's not during work hours (and we're checking
3877 # for that).
3878
3879 if ($checktime &&
3880 ! $dmb->_config('workday24hr')) {
3881 my $t = $dmb->join('hms',[$h,$mn,$s]);
3882 my $t0 = $dmb->join('hms',$$dmb{'data'}{'calc'}{'workdaybeg'});
3883 my $t1 = $dmb->join('hms',$$dmb{'data'}{'calc'}{'workdayend'});
3884 return 0 if ($t lt $t0 || $t gt $t1);
3885 }
3886
3887 # Check for holidays
3888
3889 $self->_holidays($y,2) unless ($$dmb{'data'}{'init_holidays'});
3890
3891 return 0 if (exists $$dmb{'data'}{'holidays'}{'dates'} &&
3892 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
3896 return 1;
3897}
3898
3899sub list_holidays {
3900 my($self,$y) = @_;
3901 my $dmt = $$self{'tz'};
3902 my $dmb = $$dmt{'base'};
3903
3904 $y = $dmt->_now('y',1) if (! $y);
3905 $self->_holidays($y,2);
3906
3907 my @ret;
3908 my @m = sort { $a <=> $b } keys %{ $$dmb{'data'}{'holidays'}{'dates'}{$y+0} };
3909 foreach my $m (@m) {
3910 my @d = sort { $a <=> $b } keys %{ $$dmb{'data'}{'holidays'}{'dates'}{$y+0}{$m} };
3911 foreach my $d (@d) {
3912 my $hol = $self->new_date();
3913 $hol->set('date',[$y,$m,$d,0,0,0]);
3914 push(@ret,$hol);
3915 }
3916 }
3917
3918 return @ret;
3919}
3920
3921sub holiday {
3922 my($self) = @_;
3923 if ($$self{'err'} || ! $$self{'data'}{'set'}) {
3924 warn "WARNING: [holiday] Object must contain a valid date\n";
3925 return undef;
3926 }
3927 my $dmt = $$self{'tz'};
3928 my $dmb = $$dmt{'base'};
3929
3930 my($y,$m,$d) = @{ $$self{'data'}{'date'} };
3931 $self->_holidays($y,2);
3932
3933 if (exists $$dmb{'data'}{'holidays'}{'dates'}{$y+0} &&
3934 exists $$dmb{'data'}{'holidays'}{'dates'}{$y+0}{$m+0} &&
3935 exists $$dmb{'data'}{'holidays'}{'dates'}{$y+0}{$m+0}{$d+0}) {
3936 my @tmp = @{ $$dmb{'data'}{'holidays'}{'dates'}{$y+0}{$m+0}{$d+0} };
3937 if (wantarray) {
3938 return () if (! @tmp);
3939 return @tmp;
3940 } else {
3941 return '' if (! @tmp);
3942 return $tmp[0];
3943 }
3944 }
3945 return undef;
3946}
3947
3948sub next_business_day {
3949 my($self,$off,$checktime) = @_;
3950 if ($$self{'err'} || ! $$self{'data'}{'set'}) {
3951 warn "WARNING: [next_business_day] Object must contain a valid date\n";
3952 return undef;
3953 }
3954 my $date = $$self{'data'}{'date'};
3955
3956 $date = $self->__nextprev_business_day(0,$off,$checktime,$date);
3957 $self->set('date',$date);
3958}
3959
3960sub prev_business_day {
3961 my($self,$off,$checktime) = @_;
3962 if ($$self{'err'} || ! $$self{'data'}{'set'}) {
3963 warn "WARNING: [prev_business_day] Object must contain a valid date\n";
3964 return undef;
3965 }
3966 my $date = $$self{'data'}{'date'};
3967
3968 $date = $self->__nextprev_business_day(1,$off,$checktime,$date);
3969 $self->set('date',$date);
3970}
3971
3972sub __nextprev_business_day {
3973 my($self,$prev,$off,$checktime,$date) = @_;
3974 my($y,$m,$d,$h,$mn,$s) = @$date;
3975
3976 my $dmt = $$self{'tz'};
3977 my $dmb = $$dmt{'base'};
3978
3979 # Get day 0
3980
3981 while (! $self->__is_business_day([$y,$m,$d,$h,$mn,$s],$checktime)) {
3982 if ($checktime) {
3983 ($y,$m,$d,$h,$mn,$s) =
3984 @{ $self->__next_prev([$y,$m,$d,$h,$mn,$s],1,undef,0,
3985 $$dmb{'data'}{'calc'}{'workdaybeg'}) };
3986 } else {
3987 # Move forward 1 day
3988 ($y,$m,$d) = @{ $dmb->calc_date_days([$y,$m,$d],1) };
3989 }
3990 }
3991
3992 # Move $off days into the future/past
3993
3994 while ($off > 0) {
3995 while (1) {
3996 if ($prev) {
3997 # Move backward 1 day
3998 ($y,$m,$d) = @{ $dmb->calc_date_days([$y,$m,$d],-1) };
3999 } else {
4000 # Move forward 1 day
4001 ($y,$m,$d) = @{ $dmb->calc_date_days([$y,$m,$d],1) };
4002 }
4003 last if ($self->__is_business_day([$y,$m,$d,$h,$mn,$s]));
4004 }
4005 $off--;
4006 }
4007
4008 return [$y,$m,$d,$h,$mn,$s];
4009}
4010
4011sub nearest_business_day {
4012 my($self,$tomorrow) = @_;
4013 if ($$self{'err'} || ! $$self{'data'}{'set'}) {
4014 warn "WARNING: [nearest_business_day] Object must contain a valid date\n";
4015 return undef;
4016 }
4017
4018 my $date = $$self{'data'}{'date'};
4019 $date = $self->__nearest_business_day($tomorrow,$date);
4020
4021 # If @date is empty, the date is a business day and doesn't need
4022 # to be changed.
4023
4024 return if (! defined($date));
4025
4026 $self->set('date',$date);
4027}
4028
4029sub __nearest_business_day {
4030 my($self,$tomorrow,$date) = @_;
4031
4032 # We're done if this is a business day
4033 return undef if ($self->__is_business_day($date,0));
4034
4035 my $dmt = $$self{'tz'};
4036 my $dmb = $$dmt{'base'};
4037
4038 $tomorrow = $dmb->_config('tomorrowfirst') if (! defined $tomorrow);
4039
4040 my($a1,$a2);
4041 if ($tomorrow) {
4042 ($a1,$a2) = (1,-1);
4043 } else {
4044 ($a1,$a2) = (-1,1);
4045 }
4046
4047 my ($y,$m,$d,$h,$mn,$s) = @$date;
4048 my ($y1,$m1,$d1) = ($y,$m,$d);
4049 my ($y2,$m2,$d2) = ($y,$m,$d);
4050
4051 while (1) {
4052 ($y1,$m1,$d1) = @{ $dmb->calc_date_days([$y1,$m1,$d1],$a1) };
4053 if ($self->__is_business_day([$y1,$m1,$d1,$h,$mn,$s],0)) {
4054 ($y,$m,$d) = ($y1,$m1,$d1);
4055 last;
4056 }
4057 ($y2,$m2,$d2) = @{ $dmb->calc_date_days([$y2,$m2,$d2],$a2) };
4058 if ($self->__is_business_day([$y2,$m2,$d2,$h,$mn,$s],0)) {
4059 ($y,$m,$d) = ($y2,$m2,$d2);
4060 last;
4061 }
4062 }
4063
4064 return [$y,$m,$d,$h,$mn,$s];
4065}
4066
4067# We need to create all the objects which will be used to determine holidays.
4068# By doing this once only, a lot of time is saved.
4069#
4070sub _holiday_objs {
4071 my($self) = @_;
4072 my $dmt = $$self{'tz'};
4073 my $dmb = $$dmt{'base'};
4074
4075 $$dmb{'data'}{'holidays'}{'init'} = 1;
4076
4077 # Go through all of the strings from the config file.
4078 #
4079 my (@str) = @{ $$dmb{'data'}{'sections'}{'holidays'} };
4080 $$dmb{'data'}{'holidays'}{'hols'} = [];
4081
4082 while (@str) {
4083 my($string) = shift(@str);
4084 my($name) = shift(@str);
4085
4086 # If $string is a parse_date string AND it contains a year, we'll
4087 # store the date as a holiday, but not store the holiday description
4088 # so it never needs to be re-parsed.
4089
4090 my $date = $self->new_date();
4091 my $err = $date->parse_date($string);
4092 if (! $err) {
4093 if ($$date{'data'}{'def'}[0] eq '') {
4094 push(@{ $$dmb{'data'}{'holidays'}{'hols'} },$string,$name);
4095 } else {
4096 my($y,$m,$d) = @{ $$date{'data'}{'date'} };
4097 if (exists $$dmb{'data'}{'holidays'}{'dates'}{$y+0}{$m+0}{$d+0}) {
4098 push @{ $$dmb{'data'}{'holidays'}{'dates'}{$y+0}{$m+0}{$d+0} },$name;
4099 } else {
4100 $$dmb{'data'}{'holidays'}{'dates'}{$y+0}{$m+0}{$d+0} = [ $name ];
4101 }
4102 }
4103
4104 next;
4105 }
4106 $date->err(1);
4107
4108 # If $string is a recurrence, we'll create a Recur object (which we
4109 # only have to do once) and store it.
4110
4111 my $recur = $self->new_recur();
4112 $recur->_holiday();
4113 $err = $recur->parse($string);
4114 if (! $err) {
4115 push(@{ $$dmb{'data'}{'holidays'}{'hols'} },$recur,$name);
4116 next;
4117 }
4118 $recur->err(1);
4119
4120 warn "WARNING: invalid holiday description: $string\n";
4121 }
4122}
4123
4124# Make sure that holidays are set for a given year.
4125#
4126# $$dmb{'data'}{'holidays'}{'years'}{$year} = 0 nothing done
4127# 1 this year done
4128# 2 both adjacent years done
4129#
4130sub _holidays {
4131 my($self,$year,$level) = @_;
4132
4133 my $dmt = $$self{'tz'};
4134 my $dmb = $$dmt{'base'};
4135 $self->_holiday_objs($year) if (! $$dmb{'data'}{'holidays'}{'init'});
4136
4137 $$dmb{'data'}{'holidays'}{'years'}{$year} = 0
4138 if (! exists $$dmb{'data'}{'holidays'}{'years'}{$year});
4139
4140 my $curr_level = $$dmb{'data'}{'holidays'}{'years'}{$year};
4141 return if ($curr_level >= $level);
4142 $$dmb{'data'}{'holidays'}{'years'}{$year} = $level;
4143
4144 # Parse the year
4145
4146 if ($curr_level == 0) {
4147 $self->_holidays_year($year);
4148
4149 return if ($level == 1);
4150 }
4151
4152 # Parse the years around it.
4153
4154 $self->_holidays($year-1,1);
4155 $self->_holidays($year+1,1);
4156}
4157
4158sub _holidays_year {
4159 my($self,$y) = @_;
4160
4161 my $dmt = $$self{'tz'};
4162 my $dmb = $$dmt{'base'};
4163
4164 # Get the objects and set them to use the new year. Also, get the
4165 # range for recurrences.
4166
4167 my @hol = @{ $$dmb{'data'}{'holidays'}{'hols'} };
4168
4169 my $beg = $self->new_date();
4170 $beg->set('date',[$y-1,12,1,0,0,0]);
4171 my $end = $self->new_date();
4172 $end->set('date',[$y+1,2,1,0,0,0]);
4173
4174 # Get the date for each holiday.
4175
4176 $$dmb{'data'}{'init_holidays'} = 1;
4177
4178 while (@hol) {
4179
4180 my($obj) = shift(@hol);
4181 my($name) = shift(@hol);
4182
4183 $$dmb{'data'}{'tmpnow'} = [$y,1,1,0,0,0];
4184 if (ref($obj)) {
4185 # It's a recurrence
4186
4187 # If the recurrence has a date range built in, we won't override it.
4188 # Otherwise, we'll only look for dates in this year.
4189
4190 if ($obj->start() && $obj->end()) {
4191 $obj->dates();
4192 } else {
4193 $obj->dates($beg,$end);
4194 }
4195
4196 foreach my $i (keys %{ $$obj{'data'}{'dates'} }) {
4197 next if ($$obj{'data'}{'saved'}{$i});
4198 my $date = $$obj{'data'}{'dates'}{$i};
4199 my($y,$m,$d) = @{ $$date{'data'}{'date'} };
4200 if (exists $$dmb{'data'}{'holidays'}{'dates'}{$y+0}{$m+0}{$d+0}) {
4201 push @{ $$dmb{'data'}{'holidays'}{'dates'}{$y+0}{$m+0}{$d+0} },$name;
4202 } else {
4203 $$dmb{'data'}{'holidays'}{'dates'}{$y+0}{$m+0}{$d+0} = [$name];
4204 }
4205 $$obj{'data'}{'saved'}{$i} = 1;
4206 }
4207
4208 } else {
4209 my $date = $self->new_date();
4210 $date->parse_date($obj);
4211 my($y,$m,$d) = @{ $$date{'data'}{'date'} };
4212 if (exists $$dmb{'data'}{'holidays'}{'dates'}{$y+0}{$m+0}{$d+0}) {
4213 push @{ $$dmb{'data'}{'holidays'}{'dates'}{$y+0}{$m+0}{$d+0} },$name;
4214 } else {
4215 $$dmb{'data'}{'holidays'}{'dates'}{$y+0}{$m+0}{$d+0} = [$name];
4216 }
4217 }
4218 $$dmb{'data'}{'tmpnow'} = [];
4219 }
4220
4221 $$dmb{'data'}{'init_holidays'} = 0;
4222}
4223
4224########################################################################
4225# PRINTF METHOD
4226
4227
# spent 14µs within Date::Manip::Date::BEGIN@4227 which was called: # once (14µs+0s) by main::RUNTIME at line 4544
BEGIN {
422815µs my %pad_0 = map { $_,1 } qw ( Y m d H M S I j G W L U );
422911µs my %pad_sp = map { $_,1 } qw ( y f e k i );
423011µs my %hr = map { $_,1 } qw ( H k I i );
423111µs my %dow = map { $_,1 } qw ( v a A w );
423217µs my %num = map { $_,1 } qw ( Y m d H M S y f e k I i j G W L U );
4233
4234 sub printf {
4235 my($self,@in) = @_;
4236 if ($$self{'err'} || ! $$self{'data'}{'set'}) {
4237 warn "WARNING: [printf] Object must contain a valid date\n";
4238 return undef;
4239 }
4240
4241 my $dmt = $$self{'tz'};
4242 my $dmb = $$dmt{'base'};
4243
4244 my($y,$m,$d,$h,$mn,$s) = @{ $$self{'data'}{'date'} };
4245
4246 my(@out);
4247 foreach my $in (@in) {
4248 my $out = '';
4249 while ($in) {
4250 last if ($in eq '%');
4251
4252 # Everything up to the first '%'
4253
4254 if ($in =~ s/^([^%]+)//) {
4255 $out .= $1;
4256 next;
4257 }
4258
4259 # Extended formats: %<...>
4260
4261 if ($in =~ s/^%<([^>]+)>//) {
4262 my $f = $1;
4263 my $val;
4264
4265 if ($f =~ /^a=([1-7])$/) {
4266 $val = $$dmb{'data'}{'wordlist'}{'day_abb'}[$1-1];
4267
4268 } elsif ($f =~ /^v=([1-7])$/) {
4269 $val = $$dmb{'data'}{'wordlist'}{'day_char'}[$1-1];
4270
4271 } elsif ($f =~ /^A=([1-7])$/) {
4272 $val = $$dmb{'data'}{'wordlist'}{'day_name'}[$1-1];
4273
4274 } elsif ($f =~ /^p=([1-2])$/) {
4275 $val = $$dmb{'data'}{'wordlist'}{'ampm'}[$1-1];
4276
4277 } elsif ($f =~ /^b=(0?[1-9]|1[0-2])$/) {
4278 $val = $$dmb{'data'}{'wordlist'}{'month_abb'}[$1-1];
4279
4280 } elsif ($f =~ /^B=(0?[1-9]|1[0-2])$/) {
4281 $val = $$dmb{'data'}{'wordlist'}{'month_name'}[$1-1];
4282
4283 } elsif ($f =~ /^E=(0?[1-9]|[1-4][0-9]|5[0-3])$/) {
4284 $val = $$dmb{'data'}{'wordlist'}{'nth'}[$1-1];
4285
4286 } else {
4287 $val = '%<' . $1 . '>';
4288 }
4289 $out .= $val;
4290 next;
4291 }
4292
4293 # Normals one-character formats
4294
4295 $in =~ s/^%(.)//s;
4296 my $f = $1;
4297
4298 if (exists $$self{'data'}{'f'}{$f}) {
4299 $out .= $$self{'data'}{'f'}{$f};
4300 next;
4301 }
4302
4303 my ($val,$pad,$len,$dow);
4304
4305 if (exists $pad_0{$f}) {
4306 $pad = '0';
4307 }
4308
4309 if (exists $pad_sp{$f}) {
4310 $pad = ' ';
4311 }
4312
4313 if ($f eq 'G' || $f eq 'W') {
4314 my($yy,$ww) = $dmb->_week_of_year(1,[$y,$m,$d]);
4315 if ($f eq 'G') {
4316 $val = $yy;
4317 $len = 4;
4318 } else {
4319 $val = $ww;
4320 $len = 2;
4321 }
4322 }
4323
4324 if ($f eq 'L' || $f eq 'U') {
4325 my($yy,$ww) = $dmb->_week_of_year(7,[$y,$m,$d]);
4326 if ($f eq 'L') {
4327 $val = $yy;
4328 $len = 4;
4329 } else {
4330 $val = $ww;
4331 $len = 2;
4332 }
4333 }
4334
4335 if ($f eq 'Y' || $f eq 'y') {
4336 $val = $y;
4337 $len = 4;
4338 }
4339
4340 if ($f eq 'm' || $f eq 'f') {
4341 $val = $m;
4342 $len = 2;
4343 }
4344
4345 if ($f eq 'd' || $f eq 'e') {
4346 $val = $d;
4347 $len = 2;
4348 }
4349
4350 if ($f eq 'j') {
4351 $val = $dmb->day_of_year([$y,$m,$d]);
4352 $len = 3;
4353 }
4354
4355
4356 if (exists $hr{$f}) {
4357 $val = $h;
4358 if ($f eq 'I' || $f eq 'i') {
4359 $val -= 12 if ($val > 12);
4360 $val = 12 if ($val == 0);
4361 }
4362 $len = 2;
4363 }
4364
4365 if ($f eq 'M') {
4366 $val = $mn;
4367 $len = 2;
4368 }
4369
4370 if ($f eq 'S') {
4371 $val = $s;
4372 $len = 2;
4373 }
4374
4375 if (exists $dow{$f}) {
4376 $dow = $dmb->day_of_week([$y,$m,$d]);
4377 }
4378
4379 ###
4380
4381 if (exists $num{$f}) {
4382 while (length($val) < $len) {
4383 $val = "$pad$val";
4384 }
4385
4386 $val = substr($val,2,2) if ($f eq 'y');
4387
4388 } elsif ($f eq 'b' || $f eq 'h') {
4389 $val = $$dmb{'data'}{'wordlist'}{'month_abb'}[$m-1];
4390
4391 } elsif ($f eq 'B') {
4392 $val = $$dmb{'data'}{'wordlist'}{'month_name'}[$m-1];
4393
4394 } elsif ($f eq 'v') {
4395 $val = $$dmb{'data'}{'wordlist'}{'day_char'}[$dow-1];
4396
4397 } elsif ($f eq 'a') {
4398 $val = $$dmb{'data'}{'wordlist'}{'day_abb'}[$dow-1];
4399
4400 } elsif ($f eq 'A') {
4401 $val = $$dmb{'data'}{'wordlist'}{'day_name'}[$dow-1];
4402
4403 } elsif ($f eq 'w') {
4404 $val = $dow;
4405
4406 } elsif ($f eq 'p') {
4407 my $i = ($h >= 12 ? 1 : 0);
4408 $val = $$dmb{'data'}{'wordlist'}{'ampm'}[$i];
4409
4410 } elsif ($f eq 'Z') {
4411 $val = $$self{'data'}{'abb'};
4412
4413 } elsif ($f eq 'N') {
4414 my $off = $$self{'data'}{'offset'};
4415 $val = $dmb->join('offset',$off);
4416
4417 } elsif ($f eq 'z') {
4418 my $off = $$self{'data'}{'offset'};
4419 $val = $dmb->join('offset',$off);
4420 $val =~ s/://g;
4421 $val =~ s/00$//;
4422
4423 } elsif ($f eq 'E') {
4424 $val = $$dmb{'data'}{'wordlist'}{'nth_dom'}[$d-1];
4425
4426 } elsif ($f eq 's') {
4427 $val = $self->secs_since_1970_GMT();
4428
4429 } elsif ($f eq 'o') {
4430 my $date2 = $self->new_date();
4431 $date2->parse('1970-01-01 00:00:00');
4432 my $delta = $date2->calc($self);
4433 $val = $delta->printf('%sys');
4434
4435 } elsif ($f eq 'l') {
4436 my $d0 = $self->new_date();
4437 my $d1 = $self->new_date();
4438 $d0->parse('-0:6:0:0:0:0:0'); # 6 months ago
4439 $d1->parse('+0:6:0:0:0:0:0'); # in 6 months
4440 $d0 = $d0->value();
4441 $d1 = $d1->value();
4442 my $date = $self->value();
4443 if ($date lt $d0 || $date ge $d1) {
4444 $in = '%b %e %Y' . $in;
4445 } else {
4446 $in = '%b %e %H:%M' . $in;
4447 }
4448 $val = '';
4449
4450 } elsif ($f eq 'c') {
4451 $in = '%a %b %e %H:%M:%S %Y' . $in;
4452 $val = '';
4453
4454 } elsif ($f eq 'C' || $f eq 'u') {
4455 $in = '%a %b %e %H:%M:%S %Z %Y' . $in;
4456 $val = '';
4457
4458 } elsif ($f eq 'g') {
4459 $in = '%a, %d %b %Y %H:%M:%S %Z' . $in;
4460 $val = '';
4461
4462 } elsif ($f eq 'D') {
4463 $in = '%m/%d/%y' . $in;
4464 $val = '';
4465
4466 } elsif ($f eq 'r') {
4467 $in = '%I:%M:%S %p' . $in;
4468 $val = '';
4469
4470 } elsif ($f eq 'R') {
4471 $in = '%H:%M' . $in;
4472 $val = '';
4473
4474 } elsif ($f eq 'T' || $f eq 'X') {
4475 $in = '%H:%M:%S' . $in;
4476 $val = '';
4477
4478 } elsif ($f eq 'V') {
4479 $in = '%m%d%H%M%y' . $in;
4480 $val = '';
4481
4482 } elsif ($f eq 'Q') {
4483 $in = '%Y%m%d' . $in;
4484 $val = '';
4485
4486 } elsif ($f eq 'q') {
4487 $in = '%Y%m%d%H%M%S' . $in;
4488 $val = '';
4489
4490 } elsif ($f eq 'P') {
4491 $in = '%Y%m%d%H:%M:%S' . $in;
4492 $val = '';
4493
4494 } elsif ($f eq 'O') {
4495 $in = '%Y-%m-%dT%H:%M:%S' . $in;
4496 $val = '';
4497
4498 } elsif ($f eq 'F') {
4499 $in = '%A, %B %e, %Y' . $in;
4500 $val = '';
4501
4502 } elsif ($f eq 'K') {
4503 $in = '%Y-%j' . $in;
4504 $val = '';
4505
4506 } elsif ($f eq 'x') {
4507 if ($dmb->_config('dateformat') eq 'US') {
4508 $in = '%m/%d/%y' . $in;
4509 } else {
4510 $in = '%d/%m/%y' . $in;
4511 }
4512 $val = '';
4513
4514 } elsif ($f eq 'J') {
4515 $in = '%G-W%W-%w' . $in;
4516 $val = '';
4517
4518 } elsif ($f eq 'n') {
4519 $val = "\n";
4520
4521 } elsif ($f eq 't') {
4522 $val = "\t";
4523
4524 } else {
4525 $val = $f;
4526 }
4527
4528 if ($val ne '') {
4529 $$self{'data'}{'f'}{$f} = $val;
4530 $out .= $val;
4531 }
4532 }
4533 push(@out,$out);
4534 }
4535
4536 if (wantarray) {
4537 return @out;
4538 } elsif (@out == 1) {
4539 return $out[0];
4540 }
4541
4542 return ''
4543 }
454411.15ms114µs}
# spent 14µs making 1 call to Date::Manip::Date::BEGIN@4227
4545
4546########################################################################
4547# EVENT METHODS
4548
4549sub list_events {
4550 my($self,@args) = @_;
4551 if ($$self{'err'} || ! $$self{'data'}{'set'}) {
4552 warn "WARNING: [list_events] Object must contain a valid date\n";
4553 return undef;
4554 }
4555 my $dmt = $$self{'tz'};
4556 my $dmb = $$dmt{'base'};
4557
4558 # Arguments
4559
4560 my($date,$day,$format);
4561 if (@args && $args[$#args] eq 'dates') {
4562 pop(@args);
4563 $format = 'dates';
4564 } else {
4565 $format = 'std';
4566 }
4567
4568 if (@args && $#args==0 && ref($args[0]) eq 'Date::Manip::Date') {
4569 $date = $args[0];
4570 } elsif (@args && $#args==0 && $args[0]==0) {
4571 $day = 1;
4572 } elsif (@args) {
4573 warn "ERROR: [list_events] unknown argument list\n";
4574 return [];
4575 }
4576
4577 # Get the beginning/end dates we're looking for events in
4578
4579 my($beg,$end);
4580 if ($date) {
4581 $beg = $self;
4582 $end = $date;
4583 } elsif ($day) {
4584 $beg = $self->new_date();
4585 $end = $self->new_date();
4586 my($y,$m,$d) = $self->value();
4587 $beg->set('date',[$y,$m,$d,0,0,0]);
4588 $end->set('date',[$y,$m,$d,23,59,59]);
4589 } else {
4590 $beg = $self;
4591 $end = $self;
4592 }
4593
4594 if ($beg->cmp($end) == 1) {
4595 my $tmp = $beg;
4596 $beg = $end;
4597 $end = $tmp;
4598 }
4599
4600 # We need to get a list of all events which may apply.
4601
4602 my($y0) = $beg->value();
4603 my($y1) = $end->value();
4604 foreach my $y ($y0..$y1) {
4605 $self->_events_year($y);
4606 }
4607
4608 my @events = ();
4609 foreach my $i (keys %{ $$dmb{'data'}{'events'} }) {
4610 my $event = $$dmb{'data'}{'events'}{$i};
4611 my $type = $$event{'type'};
4612 my $name = $$event{'name'};
4613
4614 if ($type eq 'specified') {
4615 my $d0 = $$dmb{'data'}{'events'}{$i}{'beg'};
4616 my $d1 = $$dmb{'data'}{'events'}{$i}{'end'};
4617 push @events,[$d0,$d1,$name];
4618
4619 } elsif ($type eq 'ym' || $type eq 'date') {
4620 foreach my $y ($y0..$y1) {
4621 if (exists $$dmb{'data'}{'events'}{$i}{$y}) {
4622 my($d0,$d1) = @{ $$dmb{'data'}{'events'}{$i}{$y} };
4623 push @events,[$d0,$d1,$name];
4624 }
4625 }
4626
4627 } elsif ($type eq 'recur') {
4628 my $rec = $$dmb{'data'}{'events'}{$i}{'recur'};
4629 my $del = $$dmb{'data'}{'events'}{$i}{'delta'};
4630 my @d = $rec->dates($beg,$end);
4631 foreach my $d0 (@d) {
4632 my $d1 = $d0->calc($del);
4633 push @events,[$d0,$d1,$name];
4634 }
4635 }
4636 }
4637
4638 # Next we need to see which ones apply.
4639
4640 my @tmp;
4641 foreach my $e (@events) {
4642 my($d0,$d1,$name) = @$e;
4643
4644 push(@tmp,$e) if ($beg->cmp($d1) != 1 &&
4645 $end->cmp($d0) != -1);
4646 }
4647
4648 # Now format them...
4649
4650 if ($format eq 'std') {
4651 @events = sort { $$a[0]->cmp($$b[0]) ||
4652 $$a[1]->cmp($$b[1]) ||
4653 $$a[2] cmp $$b[2] } @tmp;
4654
4655 } elsif ($format eq 'dates') {
4656 my $p1s = $self->new_delta();
4657 $p1s->parse('+0:0:0:0:0:0:1');
4658
4659 @events = ();
4660 my (@tmp2);
4661 foreach my $e (@tmp) {
4662 my $name = $$e[2];
4663 if ($$e[0]->cmp($beg) == -1) {
4664 # Event begins before the start
4665 push(@tmp2,[$beg,'+',$name]);
4666 } else {
4667 push(@tmp2,[$$e[0],'+',$name]);
4668 }
4669
4670 my $d1 = $$e[1]->calc($p1s);
4671
4672 if ($d1->cmp($end) == -1) {
4673 # Event ends before the end
4674 push(@tmp2,[$d1,'-',$name]);
4675 }
4676 }
4677
4678 return () if (! @tmp2);
4679 @tmp2 = sort { $$a[0]->cmp($$b[0]) ||
4680 $$a[1] cmp $$b[1] ||
4681 $$a[2] cmp $$b[2] } @tmp2;
4682
4683 # @tmp2 is now:
4684 # ( [ DATE1, OP1, NAME1 ], [ DATE2, OP2, NAME2 ], ... )
4685 # which is sorted by date.
4686
4687 my $d = $tmp2[0]->[0];
4688
4689 if ($beg->cmp($d) != 0) {
4690 push(@events,[$beg]);
4691 }
4692
4693 my %e;
4694 while (1) {
4695
4696 # If the first element is the same date as we're
4697 # currently working with, just perform the operation
4698 # and remove it from the list. If the list is not empty,
4699 # we'll proceed to the next element.
4700
4701 my $d0 = $tmp2[0]->[0];
4702 if ($d->cmp($d0) == 0) {
4703 my $e = shift(@tmp2);
4704 my $op = $$e[1];
4705 my $n = $$e[2];
4706 if ($op eq '+') {
4707 $e{$n} = 1;
4708 } else {
4709 delete $e{$n};
4710 }
4711
4712 next if (@tmp2);
4713 }
4714
4715 # We need to store the existing %e.
4716
4717 my @n = sort keys %e;
4718 push(@events,[$d,@n]);
4719
4720 # If the list is empty, we're done. Otherwise, we need to
4721 # reset the date and continue.
4722
4723 last if (! @tmp2);
4724 $d = $tmp2[0]->[0];
4725 }
4726 }
4727
4728 return @events;
4729}
4730
4731# The events of type date and ym are determined on a year-by-year basis
4732#
4733sub _events_year {
4734 my($self,$y) = @_;
4735 my $dmt = $$self{'tz'};
4736 my $dmb = $$dmt{'base'};
4737 my $tz = $dmt->_now('tz',1);
4738 return if (exists $$dmb{'data'}{'eventyears'}{$y});
4739 $self->_event_objs() if (! $$dmb{'data'}{'eventobjs'});
4740
4741 my $d = $self->new_date();
4742 $d->config('forcedate',"${y}-01-01-00:00:00,$tz");
4743
4744 my $hrM1 = $d->new_delta();
4745 $hrM1->set('delta',[0,0,0,0,0,59,59]);
4746
4747 my $dayM1 = $d->new_delta();
4748 $dayM1->set('delta',[0,0,0,0,23,59,59]);
4749
4750 foreach my $i (keys %{ $$dmb{'data'}{'events'} }) {
4751 my $event = $$dmb{'data'}{'events'}{$i};
4752 my $type = $$event{'type'};
4753
4754 if ($type eq 'ym') {
4755 my $beg = $$event{'beg'};
4756 my $end = $$event{'end'};
4757 my $d0 = $d->new_date();
4758 $d0->parse_date($beg);
4759 $d0->set('time',[0,0,0]);
4760
4761 my $d1;
4762 if ($end) {
4763 $d1 = $d0->new_date();
4764 $d1->parse_date($end);
4765 $d1->set('time',[23,59,59]);
4766 } else {
4767 $d1 = $d0->calc($dayM1);
4768 }
4769 $$dmb{'data'}{'events'}{$i}{$y} = [ $d0,$d1 ];
4770
4771 } elsif ($type eq 'date') {
4772 my $beg = $$event{'beg'};
4773 my $end = $$event{'end'};
4774 my $del = $$event{'delta'};
4775 my $d0 = $d->new_date();
4776 $d0->parse($beg);
4777
4778 my $d1;
4779 if ($end) {
4780 $d1 = $d0->new_date();
4781 $d1->parse($end);
4782 } elsif ($del) {
4783 $d1 = $d0->calc($del);
4784 } else {
4785 $d1 = $d0->calc($hrM1);
4786 }
4787 $$dmb{'data'}{'events'}{$i}{$y} = [ $d0,$d1 ];
4788 }
4789 }
4790}
4791
4792# This parses the raw event list. It only has to be done once.
4793#
4794sub _event_objs {
4795 my($self) = @_;
4796 my $dmt = $$self{'tz'};
4797 my $dmb = $$dmt{'base'};
4798 # Only parse once.
4799 $$dmb{'data'}{'eventobjs'} = 1;
4800
4801 my $hrM1 = $self->new_delta();
4802 $hrM1->set('delta',[0,0,0,0,0,59,59]);
4803
4804 my $M1 = $self->new_delta();
4805 $M1->set('delta',[0,0,0,0,0,0,-1]);
4806
4807 my @tmp = @{ $$dmb{'data'}{'sections'}{'events'} };
4808 my $i = 0;
4809 while (@tmp) {
4810 my $string = shift(@tmp);
4811 my $name = shift(@tmp);
4812 my @event = split(/\s*;\s*/,$string);
4813
4814 if ($#event == 0) {
4815
4816 # YMD/YM
4817
4818 my $d1 = $self->new_date();
4819 my $err = $d1->parse_date($event[0]);
4820 if (! $err) {
4821 if ($$d1{'data'}{'def'}[0] eq '') {
4822 # YM
4823 $$dmb{'data'}{'events'}{$i++} = { 'type' => 'ym',
4824 'name' => $name,
4825 'beg' => $event[0] };
4826 } else {
4827 # YMD
4828 my $d2 = $d1->new_date();
4829 my ($y,$m,$d) = $d1->value();
4830 $d1->set('time',[0,0,0]);
4831 $d2->set('date',[$y,$m,$d,23,59,59]);
4832 $$dmb{'data'}{'events'}{$i++} = { 'type' => 'specified',
4833 'name' => $name,
4834 'beg' => $d1,
4835 'end' => $d2 };
4836 }
4837 next;
4838 }
4839
4840 # Date
4841
4842 $err = $d1->parse($event[0]);
4843 if (! $err) {
4844 if ($$d1{'data'}{'def'}[0] eq '') {
4845 # Date (no year)
4846 $$dmb{'data'}{'events'}{$i++} = { 'type' => 'date',
4847 'name' => $name,
4848 'beg' => $event[0],
4849 'delta' => $hrM1
4850 };
4851 } else {
4852 # Date (year)
4853 my $d2 = $d1->calc($hrM1);
4854 $$dmb{'data'}{'events'}{$i++} = { 'type' => 'specified',
4855 'name' => $name,
4856 'beg' => $d1,
4857 'end' => $d2
4858 };
4859 }
4860 next;
4861 }
4862
4863 # Recur
4864
4865 my $r = $self->new_recur();
4866 $err = $r->parse($event[0]);
4867 if ($err) {
4868 warn "ERROR: invalid event definition (must be Date, YMD, YM, or Recur)\n"
4869 . " $string\n";
4870 next;
4871 }
4872
4873 my @d = $r->dates();
4874 if (@d) {
4875 foreach my $d (@d) {
4876 my $d2 = $d->calc($hrM1);
4877 $$dmb{'data'}{'events'}{$i++} = { 'type' => 'specified',
4878 'name' => $name,
4879 'beg' => $d1,
4880 'end' => $d2
4881 };
4882 }
4883 } else {
4884 $$dmb{'data'}{'events'}{$i++} = { 'type' => 'recur',
4885 'name' => $name,
4886 'recur' => $r,
4887 'delta' => $hrM1
4888 };
4889 }
4890
4891 } elsif ($#event == 1) {
4892 my($o1,$o2) = @event;
4893
4894 # YMD;YMD
4895 # YM;YM
4896
4897 my $d1 = $self->new_date();
4898 my $err = $d1->parse_date($o1);
4899 if (! $err) {
4900 my $d2 = $self->new_date();
4901 $err = $d2->parse_date($o2);
4902 if ($err) {
4903 warn "ERROR: invalid event definition (must be YMD;YMD or YM;YM)\n"
4904 . " $string\n";
4905 next;
4906 } elsif ($$d1{'data'}{'def'}[0] ne $$d2{'data'}{'def'}[0]) {
4907 warn "ERROR: invalid event definition (YMD;YM or YM;YMD not allowed)\n"
4908 . " $string\n";
4909 next;
4910 }
4911
4912 if ($$d1{'data'}{'def'}[0] eq '') {
4913 # YM;YM
4914 $$dmb{'data'}{'events'}{$i++} = { 'type' => 'ym',
4915 'name' => $name,
4916 'beg' => $o1,
4917 'end' => $o2
4918 };
4919 } else {
4920 # YMD;YMD
4921 $d1->set('time',[0,0,0]);
4922 $d2->set('time',[23,59,59]);
4923 $$dmb{'data'}{'events'}{$i++} = { 'type' => 'specified',
4924 'name' => $name,
4925 'beg' => $d1,
4926 'end' => $d2 };
4927 }
4928 next;
4929 }
4930
4931 # Date;Date
4932 # Date;Delta
4933
4934 $err = $d1->parse($o1);
4935 if (! $err) {
4936
4937 my $d2 = $self->new_date();
4938 $err = $d2->parse($o2,'nodelta');
4939
4940 if (! $err) {
4941 # Date;Date
4942 if ($$d1{'data'}{'def'}[0] ne $$d2{'data'}{'def'}[0]) {
4943 warn "ERROR: invalid event definition (year must be absent or\n"
4944 . " included in both dats in Date;Date)\n"
4945 . " $string\n";
4946 next;
4947 }
4948
4949 if ($$d1{'data'}{'def'}[0] eq '') {
4950 # Date (no year)
4951 $$dmb{'data'}{'events'}{$i++} = { 'type' => 'date',
4952 'name' => $name,
4953 'beg' => $o1,
4954 'end' => $o2
4955 };
4956 } else {
4957 # Date (year)
4958 $$dmb{'data'}{'events'}{$i++} = { 'type' => 'specified',
4959 'name' => $name,
4960 'beg' => $d1,
4961 'end' => $d2
4962 };
4963 }
4964 next;
4965 }
4966
4967 # Date;Delta
4968 my $del = $self->new_delta();
4969 $err = $del->parse($o2);
4970
4971 if ($err) {
4972 warn "ERROR: invalid event definition (must be Date;Date or\n"
4973 . " Date;Delta) $string\n";
4974 next;
4975 }
4976
4977 $del = $del->calc($M1);
4978 if ($$d1{'data'}{'def'}[0] eq '') {
4979 # Date (no year)
4980 $$dmb{'data'}{'events'}{$i++} = { 'type' => 'date',
4981 'name' => $name,
4982 'beg' => $o1,
4983 'delta' => $del
4984 };
4985 } else {
4986 # Date (year)
4987 $d2 = $d1->calc($del);
4988 $$dmb{'data'}{'events'}{$i++} = { 'type' => 'specified',
4989 'name' => $name,
4990 'beg' => $d1,
4991 'end' => $d2
4992 };
4993 }
4994 next;
4995 }
4996
4997 # Recur;Delta
4998
4999 my $r = $self->new_recur();
5000 $err = $r->parse($o1);
5001
5002 my $del = $self->new_delta();
5003 if (! $err) {
5004 $err = $del->parse($o2);
5005 }
5006
5007 if ($err) {
5008 warn "ERROR: invalid event definition (must be Date;Date, YMD;YMD, "
5009 . " YM;YM, Date;Delta, or Recur;Delta)\n"
5010 . " $string\n";
5011 next;
5012 }
5013
5014 $del = $del->calc($M1);
5015 my @d = $r->dates();
5016 if (@d) {
5017 foreach my $d1 (@d) {
5018 my $d2 = $d1->calc($del);
5019 $$dmb{'data'}{'events'}{$i++} = { 'type' => 'specified',
5020 'name' => $name,
5021 'beg' => $d1,
5022 'end' => $d2
5023 };
5024 }
5025 } else {
5026 $$dmb{'data'}{'events'}{$i++} = { 'type' => 'recur',
5027 'name' => $name,
5028 'recur' => $r,
5029 'delta' => $del
5030 };
5031 }
5032
5033 } else {
5034 warn "ERROR: invalid event definition\n"
5035 . " $string\n";
5036 next;
5037 }
5038 }
5039}
5040
504113µs1;
5042# Local Variables:
5043# mode: cperl
5044# indent-tabs-mode: nil
5045# cperl-indent-level: 3
5046# cperl-continued-statement-offset: 2
5047# cperl-continued-brace-offset: 0
5048# cperl-brace-offset: 0
5049# cperl-brace-imaginary-offset: 0
5050# cperl-label-offset: 0
5051# End:
 
# spent 31.1ms within Date::Manip::Date::CORE:match which was called 14640 times, avg 2µs/call: # 4872 times (12.1ms+0s) by Date::Manip::Date::_parse_time at line 1648, avg 2µs/call # 2442 times (4.12ms+0s) by Date::Manip::Date::_parse_date_common at line 1727, avg 2µs/call # 2442 times (3.95ms+0s) by Date::Manip::Date::_parse_date_common at line 1712, avg 2µs/call # 2436 times (8.04ms+0s) by Date::Manip::Date::_parse_datetime_iso8601 at line 1236, avg 3µs/call # 2436 times (2.91ms+0s) by Date::Manip::Date::_parse_datetime_other at line 1901, avg 1µs/call # 12 times (29µs+0s) by Date::Manip::Date::_parse_date_other at line 1991, avg 2µs/call
sub Date::Manip::Date::CORE:match; # opcode
# spent 18µs within Date::Manip::Date::CORE:qr which was called 15 times, avg 1µs/call: # once (5µs+0s) by Date::Manip::Date::_other_rx at line 1498 # once (2µs+0s) by Date::Manip::Date::_iso8601_rx at line 1123 # once (2µs+0s) by Date::Manip::Date::_other_rx at line 1599 # once (1µs+0s) by Date::Manip::Date::_iso8601_rx at line 1171 # once (1µs+0s) by Date::Manip::Date::_iso8601_rx at line 1215 # once (1µs+0s) by Date::Manip::Date::_other_rx at line 1489 # once (900ns+0s) by Date::Manip::Date::_other_rx at line 1536 # once (800ns+0s) by Date::Manip::Date::_other_rx at line 1421 # once (700ns+0s) by Date::Manip::Date::_iso8601_rx at line 1213 # once (700ns+0s) by Date::Manip::Date::_other_rx at line 1442 # once (700ns+0s) by Date::Manip::Date::_other_rx at line 1499 # once (600ns+0s) by Date::Manip::Date::_other_rx at line 1420 # once (600ns+0s) by Date::Manip::Date::_other_rx at line 1507 # once (600ns+0s) by Date::Manip::Date::_iso8601_rx at line 1138 # once (400ns+0s) by Date::Manip::Date::_iso8601_rx at line 1176
sub Date::Manip::Date::CORE:qr; # opcode
# spent 36.1ms within Date::Manip::Date::CORE:regcomp which was called 21968 times, avg 2µs/call: # 4872 times (1.86ms+0s) by Date::Manip::Date::_parse_time at line 1648, avg 383ns/call # 2442 times (3.37ms+0s) by Date::Manip::Date::_parse_date_common at line 1727, avg 1µs/call # 2442 times (1.56ms+0s) by Date::Manip::Date::_parse_date_common at line 1712, avg 638ns/call # 2442 times (1.09ms+0s) by Date::Manip::Date::_parse_date at line 430, avg 446ns/call # 2436 times (5.16ms+0s) by Date::Manip::Date::_parse_datetime_iso8601 at line 1236, avg 2µs/call # 2436 times (1.76ms+0s) by Date::Manip::Date::_parse_datetime_other at line 1901, avg 721ns/call # 2436 times (1.49ms+0s) by Date::Manip::Date::_parse_time at line 1662, avg 611ns/call # 2436 times (1.36ms+0s) by Date::Manip::Date::_parse_dow at line 1767, avg 560ns/call # 12 times (41µs+0s) by Date::Manip::Date::_parse_date_other at line 1991, avg 3µs/call # once (5.10ms+0s) by Date::Manip::Date::_iso8601_rx at line 1215 # once (4.87ms+0s) by Date::Manip::Date::_other_rx at line 1536 # once (2.74ms+0s) by Date::Manip::Date::_iso8601_rx at line 1171 # once (2.49ms+0s) by Date::Manip::Date::_other_rx at line 1421 # once (2.09ms+0s) by Date::Manip::Date::_other_rx at line 1599 # once (879µs+0s) by Date::Manip::Date::_other_rx at line 1489 # once (154µs+0s) by Date::Manip::Date::_iso8601_rx at line 1123 # once (35µs+0s) by Date::Manip::Date::_other_rx at line 1499 # once (35µs+0s) by Date::Manip::Date::_iso8601_rx at line 1138 # once (21µs+0s) by Date::Manip::Date::_other_rx at line 1442 # once (11µs+0s) by Date::Manip::Date::_iso8601_rx at line 1176 # once (9µs+0s) by Date::Manip::Date::_other_rx at line 1507 # once (8µs+0s) by Date::Manip::Date::_other_rx at line 1420 # once (8µs+0s) by Date::Manip::Date::_other_rx at line 1498
sub Date::Manip::Date::CORE:regcomp; # opcode
# spent 60.2ms within Date::Manip::Date::CORE:subst which was called 26750 times, avg 2µs/call: # 2442 times (3.23ms+0s) by Date::Manip::Date::_parse_date_common at line 1706, avg 1µs/call # 2442 times (2.83ms+0s) by Date::Manip::Date::_parse_date at line 430, avg 1µs/call # 2442 times (2.65ms+0s) by Date::Manip::Date::_parse_date at line 433, avg 1µs/call # 2442 times (508µs+0s) by Date::Manip::Date::_parse_date at line 423, avg 208ns/call # 2436 times (34.0ms+0s) by Date::Manip::Date::_parse_time at line 1662, avg 14µs/call # 2436 times (4.39ms+0s) by Date::Manip::Date::parse at line 154, avg 2µs/call # 2436 times (4.03ms+0s) by Date::Manip::Date::_parse_time at line 1668, avg 2µs/call # 2436 times (3.61ms+0s) by Date::Manip::Date::_parse_dow at line 1767, avg 1µs/call # 2436 times (637µs+0s) by Date::Manip::Date::parse at line 155, avg 262ns/call # 2401 times (3.01ms+0s) by Date::Manip::Date::_parse_dow at line 1779, avg 1µs/call # 2401 times (1.37ms+0s) by Date::Manip::Date::_parse_dow at line 1780, avg 570ns/call
sub Date::Manip::Date::CORE:subst; # opcode