← Index
NYTProf Performance Profile   « line view »
For svc/members/upsert
  Run on Tue Jan 13 11:50:22 2015
Reported on Tue Jan 13 12:09:48 2015

Filename/usr/share/perl5/Date/Manip/Base.pm
StatementsExecuted 12528 statements in 19.8ms
Subroutines
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
1114.64ms8.61msDate::Manip::Base::::BEGIN@24Date::Manip::Base::BEGIN@24
261313.36ms6.87msDate::Manip::Base::::_rx_wordlistsDate::Manip::Base::_rx_wordlists
1112.33ms2.49msDate::Manip::Base::::BEGIN@15Date::Manip::Base::BEGIN@15
830411.93ms2.46msDate::Manip::Base::::_qe_quoteDate::Manip::Base::_qe_quote
2111.63ms9.22msDate::Manip::Base::::_languageDate::Manip::Base::_language
346511.20ms1.20msDate::Manip::Base::::CORE:sortDate::Manip::Base::CORE:sort (opcode)
83011354µs354µsDate::Manip::Base::::CORE:substDate::Manip::Base::CORE:subst (opcode)
631199µs501µsDate::Manip::Base::::_rx_replaceDate::Manip::Base::_rx_replace
2221196µs196µsDate::Manip::Base::::CORE:regcompDate::Manip::Base::CORE:regcomp (opcode)
42011176µs176µsDate::Manip::Base::::CORE:substcontDate::Manip::Base::CORE:substcont (opcode)
2811134µs9.89msDate::Manip::Base::::_config_var_baseDate::Manip::Base::_config_var_base
211112µs10.2msDate::Manip::Base::::_init_configDate::Manip::Base::_init_config
82191µs112µsDate::Manip::Base::::_hms_fieldsDate::Manip::Base::_hms_fields
105186µs142µsDate::Manip::Base::::_rx_wordlistDate::Manip::Base::_rx_wordlist
826171µs71µsDate::Manip::Base::::CORE:matchDate::Manip::Base::CORE:match (opcode)
41164µs143µsDate::Manip::Base::::splitDate::Manip::Base::split
42158µs311µsDate::Manip::Base::::_config_var_workdaybegendDate::Manip::Base::_config_var_workdaybegend
104142µs42µsDate::Manip::Base::::_init_business_lengthDate::Manip::Base::_init_business_length
42241µs55µsDate::Manip::Base::::_osDate::Manip::Base::_os
21140µs10.3msDate::Manip::Base::::_initDate::Manip::Base::_init
21134µs60µsDate::Manip::Base::::_config_var_workweekendDate::Manip::Base::_config_var_workweekend
41131µs83µsDate::Manip::Base::::joinDate::Manip::Base::join
63130µs49µsDate::Manip::Base::::_calc_workweekDate::Manip::Base::_calc_workweek
21125µs56µsDate::Manip::Base::::_config_var_workweekbegDate::Manip::Base::_config_var_workweekbeg
222123µs23µsDate::Manip::Base::::CORE:qrDate::Manip::Base::CORE:qr (opcode)
11123µs24µsDate::Manip::Base::::BEGIN@2238Date::Manip::Base::BEGIN@2238
41123µs44µsDate::Manip::Base::::_config_var_workday24hrDate::Manip::Base::_config_var_workday24hr
62120µs20µsDate::Manip::Base::::_calc_bdlengthDate::Manip::Base::_calc_bdlength
63118µs26µsDate::Manip::Base::::_is_intDate::Manip::Base::_is_int
21118µs18µsDate::Manip::Base::::_init_cacheDate::Manip::Base::_init_cache
21114µs14µsDate::Manip::Base::::_config_var_encodingDate::Manip::Base::_config_var_encoding
21114µs14µsDate::Manip::Base::::_date_fieldsDate::Manip::Base::_date_fields
42114µs14µsDate::Manip::Base::::_init_languageDate::Manip::Base::_init_language
63112µs12µsDate::Manip::Base::::_rx_simpleDate::Manip::Base::_rx_simple
21112µs17µsDate::Manip::Base::::_config_var_recurrangeDate::Manip::Base::_config_var_recurrange
21111µs11µsDate::Manip::Base::::_init_nowDate::Manip::Base::_init_now
21111µs23µsDate::Manip::Base::::_config_var_firstdayDate::Manip::Base::_config_var_firstday
21110µs10µsDate::Manip::Base::::_init_eventsDate::Manip::Base::_init_events
1119µs17µsDate::Manip::Base::::BEGIN@1409Date::Manip::Base::BEGIN@1409
1119µs11µsDate::Manip::Base::::BEGIN@1782Date::Manip::Base::BEGIN@1782
1119µs11µsDate::Manip::Base::::BEGIN@577Date::Manip::Base::BEGIN@577
1119µs9µsDate::Manip::Base::::BEGIN@14Date::Manip::Base::BEGIN@14
1118µs10µsDate::Manip::Base::::BEGIN@232Date::Manip::Base::BEGIN@232
2118µs8µsDate::Manip::Base::::_init_holidaysDate::Manip::Base::_init_holidays
1118µs9µsDate::Manip::Base::::BEGIN@2194Date::Manip::Base::BEGIN@2194
1117µs9µsDate::Manip::Base::::BEGIN@392Date::Manip::Base::BEGIN@392
1117µs20µsDate::Manip::Base::::BEGIN@1359Date::Manip::Base::BEGIN@1359
1117µs18µsDate::Manip::Base::::BEGIN@1339Date::Manip::Base::BEGIN@1339
1116µs14µsDate::Manip::Base::::BEGIN@1470Date::Manip::Base::BEGIN@1470
1116µs8µsDate::Manip::Base::::BEGIN@22Date::Manip::Base::BEGIN@22
1116µs8µsDate::Manip::Base::::BEGIN@2256Date::Manip::Base::BEGIN@2256
1116µs7µsDate::Manip::Base::::BEGIN@2207Date::Manip::Base::BEGIN@2207
1116µs15µsDate::Manip::Base::::BEGIN@19Date::Manip::Base::BEGIN@19
1116µs10µsDate::Manip::Base::::BEGIN@20Date::Manip::Base::BEGIN@20
1116µs7µsDate::Manip::Base::::BEGIN@2272Date::Manip::Base::BEGIN@2272
1116µs7µsDate::Manip::Base::::BEGIN@2218Date::Manip::Base::BEGIN@2218
1116µs7µsDate::Manip::Base::::BEGIN@21Date::Manip::Base::BEGIN@21
2116µs6µsDate::Manip::Base::::_init_dataDate::Manip::Base::_init_data
1115µs12µsDate::Manip::Base::::BEGIN@1474Date::Manip::Base::BEGIN@1474
2115µs5µsDate::Manip::Base::::_config_var_defaulttimeDate::Manip::Base::_config_var_defaulttime
2114µs4µsDate::Manip::Base::::cmpDate::Manip::Base::cmp
1113µs3µsDate::Manip::Base::::ENDDate::Manip::Base::END
0000s0sDate::Manip::Base::::_calc_date_time_stringsDate::Manip::Base::_calc_date_time_strings
0000s0sDate::Manip::Base::::_calc_date_ymwdDate::Manip::Base::_calc_date_ymwd
0000s0sDate::Manip::Base::::_calc_hms_hmsDate::Manip::Base::_calc_hms_hms
0000s0sDate::Manip::Base::::_critical_dateDate::Manip::Base::_critical_date
0000s0sDate::Manip::Base::::_delta_convertDate::Manip::Base::_delta_convert
0000s0sDate::Manip::Base::::_delta_fieldsDate::Manip::Base::_delta_fields
0000s0sDate::Manip::Base::::_encodingDate::Manip::Base::_encoding
0000s0sDate::Manip::Base::::_methodDate::Manip::Base::_method
0000s0sDate::Manip::Base::::_mod_addDate::Manip::Base::_mod_add
0000s0sDate::Manip::Base::::_normalize_bus_dhmsDate::Manip::Base::_normalize_bus_dhms
0000s0sDate::Manip::Base::::_normalize_dhDate::Manip::Base::_normalize_dh
0000s0sDate::Manip::Base::::_normalize_hmsDate::Manip::Base::_normalize_hms
0000s0sDate::Manip::Base::::_normalize_mwDate::Manip::Base::_normalize_mw
0000s0sDate::Manip::Base::::_normalize_wdDate::Manip::Base::_normalize_wd
0000s0sDate::Manip::Base::::_normalize_ymDate::Manip::Base::_normalize_ym
0000s0sDate::Manip::Base::::_offset_fieldsDate::Manip::Base::_offset_fields
0000s0sDate::Manip::Base::::_sectionDate::Manip::Base::_section
0000s0sDate::Manip::Base::::_sortByLengthDate::Manip::Base::_sortByLength
0000s0sDate::Manip::Base::::_split_deltaDate::Manip::Base::_split_delta
0000s0sDate::Manip::Base::::_time_fieldsDate::Manip::Base::_time_fields
0000s0sDate::Manip::Base::::_week1_day1Date::Manip::Base::_week1_day1
0000s0sDate::Manip::Base::::_week_of_yearDate::Manip::Base::_week_of_year
0000s0sDate::Manip::Base::::_weeks_in_yearDate::Manip::Base::_weeks_in_year
0000s0sDate::Manip::Base::::calc_date_dateDate::Manip::Base::calc_date_date
0000s0sDate::Manip::Base::::calc_date_daysDate::Manip::Base::calc_date_days
0000s0sDate::Manip::Base::::calc_date_deltaDate::Manip::Base::calc_date_delta
0000s0sDate::Manip::Base::::calc_date_timeDate::Manip::Base::calc_date_time
0000s0sDate::Manip::Base::::calc_time_timeDate::Manip::Base::calc_time_time
0000s0sDate::Manip::Base::::checkDate::Manip::Base::check
0000s0sDate::Manip::Base::::check_timeDate::Manip::Base::check_time
0000s0sDate::Manip::Base::::day_of_weekDate::Manip::Base::day_of_week
0000s0sDate::Manip::Base::::day_of_yearDate::Manip::Base::day_of_year
0000s0sDate::Manip::Base::::days_in_monthDate::Manip::Base::days_in_month
0000s0sDate::Manip::Base::::days_in_yearDate::Manip::Base::days_in_year
0000s0sDate::Manip::Base::::days_since_1BCDate::Manip::Base::days_since_1BC
0000s0sDate::Manip::Base::::leapyearDate::Manip::Base::leapyear
0000s0sDate::Manip::Base::::nth_day_of_weekDate::Manip::Base::nth_day_of_week
0000s0sDate::Manip::Base::::secs_since_1970Date::Manip::Base::secs_since_1970
0000s0sDate::Manip::Base::::week1_day1Date::Manip::Base::week1_day1
0000s0sDate::Manip::Base::::week_of_yearDate::Manip::Base::week_of_year
0000s0sDate::Manip::Base::::weeks_in_yearDate::Manip::Base::weeks_in_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::Base;
2# Copyright (c) 1995-2014 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
14225µs19µs
# spent 9µs within Date::Manip::Base::BEGIN@14 which was called: # once (9µs+0s) by Date::Manip::Date::BEGIN@26 at line 14
use Date::Manip::Obj;
# spent 9µs making 1 call to Date::Manip::Base::BEGIN@14
152666µs12.49ms
# spent 2.49ms (2.33+161µs) within Date::Manip::Base::BEGIN@15 which was called: # once (2.33ms+161µs) by Date::Manip::Date::BEGIN@26 at line 15
use Date::Manip::TZ_Base;
# spent 2.49ms making 1 call to Date::Manip::Base::BEGIN@15
1619µsour @ISA = qw(Date::Manip::Obj Date::Manip::TZ_Base);
17
1818µsrequire 5.010000;
19219µs225µs
# spent 15µs (6+9) within Date::Manip::Base::BEGIN@19 which was called: # once (6µs+9µs) by Date::Manip::Date::BEGIN@26 at line 19
use strict;
# spent 15µs making 1 call to Date::Manip::Base::BEGIN@19 # spent 9µs making 1 call to strict::import
20217µs213µs
# spent 10µs (6+4) within Date::Manip::Base::BEGIN@20 which was called: # once (6µs+4µs) by Date::Manip::Date::BEGIN@26 at line 20
use warnings;
# spent 10µs making 1 call to Date::Manip::Base::BEGIN@20 # spent 4µs making 1 call to warnings::import
21217µs28µs
# spent 7µs (6+1) within Date::Manip::Base::BEGIN@21 which was called: # once (6µs+1µs) by Date::Manip::Date::BEGIN@26 at line 21
use integer;
# spent 7µs making 1 call to Date::Manip::Base::BEGIN@21 # spent 1µs making 1 call to integer::import
22223µs210µs
# spent 8µs (6+2) within Date::Manip::Base::BEGIN@22 which was called: # once (6µs+2µs) by Date::Manip::Date::BEGIN@26 at line 22
use utf8;
# spent 8µs making 1 call to Date::Manip::Base::BEGIN@22 # spent 2µs making 1 call to utf8::import
23#use re 'debug';
2421.16ms28.69ms
# spent 8.61ms (4.64+3.98) within Date::Manip::Base::BEGIN@24 which was called: # once (4.64ms+3.98ms) by Date::Manip::Date::BEGIN@26 at line 24
use Encode qw(encode_utf8 from_to find_encoding decode _utf8_off _utf8_on is_utf8);
# spent 8.61ms making 1 call to Date::Manip::Base::BEGIN@24 # spent 78µs making 1 call to Exporter::import
251770µsrequire Date::Manip::Lang::index;
26
2710sour $VERSION;
281100ns$VERSION='6.47';
2914µs
# spent 3µs within Date::Manip::Base::END which was called: # once (3µs+0s) by main::RUNTIME at line 131 of C4/Service.pm
END { undef $VERSION; }
30
31###############################################################################
32# BASE METHODS
33###############################################################################
34
35
# spent 10.3ms (40µs+10.2) within Date::Manip::Base::_init which was called 2 times, avg 5.13ms/call: # 2 times (40µs+10.2ms) by Date::Manip::Obj::new at line 162 of Date/Manip/Obj.pm, avg 5.13ms/call
sub _init {
362800ns my($self) = @_;
37
3824µs218µs $self->_init_cache();
# spent 18µs making 2 calls to Date::Manip::Base::_init_cache, avg 9µs/call
3924µs28µs $self->_init_language();
# spent 8µs making 2 calls to Date::Manip::Base::_init_language, avg 4µs/call
4024µs210.2ms $self->_init_config();
# spent 10.2ms making 2 calls to Date::Manip::Base::_init_config, avg 5.08ms/call
4124µs210µs $self->_init_events();
# spent 10µs making 2 calls to Date::Manip::Base::_init_events, avg 5µs/call
4223µs28µs $self->_init_holidays();
# spent 8µs making 2 calls to Date::Manip::Base::_init_holidays, avg 4µs/call
4328µs211µs $self->_init_now();
# spent 11µs making 2 calls to Date::Manip::Base::_init_now, avg 5µs/call
44}
45
46# The base object has some config-independant information which is
47# always reused, and only needs to be initialized once.
48
# spent 18µs within Date::Manip::Base::_init_cache which was called 2 times, avg 9µs/call: # 2 times (18µs+0s) by Date::Manip::Base::_init at line 38, avg 9µs/call
sub _init_cache {
492800ns my($self) = @_;
5026µs return if (exists $$self{'cache'}{'init'});
5122µs $$self{'cache'}{'init'} = 1;
52
53 # ly => {Y} = 0/1 1 if it is a leap year
54 # ds1_mon => {Y}{M} = N days since 1BC for Y/M/1
55 # dow_mon => {Y}{M} = DOW day of week of Y/M/1
56
5722µs $$self{'cache'}{'ly'} = {} if (! exists $$self{'cache'}{'ly'});
5822µs $$self{'cache'}{'ds1_mon'} = {} if (! exists $$self{'cache'}{'ds1_mon'});
5928µs $$self{'cache'}{'dow_mon'} = {} if (! exists $$self{'cache'}{'dow_mon'});
60}
61
62# Config dependent data. Needs to be reset every time the config is reset.
63
# spent 6µs within Date::Manip::Base::_init_data which was called 2 times, avg 3µs/call: # 2 times (6µs+0s) by Date::Manip::Base::_init_config at line 74, avg 3µs/call
sub _init_data {
6421µs my($self,$force) = @_;
6521µs return if (exists $$self{'data'}{'calc'} && ! $force);
66
6725µs $$self{'data'}{'calc'} = {}; # Calculated values
68}
69
70# Initializes config dependent data
71
# spent 10.2ms (112µs+10.1) within Date::Manip::Base::_init_config which was called 2 times, avg 5.08ms/call: # 2 times (112µs+10.1ms) by Date::Manip::Base::_init at line 40, avg 5.08ms/call
sub _init_config {
722600ns my($self,$force) = @_;
7322µs return if (exists $$self{'data'}{'sections'}{'conf'} && ! $force);
7423µs26µs $self->_init_data();
# spent 6µs making 2 calls to Date::Manip::Base::_init_data, avg 3µs/call
75
76 #
77 # Set config defaults
78 #
79
80225µs $$self{'data'}{'sections'}{'conf'} =
81 {
82 # Reset config, holiday lists, or events lists
83
84 'defaults' => '',
85 'eraseholidays' => '',
86 'eraseevents' => '',
87
88 # Which language to use when parsing dates.
89
90 'language' => '',
91
92 # 12/10 = Dec 10 (US) or Oct 12 (anything else)
93
94 'dateformat' => '',
95
96 # Define the work week (1=monday, 7=sunday)
97 #
98 # These have to be predefined to avoid a bootstrap issue, but
99 # the true defaults are defined below.
100
101 'workweekbeg' => 1,
102 'workweekend' => 5,
103
104 # If non-nil, a work day is treated as 24 hours long
105 # (WorkDayBeg/WorkDayEnd ignored)
106
107 'workday24hr' => '',
108
109 # Start and end time of the work day (any time format allowed,
110 # seconds ignored). If the defaults change, be sure to change
111 # the starting value of bdlength above.
112
113 'workdaybeg' => '',
114 'workdayend' => '',
115
116 # 2 digit years fall into the 100 year period given by [ CURR-N,
117 # CURR+(99-N) ] where N is 0-99. Default behavior is 89, but
118 # other useful numbers might be 0 (forced to be this year or
119 # later) and 99 (forced to be this year or earlier). It can
120 # also be set to 'c' (current century) or 'cNN' (i.e. c18
121 # forces the year to bet 1800-1899). Also accepts the form
122 # cNNNN to give the 100 year period NNNN to NNNN+99.
123
124 'yytoyyyy' => '',
125
126 # First day of the week (1=monday, 7=sunday). ISO 8601 says
127 # monday.
128
129 'firstday' => '',
130
131 # If this is 0, use the ISO 8601 standard that Jan 4 is in week
132 # 1. If 1, make week 1 contain Jan 1.
133
134 'jan1week1' => '',
135
136 # Date::Manip printable format
137 # 0 = YYYYMMDDHH:MN:SS
138 # 1 = YYYYHHMMDDHHMNSS
139 # 2 = YYYY-MM-DD-HH:MN:SS
140
141 'printable' => '',
142
143 # If 'today' is a holiday, we look either to 'tomorrow' or
144 # 'yesterday' for the nearest business day. By default, we'll
145 # always look 'tomorrow' first.
146
147 'tomorrowfirst' => 1,
148
149 # Used to set the current date/time/timezone.
150
151 'forcedate' => 0,
152 'setdate' => 0,
153
154 # Use this to set the default range of the recurrence.
155
156 'recurrange' => '',
157
158 # Use this to set the default time.
159
160 'defaulttime' => 'midnight',
161
162 # Whether or not to use a period as a time separator.
163
164 'periodtimesep' => 0,
165
166 # *** DEPRECATED ***
167
168 'tz' => '',
169 };
170
171 #
172 # Calculate delta field lengths
173 #
174
175 # non-business
17623µs $$self{'data'}{'len'}{'yrlen'} = 365.2425;
17725µs $$self{'data'}{'len'}{'0'} =
178 { 'yl' => 31556952, # 365.2425 * 24 * 3600
179 'ml' => 2629746, # yl / 12
180 'wl' => 604800, # 6 * 24 * 3600
181 'dl' => 86400, # 24 * 3600
182 };
18323µs231µs $self->_calc_workweek();
# spent 31µs making 2 calls to Date::Manip::Base::_calc_workweek, avg 15µs/call
184
185 #
186 # Initialize some config variables that do some additional work.
187 #
188
18924µs268µs $self->_config_var('workday24hr', 1);
# spent 68µs making 2 calls to Date::Manip::TZ_Base::_config_var, avg 34µs/call
19022µs2198µs $self->_config_var('workdaybeg', '08:00:00');
# spent 198µs making 2 calls to Date::Manip::TZ_Base::_config_var, avg 99µs/call
19122µs2148µs $self->_config_var('workdayend', '17:00:00');
# spent 148µs making 2 calls to Date::Manip::TZ_Base::_config_var, avg 74µs/call
19222µs215µs $self->_config_var('workday24hr', 0);
# spent 15µs making 2 calls to Date::Manip::TZ_Base::_config_var, avg 8µs/call
193
19422µs212µs $self->_config_var('dateformat', 'US');
# spent 12µs making 2 calls to Date::Manip::TZ_Base::_config_var, avg 6µs/call
19522µs221µs $self->_config_var('yytoyyyy', 89);
# spent 21µs making 2 calls to Date::Manip::TZ_Base::_config_var, avg 10µs/call
19622µs210µs $self->_config_var('jan1week1', 0);
# spent 10µs making 2 calls to Date::Manip::TZ_Base::_config_var, avg 5µs/call
19722µs210µs $self->_config_var('printable', 0);
# spent 10µs making 2 calls to Date::Manip::TZ_Base::_config_var, avg 5µs/call
19822µs237µs $self->_config_var('firstday', 1);
# spent 37µs making 2 calls to Date::Manip::TZ_Base::_config_var, avg 19µs/call
19922µs283µs $self->_config_var('workweekbeg', 1);
# spent 83µs making 2 calls to Date::Manip::TZ_Base::_config_var, avg 41µs/call
20022µs274µs $self->_config_var('workweekend', 5);
# spent 74µs making 2 calls to Date::Manip::TZ_Base::_config_var, avg 37µs/call
20122µs29.26ms $self->_config_var('language', 'english');
# spent 9.26ms making 2 calls to Date::Manip::TZ_Base::_config_var, avg 4.63ms/call
20222µs236µs $self->_config_var('recurrange', 'none');
# spent 36µs making 2 calls to Date::Manip::TZ_Base::_config_var, avg 18µs/call
20322µs222µs $self->_config_var('defaulttime', 'midnight');
# spent 22µs making 2 calls to Date::Manip::TZ_Base::_config_var, avg 11µs/call
204
205 # Set OS specific defaults
206
207211µs230µs my $os = $self->_os();
# spent 30µs making 2 calls to Date::Manip::Base::_os, avg 15µs/call
208}
209
210
# spent 49µs (30+19) within Date::Manip::Base::_calc_workweek which was called 6 times, avg 8µs/call: # 2 times (18µs+13µs) by Date::Manip::Base::_init_config at line 183, avg 15µs/call # 2 times (6µs+3µs) by Date::Manip::Base::_config_var_workweekbeg at line 1238, avg 5µs/call # 2 times (6µs+3µs) by Date::Manip::Base::_config_var_workweekend at line 1255, avg 4µs/call
sub _calc_workweek {
21162µs my($self,$beg,$end) = @_;
212
21367µs412µs $beg = $self->_config('workweekbeg') if (! $beg);
# spent 12µs making 4 calls to Date::Manip::TZ_Base::_config, avg 3µs/call
21464µs47µs $end = $self->_config('workweekend') if (! $end);
# spent 7µs making 4 calls to Date::Manip::TZ_Base::_config, avg 2µs/call
215
216614µs $$self{'data'}{'len'}{'workweek'} = $end - $beg + 1;
217}
218
219
# spent 20µs within Date::Manip::Base::_calc_bdlength which was called 6 times, avg 3µs/call: # 4 times (11µs+0s) by Date::Manip::Base::_config_var_workdaybegend at line 1305, avg 3µs/call # 2 times (9µs+0s) by Date::Manip::Base::_config_var_workday24hr at line 1269, avg 5µs/call
sub _calc_bdlength {
22061µs my($self) = @_;
221
22264µs my @beg = @{ $$self{'data'}{'calc'}{'workdaybeg'} };
22363µs my @end = @{ $$self{'data'}{'calc'}{'workdayend'} };
224
225617µs $$self{'data'}{'len'}{'bdlength'} =
226 ($end[0]-$beg[0])*3600 + ($end[1]-$beg[1])*60 + ($end[2]-$beg[2]);
227}
228
229
# spent 42µs within Date::Manip::Base::_init_business_length which was called 10 times, avg 4µs/call: # 4 times (16µs+0s) by Date::Manip::Base::_config_var_workdaybegend at line 1306, avg 4µs/call # 2 times (12µs+0s) by Date::Manip::Base::_config_var_workday24hr at line 1270, avg 6µs/call # 2 times (9µs+0s) by Date::Manip::Base::_config_var_workweekbeg at line 1239, avg 4µs/call # 2 times (6µs+0s) by Date::Manip::Base::_config_var_workweekend at line 1256, avg 3µs/call
sub _init_business_length {
230101µs my($self) = @_;
231
2322488µs212µs
# spent 10µs (8+2) within Date::Manip::Base::BEGIN@232 which was called: # once (8µs+2µs) by Date::Manip::Date::BEGIN@26 at line 232
no integer;
# spent 10µs making 1 call to Date::Manip::Base::BEGIN@232 # spent 2µs making 1 call to integer::unimport
233105µs my $x = $$self{'data'}{'len'}{'workweek'};
234106µs my $y_to_d = $x/7 * 365.2425;
235103µs my $d_to_s = $$self{'data'}{'len'}{'bdlength'};
236101µs my $w_to_d = $x;
237
2381036µs $$self{'data'}{'len'}{'1'} = { 'yl' => $y_to_d * $d_to_s,
239 'ml' => $y_to_d * $d_to_s / 12,
240 'wl' => $w_to_d * $d_to_s,
241 'dl' => $d_to_s,
242 };
243}
244
245# Events and holidays are reset only when they are read in.
246
# spent 10µs within Date::Manip::Base::_init_events which was called 2 times, avg 5µs/call: # 2 times (10µs+0s) by Date::Manip::Base::_init at line 41, avg 5µs/call
sub _init_events {
2472800ns my($self,$force) = @_;
24821µs return if (exists $$self{'data'}{'events'} && ! $force);
249
250 # {data}{sections}{events} = [ STRING, EVENT_NAME, ... ]
251 #
252 # {data}{events}{I}{type} = TYPE
253 # {name} = NAME
254 # TYPE: specified An event with a start/end date (only parsed once)
255 # {beg} = DATE_OBJECT
256 # {end} = DATE_OBJECT
257 # TYPE: ym
258 # {beg} = YM_STRING
259 # {end} = YM_STRING (only for YM;YM)
260 # {YEAR} = [ DATE_OBJECT, DATE_OBJECT ]
261 # TYPE: date An event specified by a date string and delta
262 # {beg} = DATE_STRING
263 # {end} = DATE_STRING (only for Date;Date)
264 # {delta} = DELTA_OBJECT (only for Date;Delta)
265 # {YEAR} = [ DATE_OBJECT, DATE_OBJECT ]
266 # TYPE: recur
267 # {recur} = RECUR_OBJECT
268 # {delta} = DELTA_OBJECT
269 #
270 # {data}{eventyears}{YEAR} = 0/1
271 # {data}{eventobjs} = 0/1
272
27322µs $$self{'data'}{'events'} = {};
27422µs $$self{'data'}{'sections'}{'events'} = [];
27522µs $$self{'data'}{'eventyears'} = {};
27625µs $$self{'data'}{'eventobjs'} = 0;
277}
278
279
# spent 8µs within Date::Manip::Base::_init_holidays which was called 2 times, avg 4µs/call: # 2 times (8µs+0s) by Date::Manip::Base::_init at line 42, avg 4µs/call
sub _init_holidays {
2802900ns my($self,$force) = @_;
28121µs return if (exists $$self{'data'}{'holidays'} && ! $force);
282
283 # {data}{sections}{holidays} = [ STRING, HOLIDAY_NAME, ... ]
284 #
285 # {data}{holidays}{YEAR} = 1 if this year has been parsed
286 # 2 if YEAR-1 and YEAR+1 have been parsed
287 # (both must be done before holidays can
288 # be known so that New Years can be
289 # celebrated on Dec 31 if Jan 1 is weekend)
290 # {date} = DATE_OBJ
291 # a Date::Manip::Date object to use for holidays
292 # {hols} = [ RECUR_OBJ|DATE_STRING, HOLIDAY_NAME, ... ]
293 # DATE_STRING is suitable for parse_date
294 # using DATE_OBJ. RECUR_OBJ is a
295 # Date::Manip::Recur object that can be used
296 # once the start and end date is set.
297 # {dates} = { Y => M => D => NAME }
298 #
299 # {data}{init_holidays} = 1 if currently initializing holidays
300
30121µs $$self{'data'}{'holidays'} = {};
30222µs $$self{'data'}{'sections'}{'holidays'} = [];
30324µs $$self{'data'}{'init_holidays'} = 0;
304}
305
306
# spent 11µs within Date::Manip::Base::_init_now which was called 2 times, avg 5µs/call: # 2 times (11µs+0s) by Date::Manip::Base::_init at line 43, avg 5µs/call
sub _init_now {
3072600ns my($self) = @_;
308
309 # {'data'}{'now'} = {
310 # date => [Y,M,D,H,MN,S] now
311 # isdst => ISDST
312 # offset => [H,MN,S]
313 # abb => ABBREV
314 #
315 # force => 0/1 SetDate/ForceDate information
316 # set => 0/1
317 # setsecs => SECS time (in secs since epoch) when
318 # SetDate was called
319 # setdate => [Y,M,D,H,MN,S] the date (IN GMT) we're calling
320 # now when SetDate was called
321 #
322 # tz => ZONE timezone we're working in
323 # systz => ZONE timezone of the system
324 # }
325 #
326
32723µs $$self{'data'}{'now'} = {};
32823µs $$self{'data'}{'now'}{'force'} = 0;
32921µs $$self{'data'}{'now'}{'set'} = 0;
33025µs $$self{'data'}{'tmpnow'} = [];
331}
332
333# Language information only needs to be initialized if the language changes.
334
# spent 14µs within Date::Manip::Base::_init_language which was called 4 times, avg 3µs/call: # 2 times (8µs+0s) by Date::Manip::Base::_init at line 39, avg 4µs/call # 2 times (6µs+0s) by Date::Manip::Base::_language at line 1351, avg 3µs/call
sub _init_language {
3354900ns my($self,$force) = @_;
33643µs return if (exists $$self{'data'}{'lang'} && ! $force);
337
33842µs $$self{'data'}{'lang'} = {}; # Current language info
33941µs $$self{'data'}{'rx'} = {}; # Regexps generated from language
34042µs $$self{'data'}{'words'} = {}; # Types of words in the language
34148µs $$self{'data'}{'wordval'} = {}; # Value of words in the language
342}
343
344###############################################################################
345# MAIN METHODS
346###############################################################################
347
348sub leapyear {
349 my($self,$y) = @_;
350 $y += 0;
351 return $$self{'cache'}{'ly'}{$y}
352 if (exists $$self{'cache'}{'ly'}{$y});
353
354 $$self{'cache'}{'ly'}{$y} = 0, return 0 unless ($y % 4 == 0);
355 $$self{'cache'}{'ly'}{$y} = 1, return 1 unless ($y % 100 == 0);
356 $$self{'cache'}{'ly'}{$y} = 0, return 0 unless ($y % 400 == 0);
357 $$self{'cache'}{'ly'}{$y} = 1, return 1;
358}
359
360sub days_in_year {
361 my($self,$y) = @_;
362 return ($self->leapyear($y) ? 366 : 365);
363}
364
365{
36622µs my(@leap)=(31,29,31,30, 31,30,31,31, 30,31,30,31);
36711µs my(@nonl)=(31,28,31,30, 31,30,31,31, 30,31,30,31);
368
369 sub days_in_month {
370 my($self,$y,$m) = @_;
371
372 if ($m) {
373 return ($self->leapyear($y) ? $leap[$m-1] : $nonl[$m-1]);
374 } else {
375 return ($self->leapyear($y) ? @leap : @nonl);
376 }
377 }
378}
379
380{
381 # DinM = (31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31)
3822800ns my(@doy_days) = ( 0, 31, 59, 90,120,151,181,212,243,273,304,334,365);
383
384 # Note: I tested storing both leap year and non-leap year days in
385 # a hash, but it was slightly slower.
386
3871500ns my($lyd,$n,$remain,$day,$y,$m,$d,$h,$mn,$s,$arg);
388
389 sub day_of_year {
390 my($self,@args) = @_;
391
3922759µs211µs
# spent 9µs (7+2) within Date::Manip::Base::BEGIN@392 which was called: # once (7µs+2µs) by Date::Manip::Date::BEGIN@26 at line 392
no integer;
# spent 9µs making 1 call to Date::Manip::Base::BEGIN@392 # spent 2µs making 1 call to integer::unimport
393 if ($#args == 1) {
394
395 # $date = day_of_year($y,$day);
396 ($y,$n) = @args;
397
398 $lyd = $self->leapyear($y);
399 $remain = ($n - int($n));
400 $n = int($n);
401
402 # Calculate the month and the day
403 for ($m=1; $m<=12; $m++) {
404 last if ($n<=($doy_days[$m] + ($m==1 ? 0 : $lyd)));
405 }
406 $d = $n-($doy_days[$m-1] + (($m-1)<2 ? 0 : $lyd));
407 return [$y,$m,$d] if (! $remain);
408
409 # Calculate the hours, minutes, and seconds into the day.
410 $remain *= 24;
411 $h = int($remain);
412 $remain = ($remain - $h)*60;
413 $mn = int($remain);
414 $remain = ($remain - $mn)*60;
415 $s = $remain;
416
417 return [$y,$m,$d,$h,$mn,$s];
418
419 } else {
420 $arg = $args[0];
421 @args = @$arg;
422
423 ($y,$m,$d,$h,$mn,$s) = @args;
424 $lyd = $self->leapyear($y);
425 $lyd = 0 if ($m <= 2);
426 $day = ($doy_days[$m-1]+$d+$lyd);
427 return $day if ($#args==2);
428
429 $day += ($h*3600 + $mn*60 + $s)/(24*3600);
430 return $day;
431 }
432 }
433}
434
435sub days_since_1BC {
436 my($self,$arg) = @_;
437
438 if (ref($arg)) {
439 my($y,$m,$d) = @$arg;
440 $y += 0;
441 $m += 0;
442
443 if (! exists $$self{'cache'}{'ds1_mon'}{$y}{$m}) {
444
445 if (! exists $$self{'cache'}{'ds1_mon'}{$y}{1}) {
446
447 my($Ny,$N4,$N100,$N400,$cc,$yy);
448
449 my $yyyy = "0000$y";
450
451 $yyyy =~ /(\d\d)(\d\d)$/o;
452 ($cc,$yy) = ($1,$2);
453
454 # Number of full years since Dec 31, 1BC (starting at 0001)
455 $Ny = $y - 1;
456
457 # Number of full 4th years (0004, 0008, etc.) since Dec 31, 1BC
458 $N4 = int($Ny/4);
459
460 # Number of full 100th years (0100, 0200, etc.)
461
462 $N100 = $cc + 0;
463 $N100-- if ($yy==0);
464
465 # Number of full 400th years (0400, 0800, etc.)
466 $N400 = int($N100/4);
467
468 $$self{'cache'}{'ds1_mon'}{$y}{1} =
469 $Ny*365 + $N4 - $N100 + $N400 + 1;
470 }
471
472 my($i,$j);
473 my @mon = $self->days_in_month($y,0);
474 for ($i=2; $i<=12; $i++) {
475 $j = shift(@mon);
476 $$self{'cache'}{'ds1_mon'}{$y}{$i} =
477 $$self{'cache'}{'ds1_mon'}{$y}{$i-1} + $j;
478 }
479 }
480
481 return ($$self{'cache'}{'ds1_mon'}{$y}{$m} + $d - 1);
482
483 } else {
484 my($days) = $arg;
485 my($y,$m,$d);
486
487 $y = int($days/$$self{'data'}{'len'}{'yrlen'})+1;
488 while ($self->days_since_1BC([$y,1,1]) > $days) {
489 $y--;
490 }
491 $m = 12;
492 while ( ($d=$self->days_since_1BC([$y,$m,1])) > $days ) {
493 $m--;
494 }
495 $d = ($days-$d+1);
496 return [$y,$m,$d];
497 }
498}
499
500sub day_of_week {
501 my($self,$date) = @_;
502 my($y,$m,$d) = @$date;
503 $y += 0;
504 $m += 0;
505
506 my($dayofweek,$dec31) = ();
507 if (! exists $$self{'cache'}{'dow_mon'}{$y}{$m}) {
508 $dec31 = 7; # Dec 31, 1BC was Sunday
509 $$self{'cache'}{'dow_mon'}{$y}{$m} =
510 ( $self->days_since_1BC([$y,$m,1])+$dec31 ) % 7;
511 }
512 $dayofweek = ($$self{'cache'}{'dow_mon'}{$y}{$m}+$d-1) % 7;
513 $dayofweek = 7 if ($dayofweek==0);
514 return $dayofweek;
515}
516
517# Can be the nth DoW of year or month (if $m given). Returns undef if
518# the date doesn't exists (i.e. 5th Sunday in a month with only 4).
519#
520sub nth_day_of_week {
521 my($self,$y,$n,$dow,$m) = @_;
522 $y += 0;
523 $m = ($m ? $m+0 : 0);
524
525 # $d is the current DoM (if $m) or DoY
526 # $max is the max value allowed for $d
527 # $ddow is the DoW of $d
528
529 my($d,$max,$ddow);
530
531 if ($m) {
532 $max = $self->days_in_month($y,$m);
533 $d = ($n<0 ? $max : 1);
534 $ddow = $self->day_of_week([$y,$m,$d]);
535 } else {
536 $max = $self->days_in_year($y);
537 $d = ($n<0 ? $max : 1);
538 if ($n<0) {
539 $d = $max;
540 $ddow = $self->day_of_week([$y,12,31]);
541 } else {
542 $d = 1;
543 $ddow = $self->day_of_week([$y,1,1]);
544 }
545 }
546
547 # Find the first occurrence of $dow on or after $d (if $n>0)
548 # or the last occurrence of $dow on or before $d (if ($n<0);
549
550 if ($dow < $ddow) {
551 $d += 7 - ($ddow-$dow);
552 } else {
553 $d += ($dow-$ddow);
554 }
555 $d -= 7 if ($d > $max);
556
557 # Find the nth occurrence of $dow
558
559 if ($n > 1) {
560 $d += 7*($n-1);
561 return undef if ($d > $max);
562 } elsif ($n < -1) {
563 $d -= 7*(-1*$n-1);
564 return undef if ($d < 1);
565 }
566
567 # Return the date
568
569 if ($m) {
570 return [$y,$m,$d];
571 }
572 return $self->day_of_year($y,$d);
573}
574
575{
576 # Integer arithmetic doesn't work due to the size of the numbers.
57733.00ms213µs
# spent 11µs (9+2) within Date::Manip::Base::BEGIN@577 which was called: # once (9µs+2µs) by Date::Manip::Date::BEGIN@26 at line 577
no integer;
# spent 11µs making 1 call to Date::Manip::Base::BEGIN@577 # spent 2µs making 1 call to integer::unimport
578 # my $sec_70 =($self->days_since_1BC([1970,1,1])-1)*24*3600;
5791100ns my $sec_70 = 62135596800;
580
581 # Using 'global' variables saves 4%
5821400ns my($y,$m,$d,$h,$mn,$s,$sec,$sec_0,$tmp);
583 sub secs_since_1970 {
584 my($self,$arg) = @_;
585
586 if (ref($arg)) {
587 ($y,$m,$d,$h,$mn,$s) = @$arg;
588 $sec_0 = ($self->days_since_1BC([$y,$m,$d])-1)*24*3600 + $h*3600 +
589 $mn*60 + $s;
590 $sec = $sec_0 - $sec_70;
591 return $sec;
592
593 } else {
594 ($sec) = $arg;
595 $sec_0 = $sec_70 + $sec;
596 $tmp = int($sec_0/24/3600)+1;
597 my $ymd = $self->days_since_1BC($tmp);
598 ($y,$m,$d) = @$ymd;
599 $sec_0 -= ($tmp-1)*24*3600;
600 $h = int($sec_0/3600);
601 $sec_0 -= $h*3600;
602 $mn = int($sec_0/60);
603 $s = $sec_0 - $mn*60;
604 return [$y,$m,$d,$h,$mn,$s];
605 }
606 }
607}
608
609sub check {
610 my($self,$date) = @_;
611 my($y,$m,$d,$h,$mn,$s) = @$date;
612
613 return 0 if (! $self->check_time([$h,$mn,$s]) ||
614 $y<1 || $y>9999 ||
615 $m<1 || $m>12);
616
617 my $days = $self->days_in_month($y,$m);
618
619 return 0 if ($d<1 || $d>$days);
620 return 1;
621}
622
623sub check_time {
624 my($self,$hms) = @_;
625 my($h,$mn,$s) = @$hms;
626
627 return 0 if ("$h:$mn:$s" !~ /^\d\d?:\d\d?:\d\d?$/o ||
628 $h > 24 || $mn > 59 || $s > 59 ||
629 ($h == 24 && ($mn || $s)));
630 return 1;
631}
632
633sub week1_day1 {
634 my($self,$year) = @_;
635 my $firstday = $self->_config('firstday');
636 return $self->_week1_day1($firstday,$year);
637}
638
639sub _week1_day1 {
640 my($self,$firstday,$year) = @_;
641 my $jan1week1 = $self->_config('jan1week1');
642 return $$self{'cache'}{'week1day1'}{$firstday}{$jan1week1}{$year}
643 if (exists $$self{'cache'}{'week1day1'}{$firstday}{$jan1week1}{$year});
644
645 # First week contains either Jan 4 (default) or Jan 1
646
647 my($y,$m,$d) = ($year,1,4);
648 $d = 1 if ($jan1week1);
649
650 # Go back to the previous (counting today) $firstday
651
652 my $dow = $self->day_of_week([$y,$m,$d]);
653 if ($dow != $firstday) {
654 $firstday = 0 if ($firstday == 7);
655 $d -= ($dow-$firstday);
656 if ($d<1) {
657 $y--;
658 $m = 12;
659 $d += 31;
660 }
661 }
662
663 $$self{'cache'}{'week1day1'}{$firstday}{$jan1week1}{$year} = [ $y,$m,$d ];
664 return [$y,$m,$d];
665}
666
667sub weeks_in_year {
668 my($self,$y) = @_;
669 my $firstday = $self->_config('firstday');
670 return $self->_weeks_in_year($firstday,$y);
671}
672
673sub _weeks_in_year {
674 my($self,$firstday,$y) = @_;
675 my $jan1week1 = $self->_config('jan1week1');
676 return $$self{'cache'}{'wiy'}{$firstday}{$jan1week1}{$y}
677 if (exists $$self{'cache'}{'wiy'}{$firstday}{$jan1week1}{$y});
678
679 # Get the week1 day1 dates for this year and the next one.
680 my ($y1,$m1,$d1) = @{ $self->_week1_day1($firstday,$y) };
681 my ($y2,$m2,$d2) = @{ $self->_week1_day1($firstday,$y+1) };
682
683 # Calculate the number of days between them.
684 my $diy = $self->days_in_year($y);
685 if ($y1 < $y) {
686 $diy += (32-$d1);
687 } else {
688 $diy -= ($d1-1);
689 }
690 if ($y2 < $y+1) {
691 $diy -= (32-$d2);
692 } else {
693 $diy += ($d2-1);
694 }
695
696 $diy = $diy/7;
697 $$self{'cache'}{'wiy'}{$firstday}{$jan1week1}{$y} = $diy;
698 return $diy;
699}
700
701sub week_of_year {
702 my($self,@args) = @_;
703 my $firstday = $self->_config('firstday');
704 $self->_week_of_year($firstday,@args);
705}
706
707sub _week_of_year {
708 my($self,$firstday,@args) = @_;
709 my $jan1week1 = $self->_config('jan1week1');
710
711 if ($#args == 1) {
712 # (y,m,d) = week_of_year(y,w)
713 my($year,$w) = @args;
714
715 return $$self{'cache'}{'woy1'}{$firstday}{$jan1week1}{$year}{$w}
716 if (exists $$self{'cache'}{'woy1'}{$firstday}{$jan1week1}{$year}{$w});
717
718 my $ymd = $self->_week1_day1($firstday,$year);
719 $ymd = $self->calc_date_days($ymd,($w-1)*7) if ($w > 1);
720
721 $$self{'cache'}{'woy1'}{$firstday}{$jan1week1}{$year}{$w} = $ymd;
722 return $ymd;
723 }
724
725 # (y,w) = week_of_year([y,m,d])
726 my($y,$m,$d) = @{ $args[0] };
727
728 # Get the first day of the first week. If the date is before that,
729 # it's the last week of last year.
730
731 my($y0,$m0,$d0) = @{ $self->_week1_day1($firstday,$y) };
732 if ($y0==$y && $m==1 && $d<$d0) {
733 return($y-1,$self->_weeks_in_year($firstday,$y-1));
734 }
735
736 # Otherwise, we'll figure out how many days are between the two and
737 # divide by 7 to figure out how many weeks in it is.
738
739 my $n = $self->day_of_year([$y,$m,$d]);
740 if ($y0<$y) {
741 $n += (32-$d0);
742 } else {
743 $n -= ($d0-1);
744 }
745 my $w = 1+int(($n-1)/7);
746
747 # Make sure we're not into the first week of next year.
748
749 if ($w>$self->_weeks_in_year($firstday,$y)) {
750 return($y+1,1);
751 }
752 return($y,$w);
753}
754
755###############################################################################
756# CALC METHODS
757###############################################################################
758
759sub calc_date_date {
760 my($self,$date0,$date1) = @_;
761
762 # Order them so date0 < date1
763 # If $minus = 1, then the delta is negative
764
765 my $minus = 0;
766 my $cmp = $self->cmp($date0,$date1);
767
768 if ($cmp == 0) {
769 return [0,0,0];
770
771 } elsif ($cmp == 1) {
772 $minus = 1;
773 my $tmp = $date1;
774 $date1 = $date0;
775 $date0 = $tmp;
776 }
777
778 my($y0,$m0,$d0,$h0,$mn0,$s0) = @$date0;
779 my($y1,$m1,$d1,$h1,$mn1,$s1) = @$date1;
780
781 my $sameday = ($y0 == $y1 && $m0 == $m1 && $d0 == $d1 ? 1 : 0);
782
783 # Handle the various cases.
784
785 my($dh,$dm,$ds);
786 if ($sameday) {
787 ($dh,$dm,$ds) = @{ $self->_calc_hms_hms([$h0,$mn0,$s0],[$h1,$mn1,$s1]) };
788
789 } else {
790 # y0-m0-d0 h0:mn0:s0 -> y0-m0-d0 24:00:00
791 # y1-m1-d1 h1:mn1:s1 -> y1-m1-d1 00:00:00
792
793 my $t1 = $self->_calc_hms_hms([$h0,$mn0,$s0],[24,0,0]);
794 my $t2 = $self->_calc_hms_hms([0,0,0],[$h1,$mn1,$s1]);
795 ($dh,$dm,$ds) = @{ $self->calc_time_time($t1,$t2) };
796
797 my $dd0 = $self->days_since_1BC([$y0,$m0,$d0]);
798 $dd0++;
799 my $dd1 = $self->days_since_1BC([$y1,$m1,$d1]);
800 $dh += ($dd1-$dd0)*24;
801 }
802
803 if ($minus) {
804 $dh *= -1;
805 $dm *= -1;
806 $ds *= -1;
807 }
808 return [$dh,$dm,$ds];
809}
810
811sub calc_date_days {
812 my($self,$date,$n,$subtract) = @_;
813 my($y,$m,$d,$h,$mn,$s) = @$date;
814 my($ymdonly) = (defined $h ? 0 : 1);
815
816 $n *= -1 if ($subtract);
817 my $d1bc = $self->days_since_1BC([$y,$m,$d]);
818 $d1bc += $n;
819 my $ymd = $self->days_since_1BC($d1bc);
820
821 if ($ymdonly) {
822 return $ymd;
823 } else {
824 return [@$ymd,$h*1,$mn*1,$s*1];
825 }
826}
827
828sub calc_date_delta {
829 my($self,$date,$delta,$subtract) = @_;
830 my($y,$m,$d,$h,$mn,$s,$dy,$dm,$dw,$dd,$dh,$dmn,$ds) = (@$date,@$delta);
831
832 ($y,$m,$d) = @{ $self->_calc_date_ymwd([$y,$m,$d], [$dy,$dm,$dw,$dd],
833 $subtract) };
834 return $self->calc_date_time([$y,$m,$d,$h,$mn,$s],[$dh,$dmn,$ds],$subtract);
835}
836
837sub calc_date_time {
838 my($self,$date,$time,$subtract) = @_;
839 my($y,$m,$d,$h,$mn,$s,$dh,$dmn,$ds) = (@$date,@$time);
840
841 if ($ds > 59 || $ds < -59) {
842 $dmn += int($ds/60);
843 $ds = $ds % 60;
844 }
845 if ($dmn > 59 || $dmn < -59) {
846 $dh += int($dmn/60);
847 $dmn = $dmn % 60;
848 }
849 my $dd = 0;
850 if ($dh > 23 || $dh < -23) {
851 $dd = int($dh/24);
852 $dh = $dh % 24;
853 }
854
855 # Handle subtraction
856 if ($subtract) {
857 $dh *= -1;
858 $dmn *= -1;
859 $ds *= -1;
860 $dd *= -1;
861 }
862
863 if ($dd == 0) {
864 $y *= 1;
865 $m *= 1;
866 $d *= 1;
867 } else {
868 ($y,$m,$d) = @{ $self->calc_date_days([$y,$m,$d],$dd) };
869 }
870
871 $self->_mod_add(60,$ds,\$s,\$mn);
872 $self->_mod_add(60,$dmn,\$mn,\$h);
873 $self->_mod_add(24,$dh,\$h,\$d);
874
875 if ($d<1) {
876 $m--;
877 $y--, $m=12 if ($m<1);
878 my $day_in_mon = $self->days_in_month($y,$m);
879 $d += $day_in_mon;
880 } else {
881 my $day_in_mon = $self->days_in_month($y,$m);
882 if ($d>$day_in_mon) {
883 $d -= $day_in_mon;
884 $m++;
885 $y++, $m=1 if ($m>12);
886 }
887 }
888
889 return [$y,$m,$d,$h,$mn,$s];
890}
891
892sub _calc_date_time_strings {
893 my($self,$date,$time,$subtract) = @_;
894 my @date = @{ $self->split('date',$date) };
895 return '' if (! @date);
896 my @time = @{ $self->split('time',$time) };
897
898 my @date2 = @{ $self->calc_date_time(\@date,\@time,$subtract) };
899
900 return $self->join('date',\@date2);
901}
902
903sub _calc_date_ymwd {
904 my($self,$date,$ymwd,$subtract) = @_;
905 my($y,$m,$d,$h,$mn,$s) = @$date;
906 my($dy,$dm,$dw,$dd) = @$ymwd;
907 my($ymdonly) = (defined $h ? 0 : 1);
908
909 $dd += $dw*7;
910
911 if ($subtract) {
912 $y -= $dy;
913 $self->_mod_add(-12,-1*$dm,\$m,\$y);
914 $dd *= -1;
915
916 } else {
917 $y += $dy;
918 $self->_mod_add(-12,$dm,\$m,\$y);
919 }
920
921 my $dim = $self->days_in_month($y,$m);
922 $d = $dim if ($d > $dim);
923
924 my $ymd;
925 if ($dd == 0) {
926 $ymd = [$y,$m,$d];
927 } else {
928 $ymd = $self->calc_date_days([$y,$m,$d],$dd);
929 }
930
931 if ($ymdonly) {
932 return $ymd;
933 } else {
934 return [@$ymd,$h,$mn,$s];
935 }
936}
937
938sub _calc_hms_hms {
939 my($self,$hms0,$hms1) = @_;
940 my($h0,$m0,$s0,$h1,$m1,$s1) = (@$hms0,@$hms1);
941
942 my($s) = ($h1-$h0)*3600 + ($m1-$m0)*60 + $s1-$s0;
943 my($m) = int($s/60);
944 $s -= $m*60;
945 my($h) = int($m/60);
946 $m -= $h*60;
947 return [$h,$m,$s];
948}
949
950sub calc_time_time {
951 my($self,$time0,$time1,$subtract) = @_;
952 my($h0,$m0,$s0,$h1,$m1,$s1) = (@$time0,@$time1);
953
954 if ($subtract) {
955 $h1 *= -1;
956 $m1 *= -1;
957 $s1 *= -1;
958 }
959 my($s) = (($h0+$h1)*60 + ($m0+$m1))*60 + $s0+$s1;
960 my($m) = int($s/60);
961 $s -= $m*60;
962 my($h) = int($m/60);
963 $m -= $h*60;
964
965 return [$h,$m,$s];
966}
967
968###############################################################################
969
970# Returns -1 if date0 is before date1, 0 if date0 is the same as date1, and
971# 1 if date0 is after date1.
972#
973
# spent 4µs within Date::Manip::Base::cmp which was called 2 times, avg 2µs/call: # 2 times (4µs+0s) by Date::Manip::TZ::zone at line 925 of Date/Manip/TZ.pm, avg 2µs/call
sub cmp {
9742700ns my($self,$date0,$date1) = @_;
97524µs return ($$date0[0] <=> $$date1[0] ||
976 $$date0[1] <=> $$date1[1] ||
977 $$date0[2] <=> $$date1[2] ||
978 $$date0[3] <=> $$date1[3] ||
979 $$date0[4] <=> $$date1[4] ||
980 $$date0[5] <=> $$date1[5]);
981}
982
983###############################################################################
984# This determines the OS.
985
986
# spent 55µs (41+14) within Date::Manip::Base::_os which was called 4 times, avg 14µs/call: # 2 times (22µs+8µs) by Date::Manip::Base::_init_config at line 207, avg 15µs/call # 2 times (19µs+5µs) by Date::Manip::TZ::_init at line 96 of Date/Manip/TZ.pm, avg 12µs/call
sub _os {
98741µs my($self) = @_;
988
98941µs my $os = '';
990
991446µs3214µs if ($^O =~ /MSWin32/io ||
# spent 14µs making 32 calls to Date::Manip::Base::CORE:match, avg 438ns/call
992 $^O =~ /Windows_95/io ||
993 $^O =~ /Windows_NT/io
994 ) {
995 $os = 'Windows';
996
997 } elsif ($^O =~ /MacOS/io ||
998 $^O =~ /MPE/io ||
999 $^O =~ /OS2/io ||
1000 $^O =~ /NetWare/io
1001 ) {
1002 $os = 'Other';
1003
1004 } elsif ($^O =~ /VMS/io) {
1005 $os = 'VMS';
1006
1007 } else {
100841µs $os = 'Unix';
1009 }
1010
101149µs return $os;
1012}
1013
1014###############################################################################
1015# Config variable functions
1016
1017# $self->config(SECT);
1018# Creates a new section (if it doesn't already exist).
1019#
1020# $self->config(SECT,'_vars');
1021# Returns a list of (VAR VAL VAR VAL ...)
1022#
1023# $self->config(SECT,VAR,VAL);
1024# Adds (VAR,VAL) to the list.
1025#
1026sub _section {
1027 my($self,$sect,$var,$val) = @_;
1028 $sect = lc($sect);
1029
1030 #
1031 # $self->_section(SECT) creates a new section
1032 #
1033
1034 if (! defined $var &&
1035 ! exists $$self{'data'}{'sections'}{$sect}) {
1036 if ($sect eq 'conf') {
1037 $$self{'data'}{'sections'}{$sect} = {};
1038 } else {
1039 $$self{'data'}{'sections'}{$sect} = [];
1040 }
1041 return '';
1042 }
1043
1044 if ($var eq '_vars') {
1045 return @{ $$self{'data'}{'sections'}{$sect} };
1046 }
1047
1048 push @{ $$self{'data'}{'sections'}{$sect} },($var,$val);
1049 return;
1050}
1051
1052# This sets a config variable. It also performs all side effects from
1053# setting that variable.
1054#
1055
# spent 9.89ms (134µs+9.75) within Date::Manip::Base::_config_var_base which was called 28 times, avg 353µs/call: # 28 times (134µs+9.75ms) by Date::Manip::TZ_Base::_config_var at line 39 of Date/Manip/TZ_Base.pm, avg 353µs/call
sub _config_var_base {
1056285µs my($self,$var,$val) = @_;
1057
10582830µs if ($var eq 'defaults') {
1059 # Reset the configuration if desired.
1060 $self->_init_config(1);
1061 return;
1062
1063 } elsif ($var eq 'eraseholidays') {
1064 $self->_init_holidays(1);
1065 return;
1066
1067 } elsif ($var eq 'eraseevents') {
1068 $self->_init_events(1);
1069 return;
1070
1071 } elsif ($var eq 'configfile') {
1072 $self->_config_file($val);
1073 return;
1074
1075 } elsif ($var eq 'encoding') {
1076 my $err = $self->_config_var_encoding($val);
1077 return if ($err);
1078
1079 } elsif ($var eq 'language') {
108023µs29.22ms my $err = $self->_language($val);
# spent 9.22ms making 2 calls to Date::Manip::Base::_language, avg 4.61ms/call
10812400ns return if ($err);
108224µs214µs $err = $self->_config_var_encoding();
# spent 14µs making 2 calls to Date::Manip::Base::_config_var_encoding, avg 7µs/call
10832600ns return if ($err);
1084
1085 } elsif ($var eq 'yytoyyyy') {
10862800ns $val = lc($val);
1087211µs63µs if ($val ne 'c' &&
# spent 3µs making 6 calls to Date::Manip::Base::CORE:match, avg 550ns/call
1088 $val !~ /^c\d\d$/o &&
1089 $val !~ /^c\d\d\d\d$/o &&
1090 $val !~ /^\d+$/o) {
1091 warn "ERROR: [config_var] invalid: YYtoYYYY: $val\n";
1092 return;
1093 }
1094
1095 } elsif ($var eq 'workweekbeg') {
109623µs256µs my $err = $self->_config_var_workweekbeg($val);
# spent 56µs making 2 calls to Date::Manip::Base::_config_var_workweekbeg, avg 28µs/call
10972600ns return if ($err);
1098
1099 } elsif ($var eq 'workweekend') {
1100215µs260µs my $err = $self->_config_var_workweekend($val);
# spent 60µs making 2 calls to Date::Manip::Base::_config_var_workweekend, avg 30µs/call
11012800ns return if ($err);
1102
1103 } elsif ($var eq 'workday24hr') {
110445µs444µs my $err = $self->_config_var_workday24hr($val);
# spent 44µs making 4 calls to Date::Manip::Base::_config_var_workday24hr, avg 11µs/call
11054800ns return if ($err);
1106
1107 } elsif ($var eq 'workdaybeg') {
110824µs2180µs my $err = $self->_config_var_workdaybegend(\$val,'WorkDayBeg');
# spent 180µs making 2 calls to Date::Manip::Base::_config_var_workdaybegend, avg 90µs/call
11092700ns return if ($err);
1110
1111 } elsif ($var eq 'workdayend') {
111223µs2131µs my $err = $self->_config_var_workdaybegend(\$val,'WorkDayEnd');
# spent 131µs making 2 calls to Date::Manip::Base::_config_var_workdaybegend, avg 66µs/call
11132500ns return if ($err);
1114
1115 } elsif ($var eq 'firstday') {
111623µs223µs my $err = $self->_config_var_firstday($val);
# spent 23µs making 2 calls to Date::Manip::Base::_config_var_firstday, avg 12µs/call
11172600ns return if ($err);
1118
1119 } elsif ($var eq 'tz' ||
1120 $var eq 'forcedate' ||
1121 $var eq 'setdate') {
1122 # These can only be used if the Date::Manip::TZ module has been loaded
1123 warn "ERROR: [config_var] $var config variable requires TZ module\n";
1124 return;
1125
1126 } elsif ($var eq 'recurrange') {
112723µs217µs my $err = $self->_config_var_recurrange($val);
# spent 17µs making 2 calls to Date::Manip::Base::_config_var_recurrange, avg 8µs/call
11282600ns return if ($err);
1129
1130 } elsif ($var eq 'defaulttime') {
113124µs25µs my $err = $self->_config_var_defaulttime($val);
# spent 5µs making 2 calls to Date::Manip::Base::_config_var_defaulttime, avg 2µs/call
11322500ns return if ($err);
1133
1134 } elsif ($var eq 'periodtimesep') {
1135 # We have to redo the time regexp
1136 delete $$self{'data'}{'rx'}{'time'};
1137
1138 } elsif ($var eq 'dateformat' ||
1139 $var eq 'jan1week1' ||
1140 $var eq 'printable' ||
1141 $var eq 'tomorrowfirst') {
1142 # do nothing
1143
1144 } else {
1145 warn "ERROR: [config_var] invalid config variable: $var\n";
1146 return '';
1147 }
1148
11492815µs $$self{'data'}{'sections'}{'conf'}{$var} = $val;
11502846µs return;
1151}
1152
1153###############################################################################
1154# Specific config variable functions
1155
1156
# spent 14µs within Date::Manip::Base::_config_var_encoding which was called 2 times, avg 7µs/call: # 2 times (14µs+0s) by Date::Manip::Base::_config_var_base at line 1082, avg 7µs/call
sub _config_var_encoding {
11572900ns my($self,$val) = @_;
1158
115921µs if (! $val) {
116024µs $$self{'data'}{'calc'}{'enc_in'} = [ @{ $$self{'data'}{'enc'} } ];
116122µs $$self{'data'}{'calc'}{'enc_out'} = 'UTF-8';
1162
1163 } elsif ($val =~ /^(.*),(.*)$/o) {
1164 my($in,$out) = ($1,$2);
1165 if ($in) {
1166 my $o = find_encoding($in);
1167 if (! $o) {
1168 warn "ERROR: [config_var] invalid: Encoding: $in\n";
1169 return 1;
1170 }
1171 }
1172 if ($out) {
1173 my $o = find_encoding($out);
1174 if (! $o) {
1175 warn "ERROR: [config_var] invalid: Encoding: $out\n";
1176 return 1;
1177 }
1178 }
1179
1180 if ($in && $out) {
1181 $$self{'data'}{'calc'}{'enc_in'} = [ $in ];
1182 $$self{'data'}{'calc'}{'enc_out'} = $out;
1183
1184 } elsif ($in) {
1185 $$self{'data'}{'calc'}{'enc_in'} = [ $in ];
1186 $$self{'data'}{'calc'}{'enc_out'} = 'UTF-8';
1187
1188 } elsif ($out) {
1189 $$self{'data'}{'calc'}{'enc_in'} = [ @{ $$self{'data'}{'enc'} } ];
1190 $$self{'data'}{'calc'}{'enc_out'} = $out;
1191
1192 } else {
1193 $$self{'data'}{'calc'}{'enc_in'} = [ @{ $$self{'data'}{'enc'} } ];
1194 $$self{'data'}{'calc'}{'enc_out'} = 'UTF-8';
1195 }
1196
1197 } else {
1198 my $o = find_encoding($val);
1199 if (! $o) {
1200 warn "ERROR: [config_var] invalid: Encoding: $val\n";
1201 return 1;
1202 }
1203 $$self{'data'}{'calc'}{'enc_in'} = [ $val ];
1204 $$self{'data'}{'calc'}{'enc_out'} = $val;
1205 }
1206
120724µs if (! @{ $$self{'data'}{'calc'}{'enc_in'} }) {
1208 $$self{'data'}{'calc'}{'enc_in'} = [ qw(utf-8 perl) ];
1209 }
1210
121125µs return 0;
1212}
1213
1214
# spent 17µs (12+5) within Date::Manip::Base::_config_var_recurrange which was called 2 times, avg 8µs/call: # 2 times (12µs+5µs) by Date::Manip::Base::_config_var_base at line 1127, avg 8µs/call
sub _config_var_recurrange {
12152600ns my($self,$val) = @_;
1216
121721µs $val = lc($val);
1218217µs25µs if ($val =~ /^(none|year|month|week|day|all)$/o) {
# spent 5µs making 2 calls to Date::Manip::Base::CORE:match, avg 2µs/call
1219 return 0;
1220 }
1221
1222 warn "ERROR: [config_var] invalid: RecurRange: $val\n";
1223 return 1;
1224}
1225
1226
# spent 56µs (25+31) within Date::Manip::Base::_config_var_workweekbeg which was called 2 times, avg 28µs/call: # 2 times (25µs+31µs) by Date::Manip::Base::_config_var_base at line 1096, avg 28µs/call
sub _config_var_workweekbeg {
12272500ns my($self,$val) = @_;
1228
122923µs27µs if (! $self->_is_int($val,1,7)) {
# spent 7µs making 2 calls to Date::Manip::Base::_is_int, avg 3µs/call
1230 warn "ERROR: [config_var] invalid: WorkWeekBeg: $val\n";
1231 return 1;
1232 }
123323µs26µs if ($val >= $self->_config('workweekend')) {
# spent 6µs making 2 calls to Date::Manip::TZ_Base::_config, avg 3µs/call
1234 warn "ERROR: [config_var] WorkWeekBeg must be before WorkWeekEnd\n";
1235 return 1;
1236 }
1237
123822µs29µs $self->_calc_workweek($val,'');
# spent 9µs making 2 calls to Date::Manip::Base::_calc_workweek, avg 5µs/call
123923µs29µs $self->_init_business_length();
# spent 9µs making 2 calls to Date::Manip::Base::_init_business_length, avg 4µs/call
124024µs return 0;
1241}
1242
1243
# spent 60µs (34+26) within Date::Manip::Base::_config_var_workweekend which was called 2 times, avg 30µs/call: # 2 times (34µs+26µs) by Date::Manip::Base::_config_var_base at line 1100, avg 30µs/call
sub _config_var_workweekend {
12442700ns my($self,$val) = @_;
1245
124622µs27µs if (! $self->_is_int($val,1,7)) {
# spent 7µs making 2 calls to Date::Manip::Base::_is_int, avg 4µs/call
1247 warn "ERROR: [config_var] invalid: WorkWeekBeg: $val\n";
1248 return 1;
1249 }
125022µs24µs if ($val <= $self->_config('workweekbeg')) {
# spent 4µs making 2 calls to Date::Manip::TZ_Base::_config, avg 2µs/call
1251 warn "ERROR: [config_var] WorkWeekEnd must be after WorkWeekBeg\n";
1252 return 1;
1253 }
1254
125522µs29µs $self->_calc_workweek('',$val);
# spent 9µs making 2 calls to Date::Manip::Base::_calc_workweek, avg 4µs/call
125622µs26µs $self->_init_business_length();
# spent 6µs making 2 calls to Date::Manip::Base::_init_business_length, avg 3µs/call
125724µs return 0;
1258}
1259
1260
# spent 44µs (23+21) within Date::Manip::Base::_config_var_workday24hr which was called 4 times, avg 11µs/call: # 4 times (23µs+21µs) by Date::Manip::Base::_config_var_base at line 1104, avg 11µs/call
sub _config_var_workday24hr {
126141µs my($self,$val) = @_;
1262
126341µs if ($val) {
126422µs $$self{'data'}{'sections'}{'conf'}{'workdaybeg'} = '00:00:00';
126521µs $$self{'data'}{'sections'}{'conf'}{'workdayend'} = '24:00:00';
126623µs $$self{'data'}{'calc'}{'workdaybeg'} = [0,0,0];
126721µs $$self{'data'}{'calc'}{'workdayend'} = [24,0,0];
1268
126923µs29µs $self->_calc_bdlength();
# spent 9µs making 2 calls to Date::Manip::Base::_calc_bdlength, avg 5µs/call
127023µs212µs $self->_init_business_length();
# spent 12µs making 2 calls to Date::Manip::Base::_init_business_length, avg 6µs/call
1271 }
1272
127347µs return 0;
1274}
1275
1276
# spent 311µs (58+253) within Date::Manip::Base::_config_var_workdaybegend which was called 4 times, avg 78µs/call: # 2 times (35µs+145µs) by Date::Manip::Base::_config_var_base at line 1108, avg 90µs/call # 2 times (23µs+108µs) by Date::Manip::Base::_config_var_base at line 1112, avg 66µs/call
sub _config_var_workdaybegend {
127741µs my($self,$val,$conf) = @_;
1278
1279 # Must be a valid time. Entered as H, H:M, or H:M:S
1280
128146µs4143µs my $tmp = $self->split('hms',$$val);
# spent 143µs making 4 calls to Date::Manip::Base::split, avg 36µs/call
12824900ns if (! defined $tmp) {
1283 warn "ERROR: [config_var] invalid: $conf: $$val\n";
1284 return 1;
1285 }
128644µs $$self{'data'}{'calc'}{lc($conf)} = $tmp;
128747µs483µs $$val = $self->join('hms',$tmp);
# spent 83µs making 4 calls to Date::Manip::Base::join, avg 21µs/call
1288
1289 # workdaybeg < workdayend
1290
129144µs my @beg = @{ $$self{'data'}{'calc'}{'workdaybeg'} };
129243µs my @end = @{ $$self{'data'}{'calc'}{'workdayend'} };
129342µs my $beg = $beg[0]*3600 + $beg[1]*60 + $beg[2];
129441µs my $end = $end[0]*3600 + $end[1]*60 + $end[2];
1295
12964800ns if ($beg > $end) {
1297 warn "ERROR: [config_var] WorkDayBeg not before WorkDayEnd\n";
1298 return 1;
1299 }
1300
1301 # Calculate bdlength
1302
130342µs $$self{'data'}{'sections'}{'conf'}{'workday24hr'} = 0;
1304
130544µs411µs $self->_calc_bdlength();
# spent 11µs making 4 calls to Date::Manip::Base::_calc_bdlength, avg 3µs/call
130644µs416µs $self->_init_business_length();
# spent 16µs making 4 calls to Date::Manip::Base::_init_business_length, avg 4µs/call
1307
1308410µs return 0;
1309}
1310
1311
# spent 23µs (11+12) within Date::Manip::Base::_config_var_firstday which was called 2 times, avg 12µs/call: # 2 times (11µs+12µs) by Date::Manip::Base::_config_var_base at line 1116, avg 12µs/call
sub _config_var_firstday {
13122700ns my($self,$val) = @_;
1313
131424µs212µs if (! $self->_is_int($val,1,7)) {
# spent 12µs making 2 calls to Date::Manip::Base::_is_int, avg 6µs/call
1315 warn "ERROR: [config_var] invalid: FirstDay: $val\n";
1316 return 1;
1317 }
1318
131925µs return 0;
1320}
1321
1322
# spent 5µs within Date::Manip::Base::_config_var_defaulttime which was called 2 times, avg 2µs/call: # 2 times (5µs+0s) by Date::Manip::Base::_config_var_base at line 1131, avg 2µs/call
sub _config_var_defaulttime {
13232700ns my($self,$val) = @_;
1324
132526µs if (lc($val) eq 'midnight' ||
1326 lc($val) eq 'curr') {
1327 return 0;
1328 }
1329 warn "ERROR: [config_var] invalid: DefaultTime: $val\n";
1330 return 1;
1331}
1332
1333###############################################################################
1334# Language functions
1335
1336# This reads in a langauge module and sets regular expressions
1337# and word lists based on it.
1338#
13392107µs229µs
# spent 18µs (7+11) within Date::Manip::Base::BEGIN@1339 which was called: # once (7µs+11µs) by Date::Manip::Date::BEGIN@26 at line 1339
no strict 'refs';
# spent 18µs making 1 call to Date::Manip::Base::BEGIN@1339 # spent 11µs making 1 call to strict::unimport
1340
# spent 9.22ms (1.63+7.59) within Date::Manip::Base::_language which was called 2 times, avg 4.61ms/call: # 2 times (1.63ms+7.59ms) by Date::Manip::Base::_config_var_base at line 1080, avg 4.61ms/call
sub _language {
13412500ns my($self,$lang) = @_;
134221µs $lang = lc($lang);
1343
134422µs if (! exists $Date::Manip::Lang::index::Lang{$lang}) {
1345 warn "ERROR: [language] invalid: $lang\n";
1346 return 1;
1347 }
1348
134924µs return 0 if (exists $$self{'data'}{'sections'}{'conf'} &&
1350 $$self{'data'}{'sections'}{'conf'} eq $lang);
135122µs26µs $self->_init_language(1);
# spent 6µs making 2 calls to Date::Manip::Base::_init_language, avg 3µs/call
1352
135321µs my $mod = $Date::Manip::Lang::index::Lang{$lang};
1354271µs eval "require Date::Manip::Lang::${mod}";
# spent 958µs executing statements in 2 string evals (merged)
13552600ns if ($@) {
1356 die "ERROR: failed to load Date::Manip::Lang::${mod}: $@\n";
1357 }
1358
13592164µs232µs
# spent 20µs (7+13) within Date::Manip::Base::BEGIN@1359 which was called: # once (7µs+13µs) by Date::Manip::Date::BEGIN@26 at line 1359
no warnings 'once';
# spent 20µs making 1 call to Date::Manip::Base::BEGIN@1359 # spent 13µs making 1 call to warnings::unimport
136027µs $$self{'data'}{'lang'} = ${ "Date::Manip::Lang::${mod}::Language" };
136126µs $$self{'data'}{'enc'} = [ @{ "Date::Manip::Lang::${mod}::Encodings" } ];
1362
1363 # Common words
136425µs244µs $self->_rx_wordlist('at');
# spent 44µs making 2 calls to Date::Manip::Base::_rx_wordlist, avg 22µs/call
136522µs233µs $self->_rx_wordlist('each');
# spent 33µs making 2 calls to Date::Manip::Base::_rx_wordlist, avg 16µs/call
136622µs224µs $self->_rx_wordlist('last');
# spent 24µs making 2 calls to Date::Manip::Base::_rx_wordlist, avg 12µs/call
136722µs225µs $self->_rx_wordlist('of');
# spent 25µs making 2 calls to Date::Manip::Base::_rx_wordlist, avg 12µs/call
136822µs216µs $self->_rx_wordlist('on');
# spent 16µs making 2 calls to Date::Manip::Base::_rx_wordlist, avg 8µs/call
136923µs2168µs $self->_rx_wordlists('when');
# spent 168µs making 2 calls to Date::Manip::Base::_rx_wordlists, avg 84µs/call
1370
1371 # Next/prev
137222µs272µs $self->_rx_wordlists('nextprev');
# spent 72µs making 2 calls to Date::Manip::Base::_rx_wordlists, avg 36µs/call
1373
1374 # Field names (years, year, yr, ...)
137522µs2654µs $self->_rx_wordlists('fields');
# spent 654µs making 2 calls to Date::Manip::Base::_rx_wordlists, avg 327µs/call
1376
1377 # Numbers (first, 1st)
137823µs22.80ms $self->_rx_wordlists('nth');
# spent 2.80ms making 2 calls to Date::Manip::Base::_rx_wordlists, avg 1.40ms/call
137923µs21.44ms $self->_rx_wordlists('nth','nth_dom',31); # 1-31
# spent 1.44ms making 2 calls to Date::Manip::Base::_rx_wordlists, avg 722µs/call
138023µs2235µs $self->_rx_wordlists('nth','nth_wom',5); # 1-5
# spent 235µs making 2 calls to Date::Manip::Base::_rx_wordlists, avg 118µs/call
1381
1382 # Calendar names (Mon, Tue and Jan, Feb)
138322µs2324µs $self->_rx_wordlists('day_abb');
# spent 324µs making 2 calls to Date::Manip::Base::_rx_wordlists, avg 162µs/call
138422µs2137µs $self->_rx_wordlists('day_char');
# spent 137µs making 2 calls to Date::Manip::Base::_rx_wordlists, avg 69µs/call
138522µs2137µs $self->_rx_wordlists('day_name');
# spent 137µs making 2 calls to Date::Manip::Base::_rx_wordlists, avg 69µs/call
138622µs2507µs $self->_rx_wordlists('month_abb');
# spent 507µs making 2 calls to Date::Manip::Base::_rx_wordlists, avg 254µs/call
138722µs2231µs $self->_rx_wordlists('month_name');
# spent 231µs making 2 calls to Date::Manip::Base::_rx_wordlists, avg 115µs/call
1388
1389 # H:M:S separators
139025µs28µs $self->_rx_simple('sephm');
# spent 8µs making 2 calls to Date::Manip::Base::_rx_simple, avg 4µs/call
139122µs22µs $self->_rx_simple('sepms');
# spent 2µs making 2 calls to Date::Manip::Base::_rx_simple, avg 1µs/call
139222µs22µs $self->_rx_simple('sepfr');
# spent 2µs making 2 calls to Date::Manip::Base::_rx_simple, avg 1µs/call
1393
1394 # Time replacement strings
139523µs2177µs $self->_rx_replace('times');
# spent 177µs making 2 calls to Date::Manip::Base::_rx_replace, avg 89µs/call
1396
1397 # Some offset strings
139824µs2252µs $self->_rx_replace('offset_date');
# spent 252µs making 2 calls to Date::Manip::Base::_rx_replace, avg 126µs/call
139923µs272µs $self->_rx_replace('offset_time');
# spent 72µs making 2 calls to Date::Manip::Base::_rx_replace, avg 36µs/call
1400
1401 # AM/PM strings
140223µs299µs $self->_rx_wordlists('ampm');
# spent 99µs making 2 calls to Date::Manip::Base::_rx_wordlists, avg 49µs/call
1403
1404 # Business/non-business mode
140522µs262µs $self->_rx_wordlists('mode');
# spent 62µs making 2 calls to Date::Manip::Base::_rx_wordlists, avg 31µs/call
1406
140725µs return 0;
1408}
14092245µs224µs
# spent 17µs (9+8) within Date::Manip::Base::BEGIN@1409 which was called: # once (9µs+8µs) by Date::Manip::Date::BEGIN@26 at line 1409
use strict 'refs';
# spent 17µs making 1 call to Date::Manip::Base::BEGIN@1409 # spent 8µs making 1 call to strict::import
1410
1411# This takes a string or strings from the language file which is a
1412# regular expression and copies it to the regular expression cache.
1413#
1414# If the language file contains a list of strings, a list of strings
1415# is stored in the regexp cache.
1416#
1417
# spent 12µs within Date::Manip::Base::_rx_simple which was called 6 times, avg 2µs/call: # 2 times (8µs+0s) by Date::Manip::Base::_language at line 1390, avg 4µs/call # 2 times (2µs+0s) by Date::Manip::Base::_language at line 1391, avg 1µs/call # 2 times (2µs+0s) by Date::Manip::Base::_language at line 1392, avg 1µs/call
sub _rx_simple {
141862µs my($self,$ele) = @_;
1419
1420612µs if (exists $$self{'data'}{'lang'}{$ele}) {
1421 if (ref($$self{'data'}{'lang'}{$ele})) {
1422 @{ $$self{'data'}{'rx'}{$ele} } = @{ $$self{'data'}{'lang'}{$ele} };
1423 } else {
1424 $$self{'data'}{'rx'}{$ele} = $$self{'data'}{'lang'}{$ele};
1425 }
1426 } else {
142764µs $$self{'data'}{'rx'}{$ele} = undef;
1428 }
1429}
1430
1431# We need to quote strings that will be used in regexps, but we don't
1432# want to quote UTF-8 characters.
1433#
1434
# spent 2.46ms (1.93+529µs) within Date::Manip::Base::_qe_quote which was called 830 times, avg 3µs/call: # 782 times (1.84ms+512µs) by Date::Manip::Base::_rx_wordlists at line 1527, avg 3µs/call # 16 times (32µs+7µs) by Date::Manip::Base::_rx_wordlist at line 1459, avg 2µs/call # 16 times (29µs+7µs) by Date::Manip::Base::_rx_replace at line 1493, avg 2µs/call # 16 times (27µs+4µs) by Date::Manip::Base::_rx_replace at line 1499, avg 2µs/call
sub _qe_quote {
1435830110µs my($string) = @_;
14368301.76ms1250529µs $string =~ s/([-.+*?])/\\$1/g;
# spent 354µs making 830 calls to Date::Manip::Base::CORE:subst, avg 426ns/call # spent 176µs making 420 calls to Date::Manip::Base::CORE:substcont, avg 419ns/call
14378301.01ms return $string;
1438}
1439
1440# This takes a list of words and creates a simple regexp which matches
1441# any of them.
1442#
1443# The first word in the list is the default way to express the word using
1444# a normal ASCII character set.
1445#
1446# The second word in the list is the default way to express the word using
1447# a locale character set. If it isn't defined, it defaults to the first word.
1448#
1449
# spent 142µs (86+56) within Date::Manip::Base::_rx_wordlist which was called 10 times, avg 14µs/call: # 2 times (27µs+16µs) by Date::Manip::Base::_language at line 1364, avg 22µs/call # 2 times (17µs+16µs) by Date::Manip::Base::_language at line 1365, avg 16µs/call # 2 times (15µs+10µs) by Date::Manip::Base::_language at line 1367, avg 12µs/call # 2 times (15µs+9µs) by Date::Manip::Base::_language at line 1366, avg 12µs/call # 2 times (12µs+5µs) by Date::Manip::Base::_language at line 1368, avg 8µs/call
sub _rx_wordlist {
1450102µs my($self,$ele) = @_;
1451
14521020µs if (exists $$self{'data'}{'lang'}{$ele}) {
1453108µs my @tmp = @{ $$self{'data'}{'lang'}{$ele} };
1454
1455105µs $$self{'data'}{'wordlist'}{$ele} = $tmp[0];
1456
1457101µs my @tmp2;
1458104µs foreach my $tmp (@tmp) {
14591617µs1638µs push(@tmp2,_qe_quote($tmp)) if ($tmp);
# spent 38µs making 16 calls to Date::Manip::Base::_qe_quote, avg 2µs/call
1460 }
14611020µs1018µs @tmp2 = sort _sortByLength(@tmp2);
# spent 18µs making 10 calls to Date::Manip::Base::CORE:sort, avg 2µs/call
1462
14631014µs $$self{'data'}{'rx'}{$ele} = join('|',@tmp2);
1464
1465 } else {
1466 $$self{'data'}{'rx'}{$ele} = undef;
1467 }
1468}
1469
1470248µs222µs
# spent 14µs (6+8) within Date::Manip::Base::BEGIN@1470 which was called: # once (6µs+8µs) by Date::Manip::Date::BEGIN@26 at line 1470
no strict 'vars';
# spent 14µs making 1 call to Date::Manip::Base::BEGIN@1470 # spent 8µs making 1 call to strict::unimport
1471sub _sortByLength {
147241981.22ms return (length $b <=> length $a);
1473}
147421.45ms218µs
# spent 12µs (5+7) within Date::Manip::Base::BEGIN@1474 which was called: # once (5µs+7µs) by Date::Manip::Date::BEGIN@26 at line 1474
use strict 'vars';
# spent 12µs making 1 call to Date::Manip::Base::BEGIN@1474 # spent 7µs making 1 call to strict::import
1475
1476# This takes a hash of the form:
1477# word => string
1478# and creates a regular expression to match word (which must be surrounded
1479# by word boundaries).
1480#
1481
# spent 501µs (199+301) within Date::Manip::Base::_rx_replace which was called 6 times, avg 83µs/call: # 2 times (93µs+159µs) by Date::Manip::Base::_language at line 1398, avg 126µs/call # 2 times (72µs+105µs) by Date::Manip::Base::_language at line 1395, avg 89µs/call # 2 times (34µs+37µs) by Date::Manip::Base::_language at line 1399, avg 36µs/call
sub _rx_replace {
148262µs my($self,$ele) = @_;
1483
148463µs if (! exists $$self{'data'}{'lang'}{$ele}) {
1485 $$self{'data'}{'rx'}{$ele} = [];
1486 return;
1487 }
1488
1489610µs my(@key) = keys %{ $$self{'data'}{'lang'}{$ele} };
149061µs my $i = 1;
1491616µs66µs foreach my $key (sort(@key)) {
# spent 6µs making 6 calls to Date::Manip::Base::CORE:sort, avg 967ns/call
1492167µs my $val = $$self{'data'}{'lang'}{$ele}{$key};
14931612µs1635µs my $k = _qe_quote($key);
# spent 35µs making 16 calls to Date::Manip::Base::_qe_quote, avg 2µs/call
149416184µs32130µs $$self{'data'}{'rx'}{$ele}[$i++] = qr/(?:^|\b)($k)(?:\b|$)/i;
# spent 112µs making 16 calls to Date::Manip::Base::CORE:regcomp, avg 7µs/call # spent 18µs making 16 calls to Date::Manip::Base::CORE:qr, avg 1µs/call
14951622µs $$self{'data'}{'wordmatch'}{$ele}{lc($key)} = $val;
1496 }
1497
149868µs610µs @key = sort _sortByLength(@key);
# spent 10µs making 6 calls to Date::Manip::Base::CORE:sort, avg 2µs/call
14992222µs1631µs @key = map { _qe_quote($_) } @key;
# spent 31µs making 16 calls to Date::Manip::Base::_qe_quote, avg 2µs/call
150065µs my $rx = join('|',@key);
1501
15026122µs1290µs $$self{'data'}{'rx'}{$ele}[0] = qr/(?:^|\b)(?:$rx)(?:\b|$)/i;
# spent 85µs making 6 calls to Date::Manip::Base::CORE:regcomp, avg 14µs/call # spent 5µs making 6 calls to Date::Manip::Base::CORE:qr, avg 817ns/call
1503}
1504
1505# This takes a list of values, each of which can be expressed in multiple
1506# ways, and gets a regular expression which matches any of them, a default
1507# way to express each value, and a hash which matches a matched string to
1508# a value (the value is 1..N where N is the number of values).
1509#
1510
# spent 6.87ms (3.36+3.52) within Date::Manip::Base::_rx_wordlists which was called 26 times, avg 264µs/call: # 2 times (1.24ms+1.56ms) by Date::Manip::Base::_language at line 1378, avg 1.40ms/call # 2 times (705µs+738µs) by Date::Manip::Base::_language at line 1379, avg 722µs/call # 2 times (278µs+376µs) by Date::Manip::Base::_language at line 1375, avg 327µs/call # 2 times (244µs+263µs) by Date::Manip::Base::_language at line 1386, avg 254µs/call # 2 times (154µs+170µs) by Date::Manip::Base::_language at line 1383, avg 162µs/call # 2 times (134µs+101µs) by Date::Manip::Base::_language at line 1380, avg 118µs/call # 2 times (161µs+69µs) by Date::Manip::Base::_language at line 1387, avg 115µs/call # 2 times (99µs+68µs) by Date::Manip::Base::_language at line 1369, avg 84µs/call # 2 times (98µs+40µs) by Date::Manip::Base::_language at line 1384, avg 69µs/call # 2 times (97µs+40µs) by Date::Manip::Base::_language at line 1385, avg 69µs/call # 2 times (51µs+48µs) by Date::Manip::Base::_language at line 1402, avg 49µs/call # 2 times (48µs+23µs) by Date::Manip::Base::_language at line 1372, avg 36µs/call # 2 times (44µs+18µs) by Date::Manip::Base::_language at line 1405, avg 31µs/call
sub _rx_wordlists {
1511268µs my($self,$ele,$subset,$max) = @_;
1512265µs $subset = $ele if (! $subset);
1513
15142661µs if (exists $$self{'data'}{'lang'}{$ele}) {
15152628µs my @vallist = @{ $$self{'data'}{'lang'}{$ele} };
15162612µs $max = $#vallist+1 if (! $max || $max > $#vallist+1);
1517262µs my (@all);
1518
15192672µs for (my $i=1; $i<=$max; $i++) {
1520298199µs my @tmp = @{ $$self{'data'}{'lang'}{$ele}[$i-1] };
1521298132µs $$self{'data'}{'wordlist'}{$subset}[$i-1] = $tmp[0];
1522
152329817µs my @str;
152429889µs foreach my $str (@tmp) {
152578248µs next if (! $str);
1526782541µs $$self{'data'}{'wordmatch'}{$subset}{lc($str)} = $i;
1527782775µs7822.35ms push(@str,_qe_quote($str));
# spent 2.35ms making 782 calls to Date::Manip::Base::_qe_quote, avg 3µs/call
1528 }
1529298108µs push(@all,@str);
1530
1531298292µs298574µs @str = sort _sortByLength(@str);
# spent 574µs making 298 calls to Date::Manip::Base::CORE:sort, avg 2µs/call
1532298443µs $$self{'data'}{'rx'}{$subset}[$i] = join('|',@str);
1533 }
1534
15352619µs26591µs @all = sort _sortByLength(@all);
# spent 591µs making 26 calls to Date::Manip::Base::CORE:sort, avg 23µs/call
153626104µs $$self{'data'}{'rx'}{$subset}[0] = join('|',@all);
1537
1538 } else {
1539 $$self{'data'}{'rx'}{$subset} = undef;
1540 }
1541}
1542
1543###############################################################################
1544# Year functions
1545#
1546# $self->_method(METHOD) use METHOD as the method for YY->YYYY
1547# conversions
1548#
1549# YEAR = _fix_year(YR) converts a 2-digit to 4-digit year
1550
1551sub _method {
1552 my($self,$method) = @_;
1553 $self->_config('yytoyyyy',$method);
1554}
1555
1556# _fix_year is in TZ_Base
1557
1558###############################################################################
1559# $self->_mod_add($N,$add,\$val,\$rem);
1560# This calculates $val=$val+$add and forces $val to be in a certain
1561# range. This is useful for adding numbers for which only a certain
1562# range is allowed (for example, minutes can be between 0 and 59 or
1563# months can be between 1 and 12). The absolute value of $N determines
1564# the range and the sign of $N determines whether the range is 0 to N-1
1565# (if N>0) or 1 to N (N<0). $rem is adjusted to force $val into the
1566# appropriate range.
1567# Example:
1568# To add 2 hours together (with the excess returned in days) use:
1569# $self->_mod_add(-24,$h1,\$h,\$day);
1570# To add 2 minutes together (with the excess returned in hours):
1571# $self->_mod_add(60,$mn1,\$mn,\$hr);
1572sub _mod_add {
1573 my($self,$N,$add,$val,$rem)=@_;
1574 return if ($N==0);
1575 $$val+=$add;
1576 if ($N<0) {
1577 # 1 to N
1578 $N = -$N;
1579 if ($$val>$N) {
1580 $$rem+= int(($$val-1)/$N);
1581 $$val = ($$val-1)%$N +1;
1582 } elsif ($$val<1) {
1583 $$rem-= int(-$$val/$N)+1;
1584 $$val = $N-(-$$val % $N);
1585 }
1586
1587 } else {
1588 # 0 to N-1
1589 if ($$val>($N-1)) {
1590 $$rem+= int($$val/$N);
1591 $$val = $$val%$N;
1592 } elsif ($$val<0) {
1593 $$rem-= int(-($$val+1)/$N)+1;
1594 $$val = ($N-1)-(-($$val+1)%$N);
1595 }
1596 }
1597}
1598
1599# $flag = $self->_is_int($string [,$low, $high]);
1600# Returns 1 if $string is a valid integer, 0 otherwise. If $low is
1601# entered, $string must be >= $low. If $high is entered, $string must
1602# be <= $high. It is valid to check only one of the bounds.
1603
# spent 26µs (18+8) within Date::Manip::Base::_is_int which was called 6 times, avg 4µs/call: # 2 times (9µs+3µs) by Date::Manip::Base::_config_var_firstday at line 1314, avg 6µs/call # 2 times (5µs+3µs) by Date::Manip::Base::_config_var_workweekend at line 1246, avg 4µs/call # 2 times (4µs+2µs) by Date::Manip::Base::_config_var_workweekbeg at line 1229, avg 3µs/call
sub _is_int {
160462µs my($self,$N,$low,$high)=@_;
1605620µs68µs return 0 if (! defined $N or
# spent 8µs making 6 calls to Date::Manip::Base::CORE:match, avg 1µs/call
1606 $N !~ /^\s*[-+]?\d+\s*$/o or
1607 defined $low && $N<$low or
1608 defined $high && $N>$high);
1609616µs return 1;
1610}
1611
1612###############################################################################
1613# Split/Join functions
1614
1615
# spent 143µs (64+80) within Date::Manip::Base::split which was called 4 times, avg 36µs/call: # 4 times (64µs+80µs) by Date::Manip::Base::_config_var_workdaybegend at line 1281, avg 36µs/call
sub split {
161641µs my($self,$op,$string,$no_normalize) = @_;
161741µs $no_normalize = 0 if (! $no_normalize);
1618
161943µs if ($op eq 'date') {
1620
1621 if ($string =~ /^(\d\d\d\d)(\d\d)(\d\d)(\d\d):(\d\d):(\d\d)$/o ||
1622 $string =~ /^(\d\d\d\d)\-(\d\d)\-(\d\d)\-(\d\d):(\d\d):(\d\d)$/o ||
1623 $string =~ /^(\d\d\d\d)(\d\d)(\d\d)(\d\d)(\d\d)(\d\d)$/o) {
1624 my($y,$m,$d,$h,$mn,$s) = ($1+0,$2+0,$3+0,$4+0,$5+0,$6+0);
1625 return [$y,$m,$d,$h,$mn,$s];
1626 } else {
1627 return undef;
1628 }
1629
1630 } elsif ($op eq 'offset') {
1631 if ($string =~ /^([-+]?\d\d)(\d\d)(\d\d)$/o ||
1632 $string =~ /^([-+]?\d\d)(\d\d)()$/o ||
1633 $string =~ /^([-+]?\d\d?):(\d\d?):(\d\d?)$/o ||
1634 $string =~ /^([-+]?\d\d?):(\d\d?)()$/o ||
1635 $string =~ /^([-+]?\d\d?)()()$/o) {
1636 my($err,$h,$mn,$s) = $self->_offset_fields( { 'source' => 'string',
1637 'out' => 'list'},
1638 [$1,$2,$3]);
1639 return undef if ($err);
1640 return [$h,$mn,$s];
1641 } else {
1642 return undef;
1643 }
1644
1645 } elsif ($op eq 'hms') {
1646436µs1220µs if ($string =~ /^(\d\d)(\d\d)(\d\d)$/o ||
# spent 20µs making 12 calls to Date::Manip::Base::CORE:match, avg 2µs/call
1647 $string =~ /^(\d\d)(\d\d)()$/o ||
1648 $string =~ /^(\d\d?):(\d\d):(\d\d)$/o ||
1649 $string =~ /^(\d\d?):(\d\d)()$/o ||
1650 $string =~ /^(\d\d?)()()$/o) {
1651419µs460µs my($err,$h,$mn,$s) = $self->_hms_fields( { 'out' => 'list' },[$1,$2,$3]);
# spent 60µs making 4 calls to Date::Manip::Base::_hms_fields, avg 15µs/call
1652413µs return undef if ($err);
1653411µs return [$h,$mn,$s];
1654 } else {
1655 return undef;
1656 }
1657
1658 } elsif ($op eq 'time') {
1659 if ($string =~ /^[-+]?\d+(:[-+]?\d+){0,2}$/o) {
1660 my($err,$dh,$dmn,$ds) = $self->_time_fields( { 'nonorm' => $no_normalize,
1661 'source' => 'string',
1662 'sign' => -1,
1663 }, [split(/:/,$string)]);
1664 return undef if ($err);
1665 return [$dh,$dmn,$ds];
1666 } else {
1667 return undef;
1668 }
1669
1670 } elsif ($op eq 'delta' || $op eq 'business') {
1671 my($err,@delta) = $self->_split_delta($string);
1672 return undef if ($err);
1673
1674 ($err,@delta) = $self->_delta_fields( { 'business' =>
1675 ($op eq 'business' ? 1 : 0),
1676 'nonorm' => $no_normalize,
1677 'source' => 'string',
1678 'sign' => -1,
1679 }, [@delta]);
1680
1681 return undef if ($err);
1682 return [@delta];
1683 }
1684}
1685
1686
# spent 83µs (31+52) within Date::Manip::Base::join which was called 4 times, avg 21µs/call: # 4 times (31µs+52µs) by Date::Manip::Base::_config_var_workdaybegend at line 1287, avg 21µs/call
sub join{
168742µs my($self,$op,$data,$no_normalize) = @_;
168843µs my @data = @$data;
1689
169044µs if ($op eq 'date') {
1691
1692 my($err,$y,$m,$d,$h,$mn,$s) = $self->_date_fields(@data);
1693 return undef if ($err);
1694 my $form = $self->_config('printable');
1695 if ($form == 1) {
1696 return "$y$m$d$h$mn$s";
1697 } elsif ($form == 2) {
1698 return "$y-$m-$d-$h:$mn:$s";
1699 } else {
1700 return "$y$m$d$h:$mn:$s";
1701 }
1702
1703 } elsif ($op eq 'offset') {
1704 my($err,$h,$mn,$s) = $self->_offset_fields( { 'source' => 'list',
1705 'out' => 'string'},
1706 [@data]);
1707 return undef if ($err);
1708 return "$h:$mn:$s";
1709
1710 } elsif ($op eq 'hms') {
1711410µs452µs my($err,$h,$mn,$s) = $self->_hms_fields( { 'out' => 'string' },[@data]);
# spent 52µs making 4 calls to Date::Manip::Base::_hms_fields, avg 13µs/call
17124800ns return undef if ($err);
1713410µs return "$h:$mn:$s";
1714
1715 } elsif ($op eq 'time') {
1716 my($err,$dh,$dmn,$ds) = $self->_time_fields( { 'nonorm' => $no_normalize,
1717 'source' => 'list',
1718 'sign' => 0,
1719 }, [@data]);
1720 return undef if ($err);
1721 return "$dh:$dmn:$ds";
1722
1723 } elsif ($op eq 'delta' || $op eq 'business') {
1724 my ($err,@delta) = $self->_delta_fields( { 'business' =>
1725 ($op eq 'business' ? 1 : 0),
1726 'nonorm' => $no_normalize,
1727 'source' => 'list',
1728 'sign' => 0,
1729 }, [@data]);
1730 return undef if ($err);
1731 return join(':',@delta);
1732 }
1733}
1734
1735sub _split_delta {
1736 my($self,$string) = @_;
1737
1738 my $sign = '[-+]?';
1739 my $num = '(?:\d+(?:\.\d*)?|\.\d+)';
1740 my $f = "(?:$sign$num)?";
1741
1742 if ($string =~ /^$f(:$f){0,6}$/o) {
1743 $string =~ s/::/:0:/go;
1744 $string =~ s/^:/0:/o;
1745 $string =~ s/:$/:0/o;
1746 my(@delta) = split(/:/,$string);
1747 return(0,@delta);
1748 } else {
1749 return(1);
1750 }
1751}
1752
1753# $opts = { business => 0/1,
1754# nonorm => 0/1,
1755# source => string, list
1756# sign => 0/1/-1
1757# }
1758# $fields = [Y,M,W,D,H,Mn,S]
1759#
1760# This function formats the fields in a delta.
1761#
1762# If the business option is 1, treat it as a business delta.
1763#
1764# If the nonorm option is 1, fields are NOT normalized. By
1765# default, they are normalized.
1766#
1767# If source is 'string', then the source of the fields is splitting
1768# a delta (so we need to handle carrying the signs). If it's 'list',
1769# then the source is a valid delta, so each field is correctly signed
1770# already.
1771#
1772# If the sign option is 1, a sign is added to every field. If the
1773# sign option is -1, all negative fields are signed. If the sign
1774# option is 0, the minimum number of signs (for fields who's sign is
1775# different from the next higher field) will be added.
1776#
1777# It returns ($err,@fields)
1778#
1779sub _delta_fields {
1780 my($self,$opts,$fields) = @_;
1781 my @fields = @$fields;
178221.22ms213µs
# spent 11µs (9+2) within Date::Manip::Base::BEGIN@1782 which was called: # once (9µs+2µs) by Date::Manip::Date::BEGIN@26 at line 1782
no integer;
# spent 11µs making 1 call to Date::Manip::Base::BEGIN@1782 # spent 2µs making 1 call to integer::unimport
1783
1784 #
1785 # Make sure that all fields are defined, numerical, and that there
1786 # are 7 of them.
1787 #
1788
1789 foreach my $f (@fields) {
1790 $f=0 if (! defined($f));
1791 return (1) if ($f !~ /^[+-]?(?:\d+(?:\.\d*)?|\.\d+)$/o);
1792 }
1793 return (1) if (@fields > 7);
1794 while (@fields < 7) {
1795 unshift(@fields,0);
1796 }
1797
1798 #
1799 # Make sure each field is the correct sign so that the math will
1800 # work correctly. Get rid of all positive signs and leading 0's.
1801 #
1802
1803 if ($$opts{'source'} eq 'string') {
1804
1805 # if the source is splitting a delta, not all fields are signed,
1806 # so we need to carry the negative signs.
1807
1808 my $sign = '+';
1809 foreach my $f (@fields) {
1810 if ($f =~ /^([-+])/o) {
1811 $sign = $1;
1812 } else {
1813 $f = "$sign$f";
1814 }
1815 $f *= 1;
1816 }
1817
1818 } else {
1819 foreach my $f (@fields) {
1820 $f *= 1;
1821 }
1822 }
1823
1824 #
1825 # Normalize them. Values will be signed only if they are
1826 # negative. Handle fractional values.
1827 #
1828
1829 my $nonorm = $$opts{'nonorm'};
1830 foreach my $f (@fields) {
1831 if ($f != int($f)) {
1832 $nonorm = 0;
1833 last;
1834 }
1835 }
1836
1837 my($y,$m,$w,$d,$h,$mn,$s) = @fields;
1838 if (! $nonorm) {
1839 ($y,$m) = $self->_normalize_ym($y,$m) if ($y || $m);
1840 ($m,$w) = $self->_normalize_mw($m,$w) if (int($m) != $m);
1841 if ($$opts{'business'}) {
1842 ($w,$d) = $self->_normalize_wd($w,$d,1) if (int($w) != $w);
1843 ($d,$h,$mn,$s) = $self->_normalize_bus_dhms($d,$h,$mn,$s);
1844 } else {
1845 ($w,$d) = $self->_normalize_wd($w,$d,0) if ($w || $d);
1846 ($d,$h) = $self->_normalize_dh($d,$h) if (int($d) != $d);
1847 ($h,$mn,$s) = $self->_normalize_hms($h,$mn,$s);
1848 }
1849 }
1850
1851 #
1852 # Now make sure that the signs are included as appropriate.
1853 #
1854
1855 if (! $$opts{'sign'}) {
1856 # Minimum number of signs
1857 my $sign;
1858 if ($y >= 0) {
1859 $sign = '+';
1860 } else {
1861 $sign = '-';
1862 }
1863 foreach my $f ($m,$w,$d,$h,$mn,$s) {
1864 if ($f > 0) {
1865 if ($sign eq '-') {
1866 $f = "+$f";
1867 $sign = '+';
1868 }
1869
1870 } elsif ($f < 0) {
1871 if ($sign eq '-') {
1872 $f *= -1;
1873 } else {
1874 $sign = '-';
1875 }
1876 }
1877 }
1878
1879 } elsif ($$opts{'sign'} == 1) {
1880 # All fields signed
1881 foreach my $f ($y,$m,$w,$d,$h,$mn,$s) {
1882 $f = "+$f" if ($f > 0);
1883 }
1884 }
1885
1886 return (0,$y,$m,$w,$d,$h,$mn,$s);
1887}
1888
1889# $opts = { out => string, list
1890# }
1891# $fields = [H,M,S]
1892#
1893# This function formats the fields in an HMS.
1894#
1895# If the out options is string, it prepares the fields to be joined (i.e.
1896# they are all 2 digits long). Otherwise, they are just numerical values
1897# (not necessarily 2 digits long).
1898#
1899# HH:MN:SS is always between 00:00:00 and 24:00:00.
1900#
1901# It returns ($err,@fields)
1902#
1903
# spent 112µs (91+21) within Date::Manip::Base::_hms_fields which was called 8 times, avg 14µs/call: # 4 times (50µs+10µs) by Date::Manip::Base::split at line 1651, avg 15µs/call # 4 times (41µs+11µs) by Date::Manip::Base::join at line 1711, avg 13µs/call
sub _hms_fields {
190482µs my($self,$opts,$fields) = @_;
190584µs my @fields = @$fields;
1906
1907 #
1908 # Make sure that all fields are defined, numerical (with no sign),
1909 # and that there are 3 of them.
1910 #
1911
191284µs foreach my $f (@fields) {
1913242µs $f=0 if (! $f);
19142457µs2421µs return (1) if ($f !~ /^\d+$/o);
# spent 21µs making 24 calls to Date::Manip::Base::CORE:match, avg 858ns/call
1915 }
191682µs return (1) if (@fields > 3);
191783µs while (@fields < 3) {
1918 push(@fields,0);
1919 }
1920
1921 #
1922 # Check validity.
1923 #
1924
192584µs my ($h,$m,$s) = @fields;
192684µs return (1) if ($h > 24 || $m > 59 || $s > 59 ||
1927 ($h==24 && ($m > 0 || $s > 0)));
1928
1929 #
1930 # Format
1931 #
1932
193385µs if ($$opts{'out'} eq 'list') {
1934 foreach my $f ($h,$m,$s) {
1935123µs $f *= 1;
1936 }
1937
1938 } else {
193942µs foreach my $f ($h,$m,$s) {
1940127µs $f = "0$f" if (length($f)<2);
1941 }
1942 }
1943
1944818µs return (0,$h,$m,$s);
1945}
1946
1947# $opts = { nonorm => 0/1,
1948# source => string, list
1949# sign => 0/1/-1
1950# }
1951# $fields = [H,M,S]
1952#
1953# This function formats the fields in an amount of time measured in
1954# hours, minutes, and seconds.
1955#
1956# It is similar to how _delta_fields (above) works.
1957#
1958sub _time_fields {
1959 my($self,$opts,$fields) = @_;
1960 my @fields = @$fields;
1961
1962 #
1963 # Make sure that all fields are defined, numerical, and that there
1964 # are 3 of them.
1965 #
1966
1967 foreach my $f (@fields) {
1968 $f=0 if (! defined($f));
1969 return (1) if ($f !~ /^[+-]?\d+$/o);
1970 }
1971 return (1) if (@fields > 3);
1972 while (@fields < 3) {
1973 unshift(@fields,0);
1974 }
1975
1976 #
1977 # Make sure each field is the correct sign so that the math will
1978 # work correctly. Get rid of all positive signs and leading 0's.
1979 #
1980
1981 if ($$opts{'source'} eq 'string') {
1982
1983 # If the source is splitting a string, not all fields are signed,
1984 # so we need to carry the negative signs.
1985
1986 my $sign = '+';
1987 foreach my $f (@fields) {
1988 if ($f =~ /^([-+])/o) {
1989 $sign = $1;
1990 } else {
1991 $f = "$sign$f";
1992 }
1993 $f *= 1;
1994 }
1995
1996 } else {
1997 foreach my $f (@fields) {
1998 $f *= 1;
1999 }
2000 }
2001
2002 #
2003 # Normalize them. Values will be signed only if they are
2004 # negative.
2005 #
2006
2007 my($h,$mn,$s) = @fields;
2008 unless ($$opts{'nonorm'}) {
2009 ($h,$mn,$s) = $self->_normalize_hms($h,$mn,$s);
2010 }
2011
2012 #
2013 # Now make sure that the signs are included as appropriate.
2014 #
2015
2016 if (! $$opts{'sign'}) {
2017 # Minimum number of signs
2018 my $sign;
2019 if ($h >= 0) {
2020 $sign = '+';
2021 } else {
2022 $sign = '-';
2023 }
2024 foreach my $f ($mn,$s) {
2025 if ($f > 0) {
2026 if ($sign eq '-') {
2027 $f = "+$f";
2028 $sign = '+';
2029 }
2030
2031 } elsif ($f < 0) {
2032 if ($sign eq '-') {
2033 $f *= -1;
2034 } else {
2035 $sign = '-';
2036 }
2037 }
2038 }
2039
2040 } elsif ($$opts{'sign'} == 1) {
2041 # All fields signed
2042 foreach my $f ($h,$mn,$s) {
2043 $f = "+$f" if ($f > 0);
2044 }
2045 }
2046
2047 return (0,$h,$mn,$s);
2048}
2049
2050# $opts = { source => string, list
2051# out => string, list
2052# }
2053# $fields = [H,M,S]
2054#
2055# This function formats the fields in a timezone offset measured in
2056# hours, minutes, and seconds.
2057#
2058# All offsets must be -23:59:59 <= offset <= 23:59:59 .
2059#
2060# The data comes from an offset in string or list format, and is
2061# formatted so that it can be used to create a string or list format
2062# output.
2063#
2064sub _offset_fields {
2065 my($self,$opts,$fields) = @_;
2066 my @fields = @$fields;
2067
2068 #
2069 # Make sure that all fields are defined, numerical, and that there
2070 # are 3 of them.
2071 #
2072
2073 foreach my $f (@fields) {
2074 $f=0 if (! defined $f || $f eq '');
2075 return (1) if ($f !~ /^[+-]?\d+$/o);
2076 }
2077 return (1) if (@fields > 3);
2078 while (@fields < 3) {
2079 push(@fields,0);
2080 }
2081
2082 #
2083 # Check validity.
2084 #
2085
2086 my ($h,$m,$s) = @fields;
2087 if ($$opts{'source'} eq 'string') {
2088 # Values = -23 59 59 to +23 59 59
2089 return (1) if ($h < -23 || $h > 23 ||
2090 $m < 0 || $m > 59 ||
2091 $s < 0 || $s > 59);
2092 } else {
2093 # Values (-23,-59,-59) to (23,59,59)
2094 # Non-zero values must have the same sign
2095 if ($h >0) {
2096 return (1) if ( $h > 23 ||
2097 $m < 0 || $m > 59 ||
2098 $s < 0 || $s > 59);
2099 } elsif ($h < 0) {
2100 return (1) if ($h < -23 ||
2101 $m < -59 || $m > 0 ||
2102 $s < -59 || $s > 0);
2103 } elsif ($m > 0) {
2104 return (1) if ( $m > 59 ||
2105 $s < 0 || $s > 59);
2106 } elsif ($m < 0) {
2107 return (1) if ($m < -59 ||
2108 $s < -59 || $s > 0);
2109 } else {
2110 return (1) if ($s < -59 || $s > 59);
2111 }
2112 }
2113
2114 #
2115 # Make sure each field is the correct sign so that the math will
2116 # work correctly. Get rid of all positive signs and leading 0's.
2117 #
2118
2119 if ($$opts{'source'} eq 'string') {
2120
2121 # In a string offset, only the first field is signed, so we need
2122 # to carry negative signs.
2123
2124 if ($h =~ /^\-/) {
2125 $h *= 1;
2126 $m *= -1;
2127 $s *= -1;
2128 } elsif ($m =~ /^\-/) {
2129 $h *= 1;
2130 $m *= 1;
2131 $s *= -1;
2132 } else {
2133 $h *= 1;
2134 $m *= 1;
2135 $s *= 1;
2136 }
2137
2138 } else {
2139 foreach my $f (@fields) {
2140 $f *= 1;
2141 }
2142 }
2143
2144 #
2145 # Format them. They're already done for 'list' output.
2146 #
2147
2148 if ($$opts{'out'} eq 'string') {
2149 my $sign;
2150 if ($h<0 || $m<0 || $s<0) {
2151 $h = abs($h);
2152 $m = abs($m);
2153 $s = abs($s);
2154 $sign = '-';
2155 } else {
2156 $sign = '+';
2157 }
2158
2159 $h = "0$h" if (length($h) < 2);
2160 $m = "0$m" if (length($m) < 2);
2161 $s = "0$s" if (length($s) < 2);
2162 $h = "$sign$h";
2163 }
2164
2165 return (0,$h,$m,$s);
2166}
2167
2168# ($err,$y,$m,$d,$h,$mn,$s) = $self->_date_fields($y,$m,$d,$h,$mn,$s);
2169#
2170# Makes sure the fields are the right length.
2171#
2172
# spent 14µs within Date::Manip::Base::_date_fields which was called 2 times, avg 7µs/call: # 2 times (14µs+0s) by Date::Manip::TZ::date_period at line 1199 of Date/Manip/TZ.pm, avg 7µs/call
sub _date_fields {
217321µs my($self,@fields) = @_;
21742700ns return (1) if (@fields != 6);
2175
217621µs my($y,$m,$d,$h,$mn,$s) = @fields;
2177
217822µs $y = "0$y" while (length($y) < 4);
217922µs $m = "0$m" if (length($m)==1);
21802600ns $d = "0$d" if (length($d)==1);
21812500ns $h = "0$h" if (length($h)==1);
21822400ns $mn = "0$mn" if (length($mn)==1);
21832800ns $s = "0$s" if (length($s)==1);
2184
21852700ns if (wantarray) {
2186 return (0,$y,$m,$d,$h,$mn,$s);
2187 } else {
218827µs return "$y$m$d$h:$mn:$s";
2189 }
2190}
2191
2192sub _normalize_ym {
2193 my($self,$y,$m) = @_;
2194262µs211µs
# spent 9µs (8+2) within Date::Manip::Base::BEGIN@2194 which was called: # once (8µs+2µs) by Date::Manip::Date::BEGIN@26 at line 2194
no integer;
# spent 9µs making 1 call to Date::Manip::Base::BEGIN@2194 # spent 2µs making 1 call to integer::unimport
2195
2196 $m += $y*12;
2197 $y = int($m/12);
2198 $m -= $y*12;
2199
2200 return ($y,$m);
2201}
2202
2203# This is only used for deltas with fractional months.
2204#
2205sub _normalize_mw {
2206 my($self,$m,$w) = @_;
2207264µs29µs
# spent 7µs (6+1) within Date::Manip::Base::BEGIN@2207 which was called: # once (6µs+1µs) by Date::Manip::Date::BEGIN@26 at line 2207
no integer;
# spent 7µs making 1 call to Date::Manip::Base::BEGIN@2207 # spent 1µs making 1 call to integer::unimport
2208
2209 my $d = ($m-int($m)) * $$self{'data'}{'len'}{'yrlen'}/12;
2210 $w += $d/7;
2211 $m = int($m);
2212
2213 return ($m,$w);
2214}
2215
2216sub _normalize_bus_dhms {
2217 my($self,$d,$h,$mn,$s) = @_;
22182105µs28µs
# spent 7µs (6+1) within Date::Manip::Base::BEGIN@2218 which was called: # once (6µs+1µs) by Date::Manip::Date::BEGIN@26 at line 2218
no integer;
# spent 7µs making 1 call to Date::Manip::Base::BEGIN@2218 # spent 1µs making 1 call to integer::unimport
2219
2220 my $dl = $$self{'data'}{'len'}{'1'}{'dl'};
2221
2222 $s += $d*$dl + $h*3600 + $mn*60;
2223 $d = int($s/$dl);
2224 $s -= $d*$dl;
2225
2226 $mn = int($s/60);
2227 $s -= $mn*60;
2228 $s = int($s);
2229
2230 $h = int($mn/60);
2231 $mn -= $h*60;
2232
2233 return ($d,$h,$mn,$s);
2234}
2235
2236sub _normalize_hms {
2237 my($self,$h,$mn,$s) = @_;
22382112µs225µs
# spent 24µs (23+1) within Date::Manip::Base::BEGIN@2238 which was called: # once (23µs+1µs) by Date::Manip::Date::BEGIN@26 at line 2238
no integer;
# spent 24µs making 1 call to Date::Manip::Base::BEGIN@2238 # spent 1µs making 1 call to integer::unimport
2239
2240 $s += $h*3600 + $mn*60;
2241 $mn = int($s/60);
2242 $s -= $mn*60;
2243 $s = int($s);
2244
2245 $h = int($mn/60);
2246 $mn -= $h*60;
2247
2248 return ($h,$mn,$s);
2249}
2250
2251# Business deltas only mix week and day if the week has a fractional
2252# part.
2253#
2254sub _normalize_wd {
2255 my($self,$w,$d,$business) = @_;
2256285µs29µs
# spent 8µs (6+1) within Date::Manip::Base::BEGIN@2256 which was called: # once (6µs+1µs) by Date::Manip::Date::BEGIN@26 at line 2256
no integer;
# spent 8µs making 1 call to Date::Manip::Base::BEGIN@2256 # spent 1µs making 1 call to integer::unimport
2257
2258 my $weeklen = ($business ? $$self{'data'}{'len'}{'workweek'} : 7);
2259
2260 $d += $w*$weeklen;
2261 $w = int($d/$weeklen);
2262 $d -= $w*$weeklen;
2263
2264 return ($w,$d);
2265}
2266
2267# This is only done for non-business days with a fractional part.
2268# part.
2269#
2270sub _normalize_dh {
2271 my($self,$d,$h) = @_;
22722452µs28µs
# spent 7µs (6+1) within Date::Manip::Base::BEGIN@2272 which was called: # once (6µs+1µs) by Date::Manip::Date::BEGIN@26 at line 2272
no integer;
# spent 7µs making 1 call to Date::Manip::Base::BEGIN@2272 # spent 1µs making 1 call to integer::unimport
2273
2274 $h += $d*24;
2275 $d = int($h/24);
2276 $h -= $d*24;
2277
2278 return ($d,$h);
2279}
2280
2281# $self->_delta_convert(FORMAT,DELTA)
2282# This converts delta into the given format. Returns '' if invalid.
2283#
2284sub _delta_convert {
2285 my($self,$format,$delta)=@_;
2286 my $fields = $self->split($format,$delta);
2287 return undef if (! defined $fields);
2288 return $self->join($format,$fields);
2289}
2290
2291###############################################################################
2292# Timezone critical dates
2293
2294# NOTE: Although I would prefer to stick this routine in the
2295# Date::Manip::TZ module where it would be more appropriate, it must
2296# appear here as it will be used to generate the data that will be
2297# used by the Date::Manip::TZ module.
2298#
2299# This calculates a critical date based on timezone information. The
2300# critical date is the date (usually in the current time) at which
2301# the current timezone period ENDS.
2302#
2303# Input is:
2304# $year,$mon,$flag,$num,$dow
2305# This is information from the appropriate Rule line from the
2306# zoneinfo files. These are used to determine the date (Y/M/D)
2307# when the timezone period will end.
2308# $isdst
2309# Whether or not the next timezone period is a Daylight Saving
2310# Time period.
2311# $time,$timetype
2312# The time of day when the change occurs. The timetype can be
2313# 'w' (wallclock time in the current period), 's' (standard
2314# time which will match wallclock time in a non-DST period, or
2315# be off an hour in a DST period), and 'u' (universal time).
2316#
2317# Output is:
2318# $endUT, $endLT, $begUT, $begLT
2319# endUT is the actual last second of the current timezone
2320# period. endLT is the same time expressed in local time.
2321# begUT is the start (in UT) of the next time period. Note that
2322# the begUT date is the one which actually corresponds to the
2323# date/time specified in the input. begLT is the time in the new
2324# local time. The endUT/endLT are the time one second earlier.
2325#
2326sub _critical_date {
2327 my($self,$year,$mon,$flag,$num,$dow,
2328 $isdst,$time,$timetype,$stdoff,$dstoff) = @_;
2329
2330 #
2331 # Get the predicted Y/M/D
2332 #
2333
2334 my($y,$m,$d) = ($year+0,$mon+0,1);
2335
2336 if ($flag eq 'dom') {
2337 $d = $num;
2338
2339 } elsif ($flag eq 'last') {
2340 my $ymd = $self->nth_day_of_week($year,-1,$dow,$mon);
2341 $d = $$ymd[2];
2342
2343 } elsif ($flag eq 'ge') {
2344 my $ymd = $self->nth_day_of_week($year,1,$dow,$mon);
2345 $d = $$ymd[2];
2346 while ($d < $num) {
2347 $d += 7;
2348 }
2349
2350 } elsif ($flag eq 'le') {
2351 my $ymd = $self->nth_day_of_week($year,-1,$dow,$mon);
2352 $d = $$ymd[2];
2353 while ($d > $num) {
2354 $d -= 7;
2355 }
2356 }
2357
2358 #
2359 # Get the predicted time and the date (not yet taking into
2360 # account time type).
2361 #
2362
2363 my($h,$mn,$s) = @{ $self->split('hms',$time) };
2364 my $date = [ $y,$m,$d,$h,$mn,$s ];
2365
2366 #
2367 # Calculate all the relevant dates.
2368 #
2369
2370 my($endUT,$endLT,$begUT,$begLT,$offset);
2371 $stdoff = $self->split('offset',$stdoff);
2372 $dstoff = $self->split('offset',$dstoff);
2373
2374 if ($timetype eq 'w') {
2375 $begUT = $self->calc_date_time($date,($isdst ? $stdoff : $dstoff), 1);
2376 } elsif ($timetype eq 'u') {
2377 $begUT = $date;
2378 } else {
2379 $begUT = $self->calc_date_time($date,$stdoff, 1);
2380 }
2381
2382 $endUT = $self->calc_date_time($begUT,[0,0,-1]);
2383 $endLT = $self->calc_date_time($endUT,($isdst ? $stdoff : $dstoff));
2384 $begLT = $self->calc_date_time($begUT,($isdst ? $dstoff : $stdoff));
2385
2386 return ($endUT,$endLT,$begUT,$begLT);
2387}
2388
2389###############################################################################
2390# Get a list of strings to try to parse.
2391
2392sub _encoding {
2393 my($self,$string) = @_;
2394 my @ret;
2395
2396 foreach my $enc (@{ $$self{'data'}{'calc'}{'enc_in'} }) {
2397 if (lc($enc) eq 'utf-8') {
2398 _utf8_on($string);
2399 push(@ret,$string) if is_utf8($string, 1);
2400 } elsif (lc($enc) eq 'perl') {
2401 push(@ret,encode_utf8($string));
2402 } else {
2403 my $tmp = $string;
2404 _utf8_off($tmp);
2405 $tmp = encode_utf8(decode($enc, $tmp));
2406 _utf8_on($tmp);
2407 push(@ret,$tmp) if is_utf8($tmp, 1);;
2408 }
2409 }
2410
2411 return @ret;
2412}
2413
241415µs1;
2415# Local Variables:
2416# mode: cperl
2417# indent-tabs-mode: nil
2418# cperl-indent-level: 3
2419# cperl-continued-statement-offset: 2
2420# cperl-continued-brace-offset: 0
2421# cperl-brace-offset: 0
2422# cperl-brace-imaginary-offset: 0
2423# cperl-label-offset: 0
2424# End:
 
# spent 71µs within Date::Manip::Base::CORE:match which was called 82 times, avg 862ns/call: # 32 times (14µs+0s) by Date::Manip::Base::_os at line 991, avg 438ns/call # 24 times (21µs+0s) by Date::Manip::Base::_hms_fields at line 1914, avg 858ns/call # 12 times (20µs+0s) by Date::Manip::Base::split at line 1646, avg 2µs/call # 6 times (8µs+0s) by Date::Manip::Base::_is_int at line 1605, avg 1µs/call # 6 times (3µs+0s) by Date::Manip::Base::_config_var_base at line 1087, avg 550ns/call # 2 times (5µs+0s) by Date::Manip::Base::_config_var_recurrange at line 1218, avg 2µs/call
sub Date::Manip::Base::CORE:match; # opcode
# spent 23µs within Date::Manip::Base::CORE:qr which was called 22 times, avg 1µs/call: # 16 times (18µs+0s) by Date::Manip::Base::_rx_replace at line 1494, avg 1µs/call # 6 times (5µs+0s) by Date::Manip::Base::_rx_replace at line 1502, avg 817ns/call
sub Date::Manip::Base::CORE:qr; # opcode
# spent 196µs within Date::Manip::Base::CORE:regcomp which was called 22 times, avg 9µs/call: # 16 times (112µs+0s) by Date::Manip::Base::_rx_replace at line 1494, avg 7µs/call # 6 times (85µs+0s) by Date::Manip::Base::_rx_replace at line 1502, avg 14µs/call
sub Date::Manip::Base::CORE:regcomp; # opcode
# spent 1.20ms within Date::Manip::Base::CORE:sort which was called 346 times, avg 3µs/call: # 298 times (574µs+0s) by Date::Manip::Base::_rx_wordlists at line 1531, avg 2µs/call # 26 times (591µs+0s) by Date::Manip::Base::_rx_wordlists at line 1535, avg 23µs/call # 10 times (18µs+0s) by Date::Manip::Base::_rx_wordlist at line 1461, avg 2µs/call # 6 times (10µs+0s) by Date::Manip::Base::_rx_replace at line 1498, avg 2µs/call # 6 times (6µs+0s) by Date::Manip::Base::_rx_replace at line 1491, avg 967ns/call
sub Date::Manip::Base::CORE:sort; # opcode
# spent 354µs within Date::Manip::Base::CORE:subst which was called 830 times, avg 426ns/call: # 830 times (354µs+0s) by Date::Manip::Base::_qe_quote at line 1436, avg 426ns/call
sub Date::Manip::Base::CORE:subst; # opcode
# spent 176µs within Date::Manip::Base::CORE:substcont which was called 420 times, avg 419ns/call: # 420 times (176µs+0s) by Date::Manip::Base::_qe_quote at line 1436, avg 419ns/call
sub Date::Manip::Base::CORE:substcont; # opcode
Report produced by the NYTProf 5.06 Perl profiler, developed by Tim Bunce and Adam Kaplan.