| Filename | /home/sulbeck/local/lib/perl5/5.20.1/Date/Manip/Base.pm |
| Statements | Executed 741558 statements in 428ms |
| Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
|---|---|---|---|---|---|
| 162406 | 2 | 2 | 82.2ms | 82.2ms | Date::Manip::Base::cmp |
| 7272 | 2 | 1 | 65.9ms | 76.0ms | Date::Manip::Base::_offset_fields |
| 7286 | 4 | 2 | 42.5ms | 99.3ms | Date::Manip::Base::split |
| 48944 | 13 | 1 | 21.4ms | 21.4ms | Date::Manip::Base::CORE:match (opcode) |
| 4860 | 2 | 1 | 21.3ms | 55.5ms | Date::Manip::Base::check |
| 4859 | 1 | 1 | 21.1ms | 21.1ms | Date::Manip::Base::_date_fields |
| 2439 | 2 | 2 | 14.1ms | 21.2ms | Date::Manip::Base::_encoding |
| 4860 | 1 | 1 | 13.2ms | 18.5ms | Date::Manip::Base::check_time |
| 2426 | 2 | 1 | 10.7ms | 35.9ms | Date::Manip::Base::join |
| 4867 | 2 | 1 | 9.90ms | 15.7ms | Date::Manip::Base::days_in_month |
| 2424 | 1 | 1 | 7.97ms | 88.6ms | Date::Manip::Base::_delta_convert |
| 2401 | 1 | 1 | 6.78ms | 7.26ms | Date::Manip::Base::day_of_week |
| 4867 | 2 | 1 | 5.81ms | 5.81ms | Date::Manip::Base::leapyear |
| 1 | 1 | 1 | 1.51ms | 4.33ms | Date::Manip::Base::BEGIN@24 |
| 13 | 13 | 1 | 1.17ms | 2.28ms | Date::Manip::Base::_rx_wordlists |
| 1 | 1 | 1 | 972µs | 1.09ms | Date::Manip::Base::BEGIN@15 |
| 415 | 4 | 1 | 678µs | 785µs | Date::Manip::Base::_qe_quote |
| 1 | 1 | 1 | 466µs | 3.04ms | Date::Manip::Base::_language |
| 74 | 1 | 1 | 419µs | 471µs | Date::Manip::Base::days_since_1BC |
| 173 | 5 | 1 | 374µs | 374µs | Date::Manip::Base::CORE:sort (opcode) |
| 17 | 3 | 1 | 91µs | 91µs | Date::Manip::Base::CORE:regcomp (opcode) |
| 3 | 3 | 1 | 85µs | 190µs | Date::Manip::Base::_rx_replace |
| 415 | 1 | 1 | 68µs | 68µs | Date::Manip::Base::CORE:subst (opcode) |
| 14 | 1 | 1 | 61µs | 3.31ms | Date::Manip::Base::_config_var_base |
| 1 | 1 | 1 | 57µs | 3.43ms | Date::Manip::Base::_init_config |
| 210 | 1 | 1 | 38µs | 38µs | Date::Manip::Base::CORE:substcont (opcode) |
| 5 | 5 | 1 | 37µs | 58µs | Date::Manip::Base::_rx_wordlist |
| 4 | 2 | 1 | 36µs | 41µs | Date::Manip::Base::_hms_fields |
| 1 | 1 | 1 | 29µs | 3.49ms | Date::Manip::Base::_init |
| 6 | 1 | 1 | 27µs | 51µs | Date::Manip::Base::_split_delta |
| 2 | 2 | 1 | 27µs | 116µs | Date::Manip::Base::_config_var_workdaybegend |
| 2 | 2 | 2 | 17µs | 22µs | Date::Manip::Base::_os |
| 5 | 4 | 1 | 17µs | 17µs | Date::Manip::Base::_init_business_length |
| 1 | 1 | 1 | 16µs | 16µs | Date::Manip::Base::_calc_hms_hms |
| 3 | 3 | 1 | 14µs | 24µs | Date::Manip::Base::_calc_workweek |
| 1 | 1 | 1 | 14µs | 15µs | Date::Manip::Base::BEGIN@232 |
| 1 | 1 | 1 | 12µs | 30µs | Date::Manip::Base::calc_date_date |
| 2 | 1 | 1 | 12µs | 25µs | Date::Manip::Base::_config_var_workday24hr |
| 1 | 1 | 1 | 10µs | 20µs | Date::Manip::Base::_config_var_workweekbeg |
| 1 | 1 | 1 | 9µs | 9µs | Date::Manip::Base::_init_cache |
| 3 | 2 | 1 | 9µs | 9µs | Date::Manip::Base::_calc_bdlength |
| 1 | 1 | 1 | 9µs | 18µs | Date::Manip::Base::_config_var_workweekend |
| 3 | 3 | 1 | 8µs | 11µs | Date::Manip::Base::_is_int |
| 1 | 1 | 1 | 8µs | 9µs | Date::Manip::Base::BEGIN@1782 |
| 1 | 1 | 1 | 7µs | 7µs | Date::Manip::Base::_config_var_encoding |
| 1 | 1 | 1 | 7µs | 8µs | Date::Manip::Base::BEGIN@577 |
| 1 | 1 | 1 | 6µs | 7µs | Date::Manip::Base::BEGIN@2194 |
| 1 | 1 | 1 | 6µs | 14µs | Date::Manip::Base::BEGIN@1339 |
| 2 | 2 | 1 | 6µs | 6µs | Date::Manip::Base::_init_language |
| 1 | 1 | 1 | 6µs | 7µs | Date::Manip::Base::BEGIN@392 |
| 3 | 3 | 1 | 6µs | 6µs | Date::Manip::Base::_rx_simple |
| 11 | 2 | 1 | 6µs | 6µs | Date::Manip::Base::CORE:qr (opcode) |
| 1 | 1 | 1 | 5µs | 6µs | Date::Manip::Base::BEGIN@2207 |
| 1 | 1 | 1 | 5µs | 6µs | Date::Manip::Base::BEGIN@2238 |
| 1 | 1 | 1 | 5µs | 5µs | Date::Manip::Base::_init_now |
| 1 | 1 | 1 | 5µs | 14µs | Date::Manip::Base::BEGIN@1359 |
| 1 | 1 | 1 | 5µs | 5µs | Date::Manip::Base::BEGIN@14 |
| 1 | 1 | 1 | 5µs | 11µs | Date::Manip::Base::BEGIN@1470 |
| 1 | 1 | 1 | 4µs | 11µs | Date::Manip::Base::BEGIN@19 |
| 1 | 1 | 1 | 4µs | 4µs | Date::Manip::Base::_init_events |
| 1 | 1 | 1 | 4µs | 10µs | Date::Manip::Base::BEGIN@1409 |
| 1 | 1 | 1 | 4µs | 5µs | Date::Manip::Base::BEGIN@2256 |
| 1 | 1 | 1 | 4µs | 4µs | Date::Manip::Base::BEGIN@2218 |
| 1 | 1 | 1 | 4µs | 8µs | Date::Manip::Base::BEGIN@1474 |
| 1 | 1 | 1 | 4µs | 10µs | Date::Manip::Base::_config_var_firstday |
| 1 | 1 | 1 | 4µs | 6µs | Date::Manip::Base::BEGIN@20 |
| 1 | 1 | 1 | 4µs | 6µs | Date::Manip::Base::_config_var_recurrange |
| 1 | 1 | 1 | 3µs | 4µs | Date::Manip::Base::BEGIN@2272 |
| 1 | 1 | 1 | 3µs | 3µs | Date::Manip::Base::_init_holidays |
| 1 | 1 | 1 | 3µs | 4µs | Date::Manip::Base::BEGIN@21 |
| 1 | 1 | 1 | 3µs | 4µs | Date::Manip::Base::BEGIN@22 |
| 1 | 1 | 1 | 2µs | 2µs | Date::Manip::Base::_config_var_defaulttime |
| 1 | 1 | 1 | 2µs | 2µs | Date::Manip::Base::_init_data |
| 1 | 1 | 1 | 2µs | 2µs | Date::Manip::Base::END |
| 0 | 0 | 0 | 0s | 0s | Date::Manip::Base::_calc_date_time_strings |
| 0 | 0 | 0 | 0s | 0s | Date::Manip::Base::_calc_date_ymwd |
| 0 | 0 | 0 | 0s | 0s | Date::Manip::Base::_critical_date |
| 0 | 0 | 0 | 0s | 0s | Date::Manip::Base::_delta_fields |
| 0 | 0 | 0 | 0s | 0s | Date::Manip::Base::_method |
| 0 | 0 | 0 | 0s | 0s | Date::Manip::Base::_mod_add |
| 0 | 0 | 0 | 0s | 0s | Date::Manip::Base::_normalize_bus_dhms |
| 0 | 0 | 0 | 0s | 0s | Date::Manip::Base::_normalize_dh |
| 0 | 0 | 0 | 0s | 0s | Date::Manip::Base::_normalize_hms |
| 0 | 0 | 0 | 0s | 0s | Date::Manip::Base::_normalize_mw |
| 0 | 0 | 0 | 0s | 0s | Date::Manip::Base::_normalize_wd |
| 0 | 0 | 0 | 0s | 0s | Date::Manip::Base::_normalize_ym |
| 0 | 0 | 0 | 0s | 0s | Date::Manip::Base::_section |
| 0 | 0 | 0 | 0s | 0s | Date::Manip::Base::_sortByLength |
| 0 | 0 | 0 | 0s | 0s | Date::Manip::Base::_time_fields |
| 0 | 0 | 0 | 0s | 0s | Date::Manip::Base::_week1_day1 |
| 0 | 0 | 0 | 0s | 0s | Date::Manip::Base::_week_of_year |
| 0 | 0 | 0 | 0s | 0s | Date::Manip::Base::_weeks_in_year |
| 0 | 0 | 0 | 0s | 0s | Date::Manip::Base::calc_date_days |
| 0 | 0 | 0 | 0s | 0s | Date::Manip::Base::calc_date_delta |
| 0 | 0 | 0 | 0s | 0s | Date::Manip::Base::calc_date_time |
| 0 | 0 | 0 | 0s | 0s | Date::Manip::Base::calc_time_time |
| 0 | 0 | 0 | 0s | 0s | Date::Manip::Base::day_of_year |
| 0 | 0 | 0 | 0s | 0s | Date::Manip::Base::days_in_year |
| 0 | 0 | 0 | 0s | 0s | Date::Manip::Base::nth_day_of_week |
| 0 | 0 | 0 | 0s | 0s | Date::Manip::Base::secs_since_1970 |
| 0 | 0 | 0 | 0s | 0s | Date::Manip::Base::week1_day1 |
| 0 | 0 | 0 | 0s | 0s | Date::Manip::Base::week_of_year |
| 0 | 0 | 0 | 0s | 0s | Date::Manip::Base::weeks_in_year |
| Line | State ments |
Time on line |
Calls | Time in subs |
Code |
|---|---|---|---|---|---|
| 1 | package Date::Manip::Base; | ||||
| 2 | # Copyright (c) 1995-2015 Sullivan Beck. All rights reserved. | ||||
| 3 | # This program is free software; you can redistribute it and/or modify it | ||||
| 4 | # under the same terms as Perl itself. | ||||
| 5 | |||||
| 6 | ############################################################################### | ||||
| 7 | # Any routine that starts with an underscore (_) is NOT intended for | ||||
| 8 | # public use. They are for internal use in the the Date::Manip | ||||
| 9 | # modules and are subject to change without warning or notice. | ||||
| 10 | # | ||||
| 11 | # ABSOLUTELY NO USER SUPPORT IS OFFERED FOR THESE ROUTINES! | ||||
| 12 | ############################################################################### | ||||
| 13 | |||||
| 14 | 2 | 12µs | 1 | 5µs | # spent 5µs within Date::Manip::Base::BEGIN@14 which was called:
# once (5µs+0s) by Date::Manip::Date::BEGIN@26 at line 14 # spent 5µs making 1 call to Date::Manip::Base::BEGIN@14 |
| 15 | 2 | 64µs | 1 | 1.09ms | # spent 1.09ms (972µs+117µs) within Date::Manip::Base::BEGIN@15 which was called:
# once (972µs+117µs) by Date::Manip::Date::BEGIN@26 at line 15 # spent 1.09ms making 1 call to Date::Manip::Base::BEGIN@15 |
| 16 | 1 | 12µs | our @ISA = qw(Date::Manip::Obj Date::Manip::TZ_Base); | ||
| 17 | |||||
| 18 | 1 | 7µs | require 5.010000; | ||
| 19 | 2 | 11µs | 2 | 18µs | # spent 11µs (4+7) within Date::Manip::Base::BEGIN@19 which was called:
# once (4µs+7µs) by Date::Manip::Date::BEGIN@26 at line 19 # spent 11µs making 1 call to Date::Manip::Base::BEGIN@19
# spent 7µs making 1 call to strict::import |
| 20 | 2 | 13µs | 2 | 9µs | # spent 6µs (4+3) within Date::Manip::Base::BEGIN@20 which was called:
# once (4µs+3µs) by Date::Manip::Date::BEGIN@26 at line 20 # spent 6µs making 1 call to Date::Manip::Base::BEGIN@20
# spent 3µs making 1 call to warnings::import |
| 21 | 2 | 9µs | 2 | 4µs | # spent 4µs (3+600ns) within Date::Manip::Base::BEGIN@21 which was called:
# once (3µs+600ns) by Date::Manip::Date::BEGIN@26 at line 21 # spent 4µs making 1 call to Date::Manip::Base::BEGIN@21
# spent 600ns making 1 call to integer::import |
| 22 | 2 | 18µs | 2 | 4µs | # spent 4µs (3+500ns) within Date::Manip::Base::BEGIN@22 which was called:
# once (3µs+500ns) by Date::Manip::Date::BEGIN@26 at line 22 # spent 4µs making 1 call to Date::Manip::Base::BEGIN@22
# spent 500ns making 1 call to utf8::import |
| 23 | #use re 'debug'; | ||||
| 24 | 2 | 373µs | 2 | 4.39ms | # spent 4.33ms (1.51+2.82) within Date::Manip::Base::BEGIN@24 which was called:
# once (1.51ms+2.82ms) by Date::Manip::Date::BEGIN@26 at line 24 # spent 4.33ms making 1 call to Date::Manip::Base::BEGIN@24
# spent 57µs making 1 call to Exporter::import |
| 25 | 1 | 63µs | require Date::Manip::Lang::index; | ||
| 26 | |||||
| 27 | 1 | 200ns | our $VERSION; | ||
| 28 | 1 | 400ns | $VERSION='6.49'; | ||
| 29 | 1 | 2µs | # spent 2µs within Date::Manip::Base::END which was called:
# once (2µs+0s) by main::RUNTIME at line 0 of ../dm5dm6_ex3 | ||
| 30 | |||||
| 31 | ############################################################################### | ||||
| 32 | # BASE METHODS | ||||
| 33 | ############################################################################### | ||||
| 34 | |||||
| 35 | # spent 3.49ms (29µs+3.46) within Date::Manip::Base::_init which was called:
# once (29µs+3.46ms) by Date::Manip::Obj::new at line 162 of Date/Manip/Obj.pm | ||||
| 36 | 1 | 400ns | my($self) = @_; | ||
| 37 | |||||
| 38 | 1 | 1µs | 1 | 9µs | $self->_init_cache(); # spent 9µs making 1 call to Date::Manip::Base::_init_cache |
| 39 | 1 | 2µs | 1 | 4µs | $self->_init_language(); # spent 4µs making 1 call to Date::Manip::Base::_init_language |
| 40 | 1 | 2µs | 1 | 3.43ms | $self->_init_config(); # spent 3.43ms making 1 call to Date::Manip::Base::_init_config |
| 41 | 1 | 1µs | 1 | 4µs | $self->_init_events(); # spent 4µs making 1 call to Date::Manip::Base::_init_events |
| 42 | 1 | 2µs | 1 | 3µs | $self->_init_holidays(); # spent 3µs making 1 call to Date::Manip::Base::_init_holidays |
| 43 | 1 | 4µs | 1 | 5µs | $self->_init_now(); # spent 5µs making 1 call to Date::Manip::Base::_init_now |
| 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 9µs within Date::Manip::Base::_init_cache which was called:
# once (9µs+0s) by Date::Manip::Base::_init at line 38 | ||||
| 49 | 1 | 300ns | my($self) = @_; | ||
| 50 | 1 | 4µs | return if (exists $$self{'cache'}{'init'}); | ||
| 51 | 1 | 800ns | $$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 | |||||
| 57 | 1 | 1µs | $$self{'cache'}{'ly'} = {} if (! exists $$self{'cache'}{'ly'}); | ||
| 58 | 1 | 1µs | $$self{'cache'}{'ds1_mon'} = {} if (! exists $$self{'cache'}{'ds1_mon'}); | ||
| 59 | 1 | 4µ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 2µs within Date::Manip::Base::_init_data which was called:
# once (2µs+0s) by Date::Manip::Base::_init_config at line 74 | ||||
| 64 | 1 | 300ns | my($self,$force) = @_; | ||
| 65 | 1 | 500ns | return if (exists $$self{'data'}{'calc'} && ! $force); | ||
| 66 | |||||
| 67 | 1 | 2µs | $$self{'data'}{'calc'} = {}; # Calculated values | ||
| 68 | } | ||||
| 69 | |||||
| 70 | # Initializes config dependent data | ||||
| 71 | # spent 3.43ms (57µs+3.38) within Date::Manip::Base::_init_config which was called:
# once (57µs+3.38ms) by Date::Manip::Base::_init at line 40 | ||||
| 72 | 1 | 300ns | my($self,$force) = @_; | ||
| 73 | 1 | 900ns | return if (exists $$self{'data'}{'sections'}{'conf'} && ! $force); | ||
| 74 | 1 | 2µs | 1 | 2µs | $self->_init_data(); # spent 2µs making 1 call to Date::Manip::Base::_init_data |
| 75 | |||||
| 76 | # | ||||
| 77 | # Set config defaults | ||||
| 78 | # | ||||
| 79 | |||||
| 80 | 1 | 15µ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 | ||||
| 176 | 1 | 1µs | $$self{'data'}{'len'}{'yrlen'} = 365.2425; | ||
| 177 | 1 | 2µ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 | }; | ||||
| 183 | 1 | 2µs | 1 | 17µs | $self->_calc_workweek(); # spent 17µs making 1 call to Date::Manip::Base::_calc_workweek |
| 184 | |||||
| 185 | # | ||||
| 186 | # Initialize some config variables that do some additional work. | ||||
| 187 | # | ||||
| 188 | |||||
| 189 | 1 | 3µs | 1 | 39µs | $self->_config_var('workday24hr', 1); # spent 39µs making 1 call to Date::Manip::TZ_Base::_config_var |
| 190 | 1 | 600ns | 1 | 84µs | $self->_config_var('workdaybeg', '08:00:00'); # spent 84µs making 1 call to Date::Manip::TZ_Base::_config_var |
| 191 | 1 | 800ns | 1 | 47µs | $self->_config_var('workdayend', '17:00:00'); # spent 47µs making 1 call to Date::Manip::TZ_Base::_config_var |
| 192 | 1 | 1µs | 1 | 6µs | $self->_config_var('workday24hr', 0); # spent 6µs making 1 call to Date::Manip::TZ_Base::_config_var |
| 193 | |||||
| 194 | 1 | 600ns | 1 | 5µs | $self->_config_var('dateformat', 'US'); # spent 5µs making 1 call to Date::Manip::TZ_Base::_config_var |
| 195 | 1 | 800ns | 1 | 9µs | $self->_config_var('yytoyyyy', 89); # spent 9µs making 1 call to Date::Manip::TZ_Base::_config_var |
| 196 | 1 | 700ns | 1 | 4µs | $self->_config_var('jan1week1', 0); # spent 4µs making 1 call to Date::Manip::TZ_Base::_config_var |
| 197 | 1 | 800ns | 1 | 3µs | $self->_config_var('printable', 0); # spent 3µs making 1 call to Date::Manip::TZ_Base::_config_var |
| 198 | 1 | 800ns | 1 | 16µs | $self->_config_var('firstday', 1); # spent 16µs making 1 call to Date::Manip::TZ_Base::_config_var |
| 199 | 1 | 1µs | 1 | 26µs | $self->_config_var('workweekbeg', 1); # spent 26µs making 1 call to Date::Manip::TZ_Base::_config_var |
| 200 | 1 | 800ns | 1 | 24µs | $self->_config_var('workweekend', 5); # spent 24µs making 1 call to Date::Manip::TZ_Base::_config_var |
| 201 | 1 | 700ns | 1 | 3.06ms | $self->_config_var('language', 'english'); # spent 3.06ms making 1 call to Date::Manip::TZ_Base::_config_var |
| 202 | 1 | 900ns | 1 | 14µs | $self->_config_var('recurrange', 'none'); # spent 14µs making 1 call to Date::Manip::TZ_Base::_config_var |
| 203 | 1 | 700ns | 1 | 8µs | $self->_config_var('defaulttime', 'midnight'); # spent 8µs making 1 call to Date::Manip::TZ_Base::_config_var |
| 204 | |||||
| 205 | # Set OS specific defaults | ||||
| 206 | |||||
| 207 | 1 | 14µs | 1 | 14µs | my $os = $self->_os(); # spent 14µs making 1 call to Date::Manip::Base::_os |
| 208 | } | ||||
| 209 | |||||
| 210 | # spent 24µs (14+9) within Date::Manip::Base::_calc_workweek which was called 3 times, avg 8µs/call:
# once (10µs+7µs) by Date::Manip::Base::_init_config at line 183
# once (2µs+1µs) by Date::Manip::Base::_config_var_workweekbeg at line 1238
# once (2µs+1µs) by Date::Manip::Base::_config_var_workweekend at line 1255 | ||||
| 211 | 3 | 700ns | my($self,$beg,$end) = @_; | ||
| 212 | |||||
| 213 | 3 | 6µs | 2 | 7µs | $beg = $self->_config('workweekbeg') if (! $beg); # spent 7µs making 2 calls to Date::Manip::TZ_Base::_config, avg 3µs/call |
| 214 | 3 | 1µs | 2 | 3µs | $end = $self->_config('workweekend') if (! $end); # spent 3µs making 2 calls to Date::Manip::TZ_Base::_config, avg 1µs/call |
| 215 | |||||
| 216 | 3 | 7µs | $$self{'data'}{'len'}{'workweek'} = $end - $beg + 1; | ||
| 217 | } | ||||
| 218 | |||||
| 219 | sub _calc_bdlength { | ||||
| 220 | 3 | 600ns | my($self) = @_; | ||
| 221 | |||||
| 222 | 3 | 2µs | my @beg = @{ $$self{'data'}{'calc'}{'workdaybeg'} }; | ||
| 223 | 3 | 2µs | my @end = @{ $$self{'data'}{'calc'}{'workdayend'} }; | ||
| 224 | |||||
| 225 | 3 | 7µs | $$self{'data'}{'len'}{'bdlength'} = | ||
| 226 | ($end[0]-$beg[0])*3600 + ($end[1]-$beg[1])*60 + ($end[2]-$beg[2]); | ||||
| 227 | } | ||||
| 228 | |||||
| 229 | # spent 17µs within Date::Manip::Base::_init_business_length which was called 5 times, avg 3µs/call:
# 2 times (5µs+0s) by Date::Manip::Base::_config_var_workdaybegend at line 1306, avg 3µs/call
# once (7µs+0s) by Date::Manip::Base::_config_var_workday24hr at line 1270
# once (2µs+0s) by Date::Manip::Base::_config_var_workweekbeg at line 1239
# once (2µs+0s) by Date::Manip::Base::_config_var_workweekend at line 1256 | ||||
| 230 | 5 | 500ns | my($self) = @_; | ||
| 231 | |||||
| 232 | 2 | 320µs | 2 | 16µs | # spent 15µs (14+1) within Date::Manip::Base::BEGIN@232 which was called:
# once (14µs+1µs) by Date::Manip::Date::BEGIN@26 at line 232 # spent 15µs making 1 call to Date::Manip::Base::BEGIN@232
# spent 1µs making 1 call to integer::unimport |
| 233 | 5 | 3µs | my $x = $$self{'data'}{'len'}{'workweek'}; | ||
| 234 | 5 | 3µs | my $y_to_d = $x/7 * 365.2425; | ||
| 235 | 5 | 1µs | my $d_to_s = $$self{'data'}{'len'}{'bdlength'}; | ||
| 236 | 5 | 700ns | my $w_to_d = $x; | ||
| 237 | |||||
| 238 | 5 | 13µ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 4µs within Date::Manip::Base::_init_events which was called:
# once (4µs+0s) by Date::Manip::Base::_init at line 41 | ||||
| 247 | 1 | 400ns | my($self,$force) = @_; | ||
| 248 | 1 | 600ns | 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 | |||||
| 273 | 1 | 700ns | $$self{'data'}{'events'} = {}; | ||
| 274 | 1 | 800ns | $$self{'data'}{'sections'}{'events'} = []; | ||
| 275 | 1 | 600ns | $$self{'data'}{'eventyears'} = {}; | ||
| 276 | 1 | 2µs | $$self{'data'}{'eventobjs'} = 0; | ||
| 277 | } | ||||
| 278 | |||||
| 279 | # spent 3µs within Date::Manip::Base::_init_holidays which was called:
# once (3µs+0s) by Date::Manip::Base::_init at line 42 | ||||
| 280 | 1 | 300ns | my($self,$force) = @_; | ||
| 281 | 1 | 700ns | 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 | |||||
| 301 | 1 | 500ns | $$self{'data'}{'holidays'} = {}; | ||
| 302 | 1 | 800ns | $$self{'data'}{'sections'}{'holidays'} = []; | ||
| 303 | 1 | 2µs | $$self{'data'}{'init_holidays'} = 0; | ||
| 304 | } | ||||
| 305 | |||||
| 306 | # spent 5µs within Date::Manip::Base::_init_now which was called:
# once (5µs+0s) by Date::Manip::Base::_init at line 43 | ||||
| 307 | 1 | 300ns | 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 | |||||
| 327 | 1 | 1µs | $$self{'data'}{'now'} = {}; | ||
| 328 | 1 | 800ns | $$self{'data'}{'now'}{'force'} = 0; | ||
| 329 | 1 | 700ns | $$self{'data'}{'now'}{'set'} = 0; | ||
| 330 | 1 | 2µs | $$self{'data'}{'tmpnow'} = []; | ||
| 331 | } | ||||
| 332 | |||||
| 333 | # Language information only needs to be initialized if the language changes. | ||||
| 334 | sub _init_language { | ||||
| 335 | 2 | 300ns | my($self,$force) = @_; | ||
| 336 | 2 | 900ns | return if (exists $$self{'data'}{'lang'} && ! $force); | ||
| 337 | |||||
| 338 | 2 | 1µs | $$self{'data'}{'lang'} = {}; # Current language info | ||
| 339 | 2 | 700ns | $$self{'data'}{'rx'} = {}; # Regexps generated from language | ||
| 340 | 2 | 1µs | $$self{'data'}{'words'} = {}; # Types of words in the language | ||
| 341 | 2 | 4µs | $$self{'data'}{'wordval'} = {}; # Value of words in the language | ||
| 342 | } | ||||
| 343 | |||||
| 344 | ############################################################################### | ||||
| 345 | # MAIN METHODS | ||||
| 346 | ############################################################################### | ||||
| 347 | |||||
| 348 | sub leapyear { | ||||
| 349 | 4867 | 702µs | my($self,$y) = @_; | ||
| 350 | 4867 | 599µs | $y += 0; | ||
| 351 | 4867 | 7.53ms | return $$self{'cache'}{'ly'}{$y} | ||
| 352 | if (exists $$self{'cache'}{'ly'}{$y}); | ||||
| 353 | |||||
| 354 | 7 | 17µs | $$self{'cache'}{'ly'}{$y} = 0, return 0 unless ($y % 4 == 0); | ||
| 355 | 1 | 2µs | $$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 | |||||
| 360 | sub days_in_year { | ||||
| 361 | my($self,$y) = @_; | ||||
| 362 | return ($self->leapyear($y) ? 366 : 365); | ||||
| 363 | } | ||||
| 364 | |||||
| 365 | { | ||||
| 366 | 2 | 2µs | my(@leap)=(31,29,31,30, 31,30,31,31, 30,31,30,31); | ||
| 367 | 1 | 700ns | my(@nonl)=(31,28,31,30, 31,30,31,31, 30,31,30,31); | ||
| 368 | |||||
| 369 | sub days_in_month { | ||||
| 370 | 4867 | 1.06ms | my($self,$y,$m) = @_; | ||
| 371 | |||||
| 372 | 4867 | 8.54ms | 4860 | 5.80ms | if ($m) { # spent 5.80ms making 4860 calls to Date::Manip::Base::leapyear, avg 1µs/call |
| 373 | return ($self->leapyear($y) ? $leap[$m-1] : $nonl[$m-1]); | ||||
| 374 | } else { | ||||
| 375 | 7 | 23µs | 7 | 18µs | return ($self->leapyear($y) ? @leap : @nonl); # spent 18µs making 7 calls to Date::Manip::Base::leapyear, avg 3µs/call |
| 376 | } | ||||
| 377 | } | ||||
| 378 | } | ||||
| 379 | |||||
| 380 | { | ||||
| 381 | # DinM = (31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31) | ||||
| 382 | 2 | 600ns | 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 | |||||
| 387 | 1 | 500ns | my($lyd,$n,$remain,$day,$y,$m,$d,$h,$mn,$s,$arg); | ||
| 388 | |||||
| 389 | sub day_of_year { | ||||
| 390 | my($self,@args) = @_; | ||||
| 391 | |||||
| 392 | 2 | 555µs | 2 | 8µs | # spent 7µs (6+1000ns) within Date::Manip::Base::BEGIN@392 which was called:
# once (6µs+1000ns) by Date::Manip::Date::BEGIN@26 at line 392 # spent 7µs making 1 call to Date::Manip::Base::BEGIN@392
# spent 1µ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 | |||||
| 435 | # spent 471µs (419+52) within Date::Manip::Base::days_since_1BC which was called 74 times, avg 6µs/call:
# 74 times (419µs+52µs) by Date::Manip::Base::day_of_week at line 509, avg 6µs/call | ||||
| 436 | 74 | 14µs | my($self,$arg) = @_; | ||
| 437 | |||||
| 438 | 74 | 31µs | if (ref($arg)) { | ||
| 439 | 74 | 30µs | my($y,$m,$d) = @$arg; | ||
| 440 | 74 | 11µs | $y += 0; | ||
| 441 | 74 | 11µs | $m += 0; | ||
| 442 | |||||
| 443 | 74 | 55µs | if (! exists $$self{'cache'}{'ds1_mon'}{$y}{$m}) { | ||
| 444 | |||||
| 445 | 7 | 6µs | if (! exists $$self{'cache'}{'ds1_mon'}{$y}{1}) { | ||
| 446 | |||||
| 447 | 7 | 2µs | my($Ny,$N4,$N100,$N400,$cc,$yy); | ||
| 448 | |||||
| 449 | 7 | 5µs | my $yyyy = "0000$y"; | ||
| 450 | |||||
| 451 | 7 | 20µs | 7 | 8µs | $yyyy =~ /(\d\d)(\d\d)$/o; # spent 8µs making 7 calls to Date::Manip::Base::CORE:match, avg 1µs/call |
| 452 | 7 | 7µs | ($cc,$yy) = ($1,$2); | ||
| 453 | |||||
| 454 | # Number of full years since Dec 31, 1BC (starting at 0001) | ||||
| 455 | 7 | 2µs | $Ny = $y - 1; | ||
| 456 | |||||
| 457 | # Number of full 4th years (0004, 0008, etc.) since Dec 31, 1BC | ||||
| 458 | 7 | 3µs | $N4 = int($Ny/4); | ||
| 459 | |||||
| 460 | # Number of full 100th years (0100, 0200, etc.) | ||||
| 461 | |||||
| 462 | 7 | 2µs | $N100 = $cc + 0; | ||
| 463 | 7 | 3µs | $N100-- if ($yy==0); | ||
| 464 | |||||
| 465 | # Number of full 400th years (0400, 0800, etc.) | ||||
| 466 | 7 | 2µs | $N400 = int($N100/4); | ||
| 467 | |||||
| 468 | 7 | 14µs | $$self{'cache'}{'ds1_mon'}{$y}{1} = | ||
| 469 | $Ny*365 + $N4 - $N100 + $N400 + 1; | ||||
| 470 | } | ||||
| 471 | |||||
| 472 | 7 | 1µs | my($i,$j); | ||
| 473 | 7 | 10µs | 7 | 43µs | my @mon = $self->days_in_month($y,0); # spent 43µs making 7 calls to Date::Manip::Base::days_in_month, avg 6µs/call |
| 474 | 7 | 18µs | for ($i=2; $i<=12; $i++) { | ||
| 475 | 77 | 8µs | $j = shift(@mon); | ||
| 476 | 77 | 63µs | $$self{'cache'}{'ds1_mon'}{$y}{$i} = | ||
| 477 | $$self{'cache'}{'ds1_mon'}{$y}{$i-1} + $j; | ||||
| 478 | } | ||||
| 479 | } | ||||
| 480 | |||||
| 481 | 74 | 143µs | 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 | |||||
| 500 | # spent 7.26ms (6.78+471µs) within Date::Manip::Base::day_of_week which was called 2401 times, avg 3µs/call:
# 2401 times (6.78ms+471µs) by Date::Manip::Date::_parse_check at line 946 of Date/Manip/Date.pm, avg 3µs/call | ||||
| 501 | 2401 | 368µs | my($self,$date) = @_; | ||
| 502 | 2401 | 713µs | my($y,$m,$d) = @$date; | ||
| 503 | 2401 | 707µs | $y += 0; | ||
| 504 | 2401 | 231µs | $m += 0; | ||
| 505 | |||||
| 506 | 2401 | 458µs | my($dayofweek,$dec31) = (); | ||
| 507 | 2401 | 1.30ms | if (! exists $$self{'cache'}{'dow_mon'}{$y}{$m}) { | ||
| 508 | 74 | 8µs | $dec31 = 7; # Dec 31, 1BC was Sunday | ||
| 509 | 74 | 166µs | 74 | 471µs | $$self{'cache'}{'dow_mon'}{$y}{$m} = # spent 471µs making 74 calls to Date::Manip::Base::days_since_1BC, avg 6µs/call |
| 510 | ( $self->days_since_1BC([$y,$m,1])+$dec31 ) % 7; | ||||
| 511 | } | ||||
| 512 | 2401 | 1.22ms | $dayofweek = ($$self{'cache'}{'dow_mon'}{$y}{$m}+$d-1) % 7; | ||
| 513 | 2401 | 315µs | $dayofweek = 7 if ($dayofweek==0); | ||
| 514 | 2401 | 2.87ms | 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 | # | ||||
| 520 | sub 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. | ||||
| 577 | 3 | 2.09ms | 2 | 9µs | # spent 8µs (7+1) within Date::Manip::Base::BEGIN@577 which was called:
# once (7µs+1µs) by Date::Manip::Date::BEGIN@26 at line 577 # spent 8µs making 1 call to Date::Manip::Base::BEGIN@577
# spent 1µs making 1 call to integer::unimport |
| 578 | # my $sec_70 =($self->days_since_1BC([1970,1,1])-1)*24*3600; | ||||
| 579 | 1 | 100ns | my $sec_70 = 62135596800; | ||
| 580 | |||||
| 581 | # Using 'global' variables saves 4% | ||||
| 582 | 1 | 200ns | 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 | |||||
| 609 | # spent 55.5ms (21.3+34.2) within Date::Manip::Base::check which was called 4860 times, avg 11µs/call:
# 2430 times (10.5ms+17.5ms) by Date::Manip::Date::_parse_check at line 960 of Date/Manip/Date.pm, avg 12µs/call
# 2430 times (10.8ms+16.7ms) by Date::Manip::Date::set at line 2678 of Date/Manip/Date.pm, avg 11µs/call | ||||
| 610 | 4860 | 692µs | my($self,$date) = @_; | ||
| 611 | 4860 | 1.78ms | my($y,$m,$d,$h,$mn,$s) = @$date; | ||
| 612 | |||||
| 613 | 4860 | 6.27ms | 4860 | 18.5ms | return 0 if (! $self->check_time([$h,$mn,$s]) || # spent 18.5ms making 4860 calls to Date::Manip::Base::check_time, avg 4µs/call |
| 614 | $y<1 || $y>9999 || | ||||
| 615 | $m<1 || $m>12); | ||||
| 616 | |||||
| 617 | 4860 | 3.36ms | 4860 | 15.7ms | my $days = $self->days_in_month($y,$m); # spent 15.7ms making 4860 calls to Date::Manip::Base::days_in_month, avg 3µs/call |
| 618 | |||||
| 619 | 4860 | 1.01ms | return 0 if ($d<1 || $d>$days); | ||
| 620 | 4860 | 5.01ms | return 1; | ||
| 621 | } | ||||
| 622 | |||||
| 623 | # spent 18.5ms (13.2+5.29) within Date::Manip::Base::check_time which was called 4860 times, avg 4µs/call:
# 4860 times (13.2ms+5.29ms) by Date::Manip::Base::check at line 613, avg 4µs/call | ||||
| 624 | 4860 | 540µs | my($self,$hms) = @_; | ||
| 625 | 4860 | 1.08ms | my($h,$mn,$s) = @$hms; | ||
| 626 | |||||
| 627 | 4860 | 14.7ms | 4860 | 5.29ms | return 0 if ("$h:$mn:$s" !~ /^\d\d?:\d\d?:\d\d?$/o || # spent 5.29ms making 4860 calls to Date::Manip::Base::CORE:match, avg 1µs/call |
| 628 | $h > 24 || $mn > 59 || $s > 59 || | ||||
| 629 | ($h == 24 && ($mn || $s))); | ||||
| 630 | 4860 | 5.38ms | return 1; | ||
| 631 | } | ||||
| 632 | |||||
| 633 | sub week1_day1 { | ||||
| 634 | my($self,$year) = @_; | ||||
| 635 | my $firstday = $self->_config('firstday'); | ||||
| 636 | return $self->_week1_day1($firstday,$year); | ||||
| 637 | } | ||||
| 638 | |||||
| 639 | sub _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 | |||||
| 667 | sub weeks_in_year { | ||||
| 668 | my($self,$y) = @_; | ||||
| 669 | my $firstday = $self->_config('firstday'); | ||||
| 670 | return $self->_weeks_in_year($firstday,$y); | ||||
| 671 | } | ||||
| 672 | |||||
| 673 | sub _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 | |||||
| 701 | sub week_of_year { | ||||
| 702 | my($self,@args) = @_; | ||||
| 703 | my $firstday = $self->_config('firstday'); | ||||
| 704 | $self->_week_of_year($firstday,@args); | ||||
| 705 | } | ||||
| 706 | |||||
| 707 | sub _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 | |||||
| 759 | # spent 30µs (12+18) within Date::Manip::Base::calc_date_date which was called:
# once (12µs+18µs) by Date::Manip::TZ_Base::_update_now at line 383 of Date/Manip/TZ_Base.pm | ||||
| 760 | 1 | 400ns | my($self,$date0,$date1) = @_; | ||
| 761 | |||||
| 762 | # Order them so date0 < date1 | ||||
| 763 | # If $minus = 1, then the delta is negative | ||||
| 764 | |||||
| 765 | 1 | 300ns | my $minus = 0; | ||
| 766 | 1 | 1µs | 1 | 2µs | my $cmp = $self->cmp($date0,$date1); # spent 2µs making 1 call to Date::Manip::Base::cmp |
| 767 | |||||
| 768 | 1 | 800ns | 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 | 1 | 600ns | my($y0,$m0,$d0,$h0,$mn0,$s0) = @$date0; | ||
| 779 | 1 | 700ns | my($y1,$m1,$d1,$h1,$mn1,$s1) = @$date1; | ||
| 780 | |||||
| 781 | 1 | 600ns | my $sameday = ($y0 == $y1 && $m0 == $m1 && $d0 == $d1 ? 1 : 0); | ||
| 782 | |||||
| 783 | # Handle the various cases. | ||||
| 784 | |||||
| 785 | 1 | 200ns | my($dh,$dm,$ds); | ||
| 786 | 1 | 13µs | 1 | 16µs | if ($sameday) { # spent 16µs making 1 call to Date::Manip::Base::_calc_hms_hms |
| 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 | 1 | 300ns | if ($minus) { | ||
| 804 | $dh *= -1; | ||||
| 805 | $dm *= -1; | ||||
| 806 | $ds *= -1; | ||||
| 807 | } | ||||
| 808 | 1 | 2µs | return [$dh,$dm,$ds]; | ||
| 809 | } | ||||
| 810 | |||||
| 811 | sub 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 | |||||
| 828 | sub 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 | |||||
| 837 | sub 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 | |||||
| 892 | sub _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 | |||||
| 903 | sub _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 | |||||
| 938 | # spent 16µs within Date::Manip::Base::_calc_hms_hms which was called:
# once (16µs+0s) by Date::Manip::Base::calc_date_date at line 786 | ||||
| 939 | 1 | 500ns | my($self,$hms0,$hms1) = @_; | ||
| 940 | 1 | 800ns | my($h0,$m0,$s0,$h1,$m1,$s1) = (@$hms0,@$hms1); | ||
| 941 | |||||
| 942 | 1 | 1µs | my($s) = ($h1-$h0)*3600 + ($m1-$m0)*60 + $s1-$s0; | ||
| 943 | 1 | 1µs | my($m) = int($s/60); | ||
| 944 | 1 | 400ns | $s -= $m*60; | ||
| 945 | 1 | 300ns | my($h) = int($m/60); | ||
| 946 | 1 | 200ns | $m -= $h*60; | ||
| 947 | 1 | 2µs | return [$h,$m,$s]; | ||
| 948 | } | ||||
| 949 | |||||
| 950 | sub 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 82.2ms within Date::Manip::Base::cmp which was called 162406 times, avg 506ns/call:
# 162405 times (82.2ms+0s) by Date::Manip::TZ::__zone at line 952 of Date/Manip/TZ.pm, avg 506ns/call
# once (2µs+0s) by Date::Manip::Base::calc_date_date at line 766 | ||||
| 974 | 162406 | 18.4ms | my($self,$date0,$date1) = @_; | ||
| 975 | 162406 | 144ms | 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 22µs (17+4) within Date::Manip::Base::_os which was called 2 times, avg 11µs/call:
# once (11µs+3µs) by Date::Manip::Base::_init_config at line 207
# once (6µs+900ns) by Date::Manip::TZ::_init at line 96 of Date/Manip/TZ.pm | ||||
| 987 | 2 | 300ns | my($self) = @_; | ||
| 988 | |||||
| 989 | 2 | 600ns | my $os = ''; | ||
| 990 | |||||
| 991 | 2 | 19µs | 16 | 4µs | if ($^O =~ /MSWin32/io || # spent 4µs making 16 calls to Date::Manip::Base::CORE:match, avg 269ns/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 { | ||||
| 1008 | 2 | 400ns | $os = 'Unix'; | ||
| 1009 | } | ||||
| 1010 | |||||
| 1011 | 2 | 3µ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 | # | ||||
| 1026 | sub _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 3.31ms (61µs+3.25) within Date::Manip::Base::_config_var_base which was called 14 times, avg 236µs/call:
# 14 times (61µs+3.25ms) by Date::Manip::TZ_Base::_config_var at line 44 of Date/Manip/TZ_Base.pm, avg 236µs/call | ||||
| 1056 | 14 | 2µs | my($self,$var,$val) = @_; | ||
| 1057 | |||||
| 1058 | 14 | 16µ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') { | ||||
| 1080 | 1 | 2µs | 1 | 3.04ms | my $err = $self->_language($val); # spent 3.04ms making 1 call to Date::Manip::Base::_language |
| 1081 | 1 | 300ns | return if ($err); | ||
| 1082 | 1 | 2µs | 1 | 7µs | $err = $self->_config_var_encoding(); # spent 7µs making 1 call to Date::Manip::Base::_config_var_encoding |
| 1083 | 1 | 400ns | return if ($err); | ||
| 1084 | |||||
| 1085 | } elsif ($var eq 'yytoyyyy') { | ||||
| 1086 | 1 | 500ns | $val = lc($val); | ||
| 1087 | 1 | 5µs | 3 | 1µs | if ($val ne 'c' && # spent 1µs making 3 calls to Date::Manip::Base::CORE:match, avg 400ns/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') { | ||||
| 1096 | 1 | 2µs | 1 | 20µs | my $err = $self->_config_var_workweekbeg($val); # spent 20µs making 1 call to Date::Manip::Base::_config_var_workweekbeg |
| 1097 | 1 | 300ns | return if ($err); | ||
| 1098 | |||||
| 1099 | } elsif ($var eq 'workweekend') { | ||||
| 1100 | 1 | 1µs | 1 | 18µs | my $err = $self->_config_var_workweekend($val); # spent 18µs making 1 call to Date::Manip::Base::_config_var_workweekend |
| 1101 | 1 | 300ns | return if ($err); | ||
| 1102 | |||||
| 1103 | } elsif ($var eq 'workday24hr') { | ||||
| 1104 | 2 | 2µs | 2 | 25µs | my $err = $self->_config_var_workday24hr($val); # spent 25µs making 2 calls to Date::Manip::Base::_config_var_workday24hr, avg 12µs/call |
| 1105 | 2 | 200ns | return if ($err); | ||
| 1106 | |||||
| 1107 | } elsif ($var eq 'workdaybeg') { | ||||
| 1108 | 1 | 2µs | 1 | 77µs | my $err = $self->_config_var_workdaybegend(\$val,'WorkDayBeg'); # spent 77µs making 1 call to Date::Manip::Base::_config_var_workdaybegend |
| 1109 | 1 | 300ns | return if ($err); | ||
| 1110 | |||||
| 1111 | } elsif ($var eq 'workdayend') { | ||||
| 1112 | 1 | 1µs | 1 | 39µs | my $err = $self->_config_var_workdaybegend(\$val,'WorkDayEnd'); # spent 39µs making 1 call to Date::Manip::Base::_config_var_workdaybegend |
| 1113 | 1 | 300ns | return if ($err); | ||
| 1114 | |||||
| 1115 | } elsif ($var eq 'firstday') { | ||||
| 1116 | 1 | 1µs | 1 | 10µs | my $err = $self->_config_var_firstday($val); # spent 10µs making 1 call to Date::Manip::Base::_config_var_firstday |
| 1117 | 1 | 300ns | 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') { | ||||
| 1127 | 1 | 1µs | 1 | 6µs | my $err = $self->_config_var_recurrange($val); # spent 6µs making 1 call to Date::Manip::Base::_config_var_recurrange |
| 1128 | 1 | 500ns | return if ($err); | ||
| 1129 | |||||
| 1130 | } elsif ($var eq 'defaulttime') { | ||||
| 1131 | 1 | 1µs | 1 | 2µs | my $err = $self->_config_var_defaulttime($val); # spent 2µs making 1 call to Date::Manip::Base::_config_var_defaulttime |
| 1132 | 1 | 200ns | 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 | |||||
| 1149 | 14 | 6µs | $$self{'data'}{'sections'}{'conf'}{$var} = $val; | ||
| 1150 | 14 | 14µs | return; | ||
| 1151 | } | ||||
| 1152 | |||||
| 1153 | ############################################################################### | ||||
| 1154 | # Specific config variable functions | ||||
| 1155 | |||||
| 1156 | # spent 7µs within Date::Manip::Base::_config_var_encoding which was called:
# once (7µs+0s) by Date::Manip::Base::_config_var_base at line 1082 | ||||
| 1157 | 1 | 300ns | my($self,$val) = @_; | ||
| 1158 | |||||
| 1159 | 1 | 800ns | if (! $val) { | ||
| 1160 | 1 | 2µs | $$self{'data'}{'calc'}{'enc_in'} = [ @{ $$self{'data'}{'enc'} } ]; | ||
| 1161 | 1 | 600ns | $$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 | |||||
| 1207 | 1 | 2µs | if (! @{ $$self{'data'}{'calc'}{'enc_in'} }) { | ||
| 1208 | $$self{'data'}{'calc'}{'enc_in'} = [ qw(utf-8 perl) ]; | ||||
| 1209 | } | ||||
| 1210 | |||||
| 1211 | 1 | 2µs | return 0; | ||
| 1212 | } | ||||
| 1213 | |||||
| 1214 | # spent 6µs (4+2) within Date::Manip::Base::_config_var_recurrange which was called:
# once (4µs+2µs) by Date::Manip::Base::_config_var_base at line 1127 | ||||
| 1215 | 1 | 300ns | my($self,$val) = @_; | ||
| 1216 | |||||
| 1217 | 1 | 700ns | $val = lc($val); | ||
| 1218 | 1 | 6µs | 1 | 2µs | if ($val =~ /^(none|year|month|week|day|all)$/o) { # spent 2µs making 1 call to Date::Manip::Base::CORE:match |
| 1219 | return 0; | ||||
| 1220 | } | ||||
| 1221 | |||||
| 1222 | warn "ERROR: [config_var] invalid: RecurRange: $val\n"; | ||||
| 1223 | return 1; | ||||
| 1224 | } | ||||
| 1225 | |||||
| 1226 | # spent 20µs (10+10) within Date::Manip::Base::_config_var_workweekbeg which was called:
# once (10µs+10µs) by Date::Manip::Base::_config_var_base at line 1096 | ||||
| 1227 | 1 | 300ns | my($self,$val) = @_; | ||
| 1228 | |||||
| 1229 | 1 | 800ns | 1 | 2µs | if (! $self->_is_int($val,1,7)) { # spent 2µs making 1 call to Date::Manip::Base::_is_int |
| 1230 | warn "ERROR: [config_var] invalid: WorkWeekBeg: $val\n"; | ||||
| 1231 | return 1; | ||||
| 1232 | } | ||||
| 1233 | 1 | 1µs | 1 | 2µs | if ($val >= $self->_config('workweekend')) { # spent 2µs making 1 call to Date::Manip::TZ_Base::_config |
| 1234 | warn "ERROR: [config_var] WorkWeekBeg must be before WorkWeekEnd\n"; | ||||
| 1235 | return 1; | ||||
| 1236 | } | ||||
| 1237 | |||||
| 1238 | 1 | 1µs | 1 | 3µs | $self->_calc_workweek($val,''); # spent 3µs making 1 call to Date::Manip::Base::_calc_workweek |
| 1239 | 1 | 1µs | 1 | 2µs | $self->_init_business_length(); # spent 2µs making 1 call to Date::Manip::Base::_init_business_length |
| 1240 | 1 | 2µs | return 0; | ||
| 1241 | } | ||||
| 1242 | |||||
| 1243 | # spent 18µs (9+9) within Date::Manip::Base::_config_var_workweekend which was called:
# once (9µs+9µs) by Date::Manip::Base::_config_var_base at line 1100 | ||||
| 1244 | 1 | 400ns | my($self,$val) = @_; | ||
| 1245 | |||||
| 1246 | 1 | 2µs | 1 | 3µs | if (! $self->_is_int($val,1,7)) { # spent 3µs making 1 call to Date::Manip::Base::_is_int |
| 1247 | warn "ERROR: [config_var] invalid: WorkWeekBeg: $val\n"; | ||||
| 1248 | return 1; | ||||
| 1249 | } | ||||
| 1250 | 1 | 1µs | 1 | 1µs | if ($val <= $self->_config('workweekbeg')) { # spent 1µs making 1 call to Date::Manip::TZ_Base::_config |
| 1251 | warn "ERROR: [config_var] WorkWeekEnd must be after WorkWeekBeg\n"; | ||||
| 1252 | return 1; | ||||
| 1253 | } | ||||
| 1254 | |||||
| 1255 | 1 | 800ns | 1 | 3µs | $self->_calc_workweek('',$val); # spent 3µs making 1 call to Date::Manip::Base::_calc_workweek |
| 1256 | 1 | 700ns | 1 | 2µs | $self->_init_business_length(); # spent 2µs making 1 call to Date::Manip::Base::_init_business_length |
| 1257 | 1 | 1µs | return 0; | ||
| 1258 | } | ||||
| 1259 | |||||
| 1260 | # spent 25µs (12+12) within Date::Manip::Base::_config_var_workday24hr which was called 2 times, avg 12µs/call:
# 2 times (12µs+12µs) by Date::Manip::Base::_config_var_base at line 1104, avg 12µs/call | ||||
| 1261 | 2 | 500ns | my($self,$val) = @_; | ||
| 1262 | |||||
| 1263 | 2 | 900ns | if ($val) { | ||
| 1264 | 1 | 1µs | $$self{'data'}{'sections'}{'conf'}{'workdaybeg'} = '00:00:00'; | ||
| 1265 | 1 | 800ns | $$self{'data'}{'sections'}{'conf'}{'workdayend'} = '24:00:00'; | ||
| 1266 | 1 | 2µs | $$self{'data'}{'calc'}{'workdaybeg'} = [0,0,0]; | ||
| 1267 | 1 | 1µs | $$self{'data'}{'calc'}{'workdayend'} = [24,0,0]; | ||
| 1268 | |||||
| 1269 | 1 | 1µs | 1 | 5µs | $self->_calc_bdlength(); # spent 5µs making 1 call to Date::Manip::Base::_calc_bdlength |
| 1270 | 1 | 2µs | 1 | 7µs | $self->_init_business_length(); # spent 7µs making 1 call to Date::Manip::Base::_init_business_length |
| 1271 | } | ||||
| 1272 | |||||
| 1273 | 2 | 3µs | return 0; | ||
| 1274 | } | ||||
| 1275 | |||||
| 1276 | sub _config_var_workdaybegend { | ||||
| 1277 | 2 | 500ns | my($self,$val,$conf) = @_; | ||
| 1278 | |||||
| 1279 | # Must be a valid time. Entered as H, H:M, or H:M:S | ||||
| 1280 | |||||
| 1281 | 2 | 3µs | 2 | 50µs | my $tmp = $self->split('hms',$$val); # spent 50µs making 2 calls to Date::Manip::Base::split, avg 25µs/call |
| 1282 | 2 | 300ns | if (! defined $tmp) { | ||
| 1283 | warn "ERROR: [config_var] invalid: $conf: $$val\n"; | ||||
| 1284 | return 1; | ||||
| 1285 | } | ||||
| 1286 | 2 | 2µs | $$self{'data'}{'calc'}{lc($conf)} = $tmp; | ||
| 1287 | 2 | 2µs | 2 | 30µs | $$val = $self->join('hms',$tmp); # spent 30µs making 2 calls to Date::Manip::Base::join, avg 15µs/call |
| 1288 | |||||
| 1289 | # workdaybeg < workdayend | ||||
| 1290 | |||||
| 1291 | 2 | 2µs | my @beg = @{ $$self{'data'}{'calc'}{'workdaybeg'} }; | ||
| 1292 | 2 | 1µs | my @end = @{ $$self{'data'}{'calc'}{'workdayend'} }; | ||
| 1293 | 2 | 2µs | my $beg = $beg[0]*3600 + $beg[1]*60 + $beg[2]; | ||
| 1294 | 2 | 800ns | my $end = $end[0]*3600 + $end[1]*60 + $end[2]; | ||
| 1295 | |||||
| 1296 | 2 | 500ns | if ($beg > $end) { | ||
| 1297 | warn "ERROR: [config_var] WorkDayBeg not before WorkDayEnd\n"; | ||||
| 1298 | return 1; | ||||
| 1299 | } | ||||
| 1300 | |||||
| 1301 | # Calculate bdlength | ||||
| 1302 | |||||
| 1303 | 2 | 900ns | $$self{'data'}{'sections'}{'conf'}{'workday24hr'} = 0; | ||
| 1304 | |||||
| 1305 | 2 | 1µs | 2 | 4µs | $self->_calc_bdlength(); # spent 4µs making 2 calls to Date::Manip::Base::_calc_bdlength, avg 2µs/call |
| 1306 | 2 | 2µs | 2 | 5µs | $self->_init_business_length(); # spent 5µs making 2 calls to Date::Manip::Base::_init_business_length, avg 3µs/call |
| 1307 | |||||
| 1308 | 2 | 4µs | return 0; | ||
| 1309 | } | ||||
| 1310 | |||||
| 1311 | # spent 10µs (4+6) within Date::Manip::Base::_config_var_firstday which was called:
# once (4µs+6µs) by Date::Manip::Base::_config_var_base at line 1116 | ||||
| 1312 | 1 | 500ns | my($self,$val) = @_; | ||
| 1313 | |||||
| 1314 | 1 | 2µs | 1 | 6µs | if (! $self->_is_int($val,1,7)) { # spent 6µs making 1 call to Date::Manip::Base::_is_int |
| 1315 | warn "ERROR: [config_var] invalid: FirstDay: $val\n"; | ||||
| 1316 | return 1; | ||||
| 1317 | } | ||||
| 1318 | |||||
| 1319 | 1 | 2µs | return 0; | ||
| 1320 | } | ||||
| 1321 | |||||
| 1322 | # spent 2µs within Date::Manip::Base::_config_var_defaulttime which was called:
# once (2µs+0s) by Date::Manip::Base::_config_var_base at line 1131 | ||||
| 1323 | 1 | 600ns | my($self,$val) = @_; | ||
| 1324 | |||||
| 1325 | 1 | 3µ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 | # | ||||
| 1339 | 2 | 70µs | 2 | 23µs | # spent 14µs (6+8) within Date::Manip::Base::BEGIN@1339 which was called:
# once (6µs+8µs) by Date::Manip::Date::BEGIN@26 at line 1339 # spent 14µs making 1 call to Date::Manip::Base::BEGIN@1339
# spent 8µs making 1 call to strict::unimport |
| 1340 | # spent 3.04ms (466µs+2.57) within Date::Manip::Base::_language which was called:
# once (466µs+2.57ms) by Date::Manip::Base::_config_var_base at line 1080 | ||||
| 1341 | 1 | 400ns | my($self,$lang) = @_; | ||
| 1342 | 1 | 600ns | $lang = lc($lang); | ||
| 1343 | |||||
| 1344 | 1 | 700ns | if (! exists $Date::Manip::Lang::index::Lang{$lang}) { | ||
| 1345 | warn "ERROR: [language] invalid: $lang\n"; | ||||
| 1346 | return 1; | ||||
| 1347 | } | ||||
| 1348 | |||||
| 1349 | 1 | 2µs | return 0 if (exists $$self{'data'}{'sections'}{'conf'} && | ||
| 1350 | $$self{'data'}{'sections'}{'conf'} eq $lang); | ||||
| 1351 | 1 | 800ns | 1 | 2µs | $self->_init_language(1); # spent 2µs making 1 call to Date::Manip::Base::_init_language |
| 1352 | |||||
| 1353 | 1 | 500ns | my $mod = $Date::Manip::Lang::index::Lang{$lang}; | ||
| 1354 | 1 | 21µs | eval "require Date::Manip::Lang::${mod}"; # spent 54µs executing statements in string eval | ||
| 1355 | 1 | 300ns | if ($@) { | ||
| 1356 | die "ERROR: failed to load Date::Manip::Lang::${mod}: $@\n"; | ||||
| 1357 | } | ||||
| 1358 | |||||
| 1359 | 2 | 109µs | 2 | 24µs | # spent 14µs (5+9) within Date::Manip::Base::BEGIN@1359 which was called:
# once (5µs+9µs) by Date::Manip::Date::BEGIN@26 at line 1359 # spent 14µs making 1 call to Date::Manip::Base::BEGIN@1359
# spent 9µs making 1 call to warnings::unimport |
| 1360 | 1 | 3µs | $$self{'data'}{'lang'} = ${ "Date::Manip::Lang::${mod}::Language" }; | ||
| 1361 | 1 | 2µs | $$self{'data'}{'enc'} = [ @{ "Date::Manip::Lang::${mod}::Encodings" } ]; | ||
| 1362 | |||||
| 1363 | # Common words | ||||
| 1364 | 1 | 2µs | 1 | 24µs | $self->_rx_wordlist('at'); # spent 24µs making 1 call to Date::Manip::Base::_rx_wordlist |
| 1365 | 1 | 1µs | 1 | 12µs | $self->_rx_wordlist('each'); # spent 12µs making 1 call to Date::Manip::Base::_rx_wordlist |
| 1366 | 1 | 800ns | 1 | 8µs | $self->_rx_wordlist('last'); # spent 8µs making 1 call to Date::Manip::Base::_rx_wordlist |
| 1367 | 1 | 600ns | 1 | 9µs | $self->_rx_wordlist('of'); # spent 9µs making 1 call to Date::Manip::Base::_rx_wordlist |
| 1368 | 1 | 600ns | 1 | 5µs | $self->_rx_wordlist('on'); # spent 5µs making 1 call to Date::Manip::Base::_rx_wordlist |
| 1369 | 1 | 2µs | 1 | 58µs | $self->_rx_wordlists('when'); # spent 58µs making 1 call to Date::Manip::Base::_rx_wordlists |
| 1370 | |||||
| 1371 | # Next/prev | ||||
| 1372 | 1 | 700ns | 1 | 29µs | $self->_rx_wordlists('nextprev'); # spent 29µs making 1 call to Date::Manip::Base::_rx_wordlists |
| 1373 | |||||
| 1374 | # Field names (years, year, yr, ...) | ||||
| 1375 | 1 | 700ns | 1 | 170µs | $self->_rx_wordlists('fields'); # spent 170µs making 1 call to Date::Manip::Base::_rx_wordlists |
| 1376 | |||||
| 1377 | # Numbers (first, 1st) | ||||
| 1378 | 1 | 1µs | 1 | 948µs | $self->_rx_wordlists('nth'); # spent 948µs making 1 call to Date::Manip::Base::_rx_wordlists |
| 1379 | 1 | 2µs | 1 | 506µs | $self->_rx_wordlists('nth','nth_dom',31); # 1-31 # spent 506µs making 1 call to Date::Manip::Base::_rx_wordlists |
| 1380 | 1 | 1µs | 1 | 74µs | $self->_rx_wordlists('nth','nth_wom',5); # 1-5 # spent 74µs making 1 call to Date::Manip::Base::_rx_wordlists |
| 1381 | |||||
| 1382 | # Calendar names (Mon, Tue and Jan, Feb) | ||||
| 1383 | 1 | 900ns | 1 | 113µs | $self->_rx_wordlists('day_abb'); # spent 113µs making 1 call to Date::Manip::Base::_rx_wordlists |
| 1384 | 1 | 800ns | 1 | 46µs | $self->_rx_wordlists('day_char'); # spent 46µs making 1 call to Date::Manip::Base::_rx_wordlists |
| 1385 | 1 | 900ns | 1 | 44µs | $self->_rx_wordlists('day_name'); # spent 44µs making 1 call to Date::Manip::Base::_rx_wordlists |
| 1386 | 1 | 700ns | 1 | 161µs | $self->_rx_wordlists('month_abb'); # spent 161µs making 1 call to Date::Manip::Base::_rx_wordlists |
| 1387 | 1 | 700ns | 1 | 79µs | $self->_rx_wordlists('month_name'); # spent 79µs making 1 call to Date::Manip::Base::_rx_wordlists |
| 1388 | |||||
| 1389 | # H:M:S separators | ||||
| 1390 | 1 | 2µs | 1 | 4µs | $self->_rx_simple('sephm'); # spent 4µs making 1 call to Date::Manip::Base::_rx_simple |
| 1391 | 1 | 800ns | 1 | 1µs | $self->_rx_simple('sepms'); # spent 1µs making 1 call to Date::Manip::Base::_rx_simple |
| 1392 | 1 | 400ns | 1 | 1µs | $self->_rx_simple('sepfr'); # spent 1µs making 1 call to Date::Manip::Base::_rx_simple |
| 1393 | |||||
| 1394 | # Time replacement strings | ||||
| 1395 | 1 | 2µs | 1 | 76µs | $self->_rx_replace('times'); # spent 76µs making 1 call to Date::Manip::Base::_rx_replace |
| 1396 | |||||
| 1397 | # Some offset strings | ||||
| 1398 | 1 | 2µs | 1 | 90µs | $self->_rx_replace('offset_date'); # spent 90µs making 1 call to Date::Manip::Base::_rx_replace |
| 1399 | 1 | 900ns | 1 | 24µs | $self->_rx_replace('offset_time'); # spent 24µs making 1 call to Date::Manip::Base::_rx_replace |
| 1400 | |||||
| 1401 | # AM/PM strings | ||||
| 1402 | 1 | 900ns | 1 | 34µs | $self->_rx_wordlists('ampm'); # spent 34µs making 1 call to Date::Manip::Base::_rx_wordlists |
| 1403 | |||||
| 1404 | # Business/non-business mode | ||||
| 1405 | 1 | 900ns | 1 | 20µs | $self->_rx_wordlists('mode'); # spent 20µs making 1 call to Date::Manip::Base::_rx_wordlists |
| 1406 | |||||
| 1407 | 1 | 2µs | return 0; | ||
| 1408 | } | ||||
| 1409 | 2 | 159µs | 2 | 15µs | # spent 10µs (4+6) within Date::Manip::Base::BEGIN@1409 which was called:
# once (4µs+6µs) by Date::Manip::Date::BEGIN@26 at line 1409 # spent 10µs making 1 call to Date::Manip::Base::BEGIN@1409
# spent 6µ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 | sub _rx_simple { | ||||
| 1418 | 3 | 700ns | my($self,$ele) = @_; | ||
| 1419 | |||||
| 1420 | 3 | 6µ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 { | ||||
| 1427 | 3 | 2µ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 785µs (678+106) within Date::Manip::Base::_qe_quote which was called 415 times, avg 2µs/call:
# 391 times (647µs+102µs) by Date::Manip::Base::_rx_wordlists at line 1527, avg 2µs/call
# 8 times (13µs+2µs) by Date::Manip::Base::_rx_wordlist at line 1459, avg 2µs/call
# 8 times (10µs+1µs) by Date::Manip::Base::_rx_replace at line 1493, avg 1µs/call
# 8 times (8µs+1µs) by Date::Manip::Base::_rx_replace at line 1499, avg 1µs/call | ||||
| 1435 | 415 | 48µs | my($string) = @_; | ||
| 1436 | 415 | 607µs | 625 | 106µs | $string =~ s/([-.+*?])/\\$1/g; # spent 68µs making 415 calls to Date::Manip::Base::CORE:subst, avg 164ns/call
# spent 38µs making 210 calls to Date::Manip::Base::CORE:substcont, avg 183ns/call |
| 1437 | 415 | 338µs | 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 58µs (37+21) within Date::Manip::Base::_rx_wordlist which was called 5 times, avg 12µs/call:
# once (15µs+8µs) by Date::Manip::Base::_language at line 1364
# once (6µs+6µs) by Date::Manip::Base::_language at line 1365
# once (6µs+3µs) by Date::Manip::Base::_language at line 1367
# once (5µs+3µs) by Date::Manip::Base::_language at line 1366
# once (4µs+1µs) by Date::Manip::Base::_language at line 1368 | ||||
| 1450 | 5 | 1µs | my($self,$ele) = @_; | ||
| 1451 | |||||
| 1452 | 5 | 9µs | if (exists $$self{'data'}{'lang'}{$ele}) { | ||
| 1453 | 5 | 3µs | my @tmp = @{ $$self{'data'}{'lang'}{$ele} }; | ||
| 1454 | |||||
| 1455 | 5 | 3µs | $$self{'data'}{'wordlist'}{$ele} = $tmp[0]; | ||
| 1456 | |||||
| 1457 | 5 | 500ns | my @tmp2; | ||
| 1458 | 5 | 2µs | foreach my $tmp (@tmp) { | ||
| 1459 | 8 | 6µs | 8 | 15µs | push(@tmp2,_qe_quote($tmp)) if ($tmp); # spent 15µs making 8 calls to Date::Manip::Base::_qe_quote, avg 2µs/call |
| 1460 | } | ||||
| 1461 | 5 | 8µs | 5 | 6µs | @tmp2 = sort _sortByLength(@tmp2); # spent 6µs making 5 calls to Date::Manip::Base::CORE:sort, avg 1µs/call |
| 1462 | |||||
| 1463 | 5 | 5µs | $$self{'data'}{'rx'}{$ele} = join('|',@tmp2); | ||
| 1464 | |||||
| 1465 | } else { | ||||
| 1466 | $$self{'data'}{'rx'}{$ele} = undef; | ||||
| 1467 | } | ||||
| 1468 | } | ||||
| 1469 | |||||
| 1470 | 2 | 33µs | 2 | 17µs | # spent 11µs (5+6) within Date::Manip::Base::BEGIN@1470 which was called:
# once (5µs+6µs) by Date::Manip::Date::BEGIN@26 at line 1470 # spent 11µs making 1 call to Date::Manip::Base::BEGIN@1470
# spent 6µs making 1 call to strict::unimport |
| 1471 | sub _sortByLength { | ||||
| 1472 | 2102 | 425µs | return (length $b <=> length $a); | ||
| 1473 | } | ||||
| 1474 | 2 | 892µs | 2 | 13µs | # spent 8µs (4+4) within Date::Manip::Base::BEGIN@1474 which was called:
# once (4µs+4µs) by Date::Manip::Date::BEGIN@26 at line 1474 # spent 8µs making 1 call to Date::Manip::Base::BEGIN@1474
# spent 4µ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 190µs (85+104) within Date::Manip::Base::_rx_replace which was called 3 times, avg 63µs/call:
# once (33µs+57µs) by Date::Manip::Base::_language at line 1398
# once (41µs+35µs) by Date::Manip::Base::_language at line 1395
# once (12µs+12µs) by Date::Manip::Base::_language at line 1399 | ||||
| 1482 | 3 | 1µs | my($self,$ele) = @_; | ||
| 1483 | |||||
| 1484 | 3 | 2µs | if (! exists $$self{'data'}{'lang'}{$ele}) { | ||
| 1485 | $$self{'data'}{'rx'}{$ele} = []; | ||||
| 1486 | return; | ||||
| 1487 | } | ||||
| 1488 | |||||
| 1489 | 3 | 4µs | my(@key) = keys %{ $$self{'data'}{'lang'}{$ele} }; | ||
| 1490 | 3 | 300ns | my $i = 1; | ||
| 1491 | 3 | 6µs | 3 | 2µs | foreach my $key (sort(@key)) { # spent 2µs making 3 calls to Date::Manip::Base::CORE:sort, avg 500ns/call |
| 1492 | 8 | 3µs | my $val = $$self{'data'}{'lang'}{$ele}{$key}; | ||
| 1493 | 8 | 4µs | 8 | 11µs | my $k = _qe_quote($key); # spent 11µs making 8 calls to Date::Manip::Base::_qe_quote, avg 1µs/call |
| 1494 | 8 | 67µs | 16 | 46µs | $$self{'data'}{'rx'}{$ele}[$i++] = qr/(?:^|\b)($k)(?:\b|$)/i; # spent 42µs making 8 calls to Date::Manip::Base::CORE:regcomp, avg 5µs/call
# spent 4µs making 8 calls to Date::Manip::Base::CORE:qr, avg 450ns/call |
| 1495 | 8 | 7µs | $$self{'data'}{'wordmatch'}{$ele}{lc($key)} = $val; | ||
| 1496 | } | ||||
| 1497 | |||||
| 1498 | 3 | 3µs | 3 | 3µs | @key = sort _sortByLength(@key); # spent 3µs making 3 calls to Date::Manip::Base::CORE:sort, avg 1µs/call |
| 1499 | 11 | 7µs | 8 | 9µs | @key = map { _qe_quote($_) } @key; # spent 9µs making 8 calls to Date::Manip::Base::_qe_quote, avg 1µs/call |
| 1500 | 3 | 2µs | my $rx = join('|',@key); | ||
| 1501 | |||||
| 1502 | 3 | 52µs | 6 | 33µs | $$self{'data'}{'rx'}{$ele}[0] = qr/(?:^|\b)(?:$rx)(?:\b|$)/i; # spent 31µs making 3 calls to Date::Manip::Base::CORE:regcomp, avg 10µs/call
# spent 2µs making 3 calls to Date::Manip::Base::CORE:qr, avg 700ns/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 2.28ms (1.17+1.11) within Date::Manip::Base::_rx_wordlists which was called 13 times, avg 176µs/call:
# once (432µs+516µs) by Date::Manip::Base::_language at line 1378
# once (246µs+260µs) by Date::Manip::Base::_language at line 1379
# once (95µs+76µs) by Date::Manip::Base::_language at line 1375
# once (84µs+77µs) by Date::Manip::Base::_language at line 1386
# once (55µs+58µs) by Date::Manip::Base::_language at line 1383
# once (56µs+23µs) by Date::Manip::Base::_language at line 1387
# once (46µs+28µs) by Date::Manip::Base::_language at line 1380
# once (39µs+19µs) by Date::Manip::Base::_language at line 1369
# once (34µs+12µs) by Date::Manip::Base::_language at line 1384
# once (32µs+11µs) by Date::Manip::Base::_language at line 1385
# once (19µs+16µs) by Date::Manip::Base::_language at line 1402
# once (17µs+12µs) by Date::Manip::Base::_language at line 1372
# once (15µs+5µs) by Date::Manip::Base::_language at line 1405 | ||||
| 1511 | 13 | 3µs | my($self,$ele,$subset,$max) = @_; | ||
| 1512 | 13 | 2µs | $subset = $ele if (! $subset); | ||
| 1513 | |||||
| 1514 | 13 | 26µs | if (exists $$self{'data'}{'lang'}{$ele}) { | ||
| 1515 | 13 | 10µs | my @vallist = @{ $$self{'data'}{'lang'}{$ele} }; | ||
| 1516 | 13 | 4µs | $max = $#vallist+1 if (! $max || $max > $#vallist+1); | ||
| 1517 | 13 | 500ns | my (@all); | ||
| 1518 | |||||
| 1519 | 13 | 32µs | for (my $i=1; $i<=$max; $i++) { | ||
| 1520 | 149 | 65µs | my @tmp = @{ $$self{'data'}{'lang'}{$ele}[$i-1] }; | ||
| 1521 | 149 | 51µs | $$self{'data'}{'wordlist'}{$subset}[$i-1] = $tmp[0]; | ||
| 1522 | |||||
| 1523 | 149 | 8µs | my @str; | ||
| 1524 | 149 | 32µs | foreach my $str (@tmp) { | ||
| 1525 | 391 | 22µs | next if (! $str); | ||
| 1526 | 391 | 174µs | $$self{'data'}{'wordmatch'}{$subset}{lc($str)} = $i; | ||
| 1527 | 391 | 234µs | 391 | 749µs | push(@str,_qe_quote($str)); # spent 749µs making 391 calls to Date::Manip::Base::_qe_quote, avg 2µs/call |
| 1528 | } | ||||
| 1529 | 149 | 38µs | push(@all,@str); | ||
| 1530 | |||||
| 1531 | 149 | 78µs | 149 | 108µs | @str = sort _sortByLength(@str); # spent 108µs making 149 calls to Date::Manip::Base::CORE:sort, avg 722ns/call |
| 1532 | 149 | 118µs | $$self{'data'}{'rx'}{$subset}[$i] = join('|',@str); | ||
| 1533 | } | ||||
| 1534 | |||||
| 1535 | 13 | 6µs | 13 | 256µs | @all = sort _sortByLength(@all); # spent 256µs making 13 calls to Date::Manip::Base::CORE:sort, avg 20µs/call |
| 1536 | 13 | 35µ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 | |||||
| 1551 | sub _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); | ||||
| 1572 | sub _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 11µs (8+2) within Date::Manip::Base::_is_int which was called 3 times, avg 4µs/call:
# once (5µs+1µs) by Date::Manip::Base::_config_var_firstday at line 1314
# once (2µs+600ns) by Date::Manip::Base::_config_var_workweekend at line 1246
# once (2µs+400ns) by Date::Manip::Base::_config_var_workweekbeg at line 1229 | ||||
| 1604 | 3 | 900ns | my($self,$N,$low,$high)=@_; | ||
| 1605 | 3 | 7µs | 3 | 2µs | return 0 if (! defined $N or # spent 2µs making 3 calls to Date::Manip::Base::CORE:match, avg 667ns/call |
| 1606 | $N !~ /^\s*[-+]?\d+\s*$/o or | ||||
| 1607 | defined $low && $N<$low or | ||||
| 1608 | defined $high && $N>$high); | ||||
| 1609 | 3 | 4µs | return 1; | ||
| 1610 | } | ||||
| 1611 | |||||
| 1612 | ############################################################################### | ||||
| 1613 | # Split/Join functions | ||||
| 1614 | |||||
| 1615 | # spent 99.3ms (42.5+56.8) within Date::Manip::Base::split which was called 7286 times, avg 14µs/call:
# 2436 times (8.76ms+1.93ms) by Date::Manip::Date::parse at line 132 of Date/Manip/Date.pm, avg 4µs/call
# 2424 times (17.0ms+27.8ms) by Date::Manip::Base::_delta_convert at line 2286, avg 18µs/call
# 2424 times (16.8ms+27.1ms) by Date::Manip::Date::__parse_check at line 1038 of Date/Manip/Date.pm, avg 18µs/call
# 2 times (22µs+29µs) by Date::Manip::Base::_config_var_workdaybegend at line 1281, avg 25µs/call | ||||
| 1616 | 7286 | 1.79ms | my($self,$op,$string,$no_normalize) = @_; | ||
| 1617 | 7286 | 1.05ms | $no_normalize = 0 if (! $no_normalize); | ||
| 1618 | |||||
| 1619 | 7286 | 1.93ms | if ($op eq 'date') { | ||
| 1620 | |||||
| 1621 | 2436 | 7.78ms | 7308 | 1.93ms | if ($string =~ /^(\d\d\d\d)(\d\d)(\d\d)(\d\d):(\d\d):(\d\d)$/o || # spent 1.93ms making 7308 calls to Date::Manip::Base::CORE:match, avg 264ns/call |
| 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 | 2436 | 2.83ms | return undef; | ||
| 1628 | } | ||||
| 1629 | |||||
| 1630 | } elsif ($op eq 'offset') { | ||||
| 1631 | 4848 | 12.9ms | 9696 | 4.01ms | if ($string =~ /^([-+]?\d\d)(\d\d)(\d\d)$/o || # spent 4.01ms making 9696 calls to Date::Manip::Base::CORE:match, avg 414ns/call |
| 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 | 4848 | 13.9ms | 4848 | 50.8ms | my($err,$h,$mn,$s) = $self->_offset_fields( { 'source' => 'string', # spent 50.8ms making 4848 calls to Date::Manip::Base::_offset_fields, avg 10µs/call |
| 1637 | 'out' => 'list'}, | ||||
| 1638 | [$1,$2,$3]); | ||||
| 1639 | 4848 | 504µs | return undef if ($err); | ||
| 1640 | 4848 | 7.44ms | return [$h,$mn,$s]; | ||
| 1641 | } else { | ||||
| 1642 | return undef; | ||||
| 1643 | } | ||||
| 1644 | |||||
| 1645 | } elsif ($op eq 'hms') { | ||||
| 1646 | 2 | 13µs | 6 | 6µs | if ($string =~ /^(\d\d)(\d\d)(\d\d)$/o || # spent 6µs making 6 calls to Date::Manip::Base::CORE:match, avg 933ns/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) { | ||||
| 1651 | 2 | 8µs | 2 | 23µs | my($err,$h,$mn,$s) = $self->_hms_fields( { 'out' => 'list' },[$1,$2,$3]); # spent 23µs making 2 calls to Date::Manip::Base::_hms_fields, avg 12µs/call |
| 1652 | 2 | 400ns | return undef if ($err); | ||
| 1653 | 2 | 4µ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 | sub join{ | ||||
| 1687 | 2426 | 536µs | my($self,$op,$data,$no_normalize) = @_; | ||
| 1688 | 2426 | 813µs | my @data = @$data; | ||
| 1689 | |||||
| 1690 | 2426 | 576µ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 | 2424 | 4.20ms | 2424 | 25.2ms | my($err,$h,$mn,$s) = $self->_offset_fields( { 'source' => 'list', # spent 25.2ms making 2424 calls to Date::Manip::Base::_offset_fields, avg 10µs/call |
| 1705 | 'out' => 'string'}, | ||||
| 1706 | [@data]); | ||||
| 1707 | 2424 | 252µs | return undef if ($err); | ||
| 1708 | 2424 | 4.06ms | return "$h:$mn:$s"; | ||
| 1709 | |||||
| 1710 | } elsif ($op eq 'hms') { | ||||
| 1711 | 2 | 4µs | 2 | 18µs | my($err,$h,$mn,$s) = $self->_hms_fields( { 'out' => 'string' },[@data]); # spent 18µs making 2 calls to Date::Manip::Base::_hms_fields, avg 9µs/call |
| 1712 | 2 | 300ns | return undef if ($err); | ||
| 1713 | 2 | 5µ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 | |||||
| 1735 | # spent 51µs (27+24) within Date::Manip::Base::_split_delta which was called 6 times, avg 9µs/call:
# 6 times (27µs+24µs) by Date::Manip::Delta::parse at line 320 of Date/Manip/Delta.pm, avg 9µs/call | ||||
| 1736 | 6 | 2µs | my($self,$string) = @_; | ||
| 1737 | |||||
| 1738 | 6 | 1µs | my $sign = '[-+]?'; | ||
| 1739 | 6 | 1µs | my $num = '(?:\d+(?:\.\d*)?|\.\d+)'; | ||
| 1740 | 6 | 3µs | my $f = "(?:$sign$num)?"; | ||
| 1741 | |||||
| 1742 | 6 | 38µs | 12 | 24µs | if ($string =~ /^$f(:$f){0,6}$/o) { # spent 17µs making 6 calls to Date::Manip::Base::CORE:regcomp, avg 3µs/call
# spent 7µs making 6 calls to Date::Manip::Base::CORE:match, avg 1µs/call |
| 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 | 6 | 13µs | 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 | # | ||||
| 1779 | sub _delta_fields { | ||||
| 1780 | my($self,$opts,$fields) = @_; | ||||
| 1781 | my @fields = @$fields; | ||||
| 1782 | 2 | 782µs | 2 | 10µs | # spent 9µs (8+1) within Date::Manip::Base::BEGIN@1782 which was called:
# once (8µs+1µs) by Date::Manip::Date::BEGIN@26 at line 1782 # spent 9µs making 1 call to Date::Manip::Base::BEGIN@1782
# spent 1µ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 | sub _hms_fields { | ||||
| 1904 | 4 | 1µs | my($self,$opts,$fields) = @_; | ||
| 1905 | 4 | 2µ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 | |||||
| 1912 | 4 | 1µs | foreach my $f (@fields) { | ||
| 1913 | 12 | 1µs | $f=0 if (! $f); | ||
| 1914 | 12 | 17µs | 12 | 5µs | return (1) if ($f !~ /^\d+$/o); # spent 5µs making 12 calls to Date::Manip::Base::CORE:match, avg 400ns/call |
| 1915 | } | ||||
| 1916 | 4 | 900ns | return (1) if (@fields > 3); | ||
| 1917 | 4 | 2µs | while (@fields < 3) { | ||
| 1918 | push(@fields,0); | ||||
| 1919 | } | ||||
| 1920 | |||||
| 1921 | # | ||||
| 1922 | # Check validity. | ||||
| 1923 | # | ||||
| 1924 | |||||
| 1925 | 4 | 1µs | my ($h,$m,$s) = @fields; | ||
| 1926 | 4 | 2µs | return (1) if ($h > 24 || $m > 59 || $s > 59 || | ||
| 1927 | ($h==24 && ($m > 0 || $s > 0))); | ||||
| 1928 | |||||
| 1929 | # | ||||
| 1930 | # Format | ||||
| 1931 | # | ||||
| 1932 | |||||
| 1933 | 4 | 2µs | if ($$opts{'out'} eq 'list') { | ||
| 1934 | foreach my $f ($h,$m,$s) { | ||||
| 1935 | 6 | 1µs | $f *= 1; | ||
| 1936 | } | ||||
| 1937 | |||||
| 1938 | } else { | ||||
| 1939 | 2 | 700ns | foreach my $f ($h,$m,$s) { | ||
| 1940 | 6 | 3µs | $f = "0$f" if (length($f)<2); | ||
| 1941 | } | ||||
| 1942 | } | ||||
| 1943 | |||||
| 1944 | 4 | 7µ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 | # | ||||
| 1958 | sub _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 | # | ||||
| 2064 | sub _offset_fields { | ||||
| 2065 | 7272 | 1.20ms | my($self,$opts,$fields) = @_; | ||
| 2066 | 7272 | 3.43ms | 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 | 7272 | 2.54ms | foreach my $f (@fields) { | ||
| 2074 | 21816 | 3.66ms | $f=0 if (! defined $f || $f eq ''); | ||
| 2075 | 21816 | 29.5ms | 21816 | 8.19ms | return (1) if ($f !~ /^[+-]?\d+$/o); # spent 8.19ms making 21816 calls to Date::Manip::Base::CORE:match, avg 375ns/call |
| 2076 | } | ||||
| 2077 | 7272 | 1.18ms | return (1) if (@fields > 3); | ||
| 2078 | 7272 | 2.02ms | while (@fields < 3) { | ||
| 2079 | push(@fields,0); | ||||
| 2080 | } | ||||
| 2081 | |||||
| 2082 | # | ||||
| 2083 | # Check validity. | ||||
| 2084 | # | ||||
| 2085 | |||||
| 2086 | 7272 | 2.19ms | my ($h,$m,$s) = @fields; | ||
| 2087 | 7272 | 3.92ms | 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 | 2424 | 1.23ms | 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 | 55 | 16µs | 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 | 7272 | 1.81ms | 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 | 4848 | 7.25ms | 5210 | 1.91ms | if ($h =~ /^\-/) { # spent 1.91ms making 5210 calls to Date::Manip::Base::CORE:match, avg 366ns/call |
| 2125 | 4486 | 679µs | $h *= 1; | ||
| 2126 | 4486 | 454µs | $m *= -1; | ||
| 2127 | 4486 | 513µs | $s *= -1; | ||
| 2128 | } elsif ($m =~ /^\-/) { | ||||
| 2129 | $h *= 1; | ||||
| 2130 | $m *= 1; | ||||
| 2131 | $s *= -1; | ||||
| 2132 | } else { | ||||
| 2133 | 362 | 56µs | $h *= 1; | ||
| 2134 | 362 | 33µs | $m *= 1; | ||
| 2135 | 362 | 43µs | $s *= 1; | ||
| 2136 | } | ||||
| 2137 | |||||
| 2138 | } else { | ||||
| 2139 | 2424 | 542µs | foreach my $f (@fields) { | ||
| 2140 | 7272 | 1.43ms | $f *= 1; | ||
| 2141 | } | ||||
| 2142 | } | ||||
| 2143 | |||||
| 2144 | # | ||||
| 2145 | # Format them. They're already done for 'list' output. | ||||
| 2146 | # | ||||
| 2147 | |||||
| 2148 | 7272 | 1.51ms | if ($$opts{'out'} eq 'string') { | ||
| 2149 | 2424 | 179µs | my $sign; | ||
| 2150 | 2424 | 535µs | if ($h<0 || $m<0 || $s<0) { | ||
| 2151 | 2242 | 325µs | $h = abs($h); | ||
| 2152 | 2242 | 248µs | $m = abs($m); | ||
| 2153 | 2242 | 141µs | $s = abs($s); | ||
| 2154 | 2242 | 343µs | $sign = '-'; | ||
| 2155 | } else { | ||||
| 2156 | 182 | 29µs | $sign = '+'; | ||
| 2157 | } | ||||
| 2158 | |||||
| 2159 | 2424 | 1.22ms | $h = "0$h" if (length($h) < 2); | ||
| 2160 | 2424 | 590µs | $m = "0$m" if (length($m) < 2); | ||
| 2161 | 2424 | 449µs | $s = "0$s" if (length($s) < 2); | ||
| 2162 | 2424 | 728µs | $h = "$sign$h"; | ||
| 2163 | } | ||||
| 2164 | |||||
| 2165 | 7272 | 10.4ms | 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 21.1ms within Date::Manip::Base::_date_fields which was called 4859 times, avg 4µs/call:
# 4859 times (21.1ms+0s) by Date::Manip::TZ::date_period at line 1229 of Date/Manip/TZ.pm, avg 4µs/call | ||||
| 2173 | 4859 | 3.32ms | my($self,@fields) = @_; | ||
| 2174 | 4859 | 879µs | return (1) if (@fields != 6); | ||
| 2175 | |||||
| 2176 | 4859 | 1.57ms | my($y,$m,$d,$h,$mn,$s) = @fields; | ||
| 2177 | |||||
| 2178 | 4859 | 2.27ms | $y = "0$y" while (length($y) < 4); | ||
| 2179 | 4859 | 1.97ms | $m = "0$m" if (length($m)==1); | ||
| 2180 | 4859 | 1.05ms | $d = "0$d" if (length($d)==1); | ||
| 2181 | 4859 | 568µs | $h = "0$h" if (length($h)==1); | ||
| 2182 | 4859 | 532µs | $mn = "0$mn" if (length($mn)==1); | ||
| 2183 | 4859 | 738µs | $s = "0$s" if (length($s)==1); | ||
| 2184 | |||||
| 2185 | 4859 | 635µs | if (wantarray) { | ||
| 2186 | return (0,$y,$m,$d,$h,$mn,$s); | ||||
| 2187 | } else { | ||||
| 2188 | 4859 | 11.3ms | return "$y$m$d$h:$mn:$s"; | ||
| 2189 | } | ||||
| 2190 | } | ||||
| 2191 | |||||
| 2192 | sub _normalize_ym { | ||||
| 2193 | my($self,$y,$m) = @_; | ||||
| 2194 | 2 | 52µs | 2 | 8µs | # spent 7µs (6+1000ns) within Date::Manip::Base::BEGIN@2194 which was called:
# once (6µs+1000ns) by Date::Manip::Date::BEGIN@26 at line 2194 # spent 7µs making 1 call to Date::Manip::Base::BEGIN@2194
# spent 1µ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 | # | ||||
| 2205 | sub _normalize_mw { | ||||
| 2206 | my($self,$m,$w) = @_; | ||||
| 2207 | 2 | 44µs | 2 | 7µs | # spent 6µs (5+900ns) within Date::Manip::Base::BEGIN@2207 which was called:
# once (5µs+900ns) by Date::Manip::Date::BEGIN@26 at line 2207 # spent 6µs making 1 call to Date::Manip::Base::BEGIN@2207
# spent 900ns 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 | |||||
| 2216 | sub _normalize_bus_dhms { | ||||
| 2217 | my($self,$d,$h,$mn,$s) = @_; | ||||
| 2218 | 2 | 55µs | 2 | 5µs | # spent 4µs (4+600ns) within Date::Manip::Base::BEGIN@2218 which was called:
# once (4µs+600ns) by Date::Manip::Date::BEGIN@26 at line 2218 # spent 4µs making 1 call to Date::Manip::Base::BEGIN@2218
# spent 600ns 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 | |||||
| 2236 | sub _normalize_hms { | ||||
| 2237 | my($self,$h,$mn,$s) = @_; | ||||
| 2238 | 2 | 43µs | 2 | 6µs | # spent 6µs (5+600ns) within Date::Manip::Base::BEGIN@2238 which was called:
# once (5µs+600ns) by Date::Manip::Date::BEGIN@26 at line 2238 # spent 6µs making 1 call to Date::Manip::Base::BEGIN@2238
# spent 600ns 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 | # | ||||
| 2254 | sub _normalize_wd { | ||||
| 2255 | my($self,$w,$d,$business) = @_; | ||||
| 2256 | 2 | 40µs | 2 | 5µs | # spent 5µs (4+600ns) within Date::Manip::Base::BEGIN@2256 which was called:
# once (4µs+600ns) by Date::Manip::Date::BEGIN@26 at line 2256 # spent 5µs making 1 call to Date::Manip::Base::BEGIN@2256
# spent 600ns 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 | # | ||||
| 2270 | sub _normalize_dh { | ||||
| 2271 | my($self,$d,$h) = @_; | ||||
| 2272 | 2 | 319µs | 2 | 5µs | # spent 4µs (3+600ns) within Date::Manip::Base::BEGIN@2272 which was called:
# once (3µs+600ns) by Date::Manip::Date::BEGIN@26 at line 2272 # spent 4µs making 1 call to Date::Manip::Base::BEGIN@2272
# spent 600ns 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 | # | ||||
| 2284 | # spent 88.6ms (7.97+80.6) within Date::Manip::Base::_delta_convert which was called 2424 times, avg 37µs/call:
# 2424 times (7.97ms+80.6ms) by Date::Manip::Date::_parse_check at line 975 of Date/Manip/Date.pm, avg 37µs/call | ||||
| 2285 | 2424 | 513µs | my($self,$format,$delta)=@_; | ||
| 2286 | 2424 | 1.40ms | 2424 | 44.7ms | my $fields = $self->split($format,$delta); # spent 44.7ms making 2424 calls to Date::Manip::Base::split, avg 18µs/call |
| 2287 | 2424 | 250µs | return undef if (! defined $fields); | ||
| 2288 | 2424 | 4.52ms | 2424 | 35.9ms | return $self->join($format,$fields); # spent 35.9ms making 2424 calls to Date::Manip::Base::join, avg 15µs/call |
| 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 | # | ||||
| 2326 | sub _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 | |||||
| 2392 | # spent 21.2ms (14.1+7.12) within Date::Manip::Base::_encoding which was called 2439 times, avg 9µs/call:
# 2433 times (14.1ms+7.11ms) by Date::Manip::Date::parse at line 120 of Date/Manip/Date.pm, avg 9µs/call
# 6 times (37µs+17µs) by Date::Manip::Delta::parse at line 331 of Date/Manip/Delta.pm, avg 9µs/call | ||||
| 2393 | 2439 | 367µs | my($self,$string) = @_; | ||
| 2394 | 2439 | 213µs | my @ret; | ||
| 2395 | |||||
| 2396 | 2439 | 1.37ms | foreach my $enc (@{ $$self{'data'}{'calc'}{'enc_in'} }) { | ||
| 2397 | 4878 | 3.98ms | 2439 | 4.66ms | if (lc($enc) eq 'utf-8') { # spent 4.66ms making 2439 calls to Encode::encode_utf8, avg 2µs/call |
| 2398 | 2439 | 4.26ms | 2439 | 1.67ms | _utf8_on($string); # spent 1.67ms making 2439 calls to Encode::_utf8_on, avg 683ns/call |
| 2399 | 2439 | 3.92ms | 2439 | 801µs | push(@ret,$string) if is_utf8($string, 1); # spent 801µs making 2439 calls to Encode::is_utf8, avg 328ns/call |
| 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 | 2439 | 2.85ms | return @ret; | ||
| 2412 | } | ||||
| 2413 | |||||
| 2414 | 1 | 4µs | 1; | ||
| 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 21.4ms within Date::Manip::Base::CORE:match which was called 48944 times, avg 436ns/call:
# 21816 times (8.19ms+0s) by Date::Manip::Base::_offset_fields at line 2075, avg 375ns/call
# 9696 times (4.01ms+0s) by Date::Manip::Base::split at line 1631, avg 414ns/call
# 7308 times (1.93ms+0s) by Date::Manip::Base::split at line 1621, avg 264ns/call
# 5210 times (1.91ms+0s) by Date::Manip::Base::_offset_fields at line 2124, avg 366ns/call
# 4860 times (5.29ms+0s) by Date::Manip::Base::check_time at line 627, avg 1µs/call
# 16 times (4µs+0s) by Date::Manip::Base::_os at line 991, avg 269ns/call
# 12 times (5µs+0s) by Date::Manip::Base::_hms_fields at line 1914, avg 400ns/call
# 7 times (8µs+0s) by Date::Manip::Base::days_since_1BC at line 451, avg 1µs/call
# 6 times (7µs+0s) by Date::Manip::Base::_split_delta at line 1742, avg 1µs/call
# 6 times (6µs+0s) by Date::Manip::Base::split at line 1646, avg 933ns/call
# 3 times (2µs+0s) by Date::Manip::Base::_is_int at line 1605, avg 667ns/call
# 3 times (1µs+0s) by Date::Manip::Base::_config_var_base at line 1087, avg 400ns/call
# once (2µs+0s) by Date::Manip::Base::_config_var_recurrange at line 1218 | |||||
sub Date::Manip::Base::CORE:qr; # opcode | |||||
# spent 91µs within Date::Manip::Base::CORE:regcomp which was called 17 times, avg 5µs/call:
# 8 times (42µs+0s) by Date::Manip::Base::_rx_replace at line 1494, avg 5µs/call
# 6 times (17µs+0s) by Date::Manip::Base::_split_delta at line 1742, avg 3µs/call
# 3 times (31µs+0s) by Date::Manip::Base::_rx_replace at line 1502, avg 10µs/call | |||||
# spent 374µs within Date::Manip::Base::CORE:sort which was called 173 times, avg 2µs/call:
# 149 times (108µs+0s) by Date::Manip::Base::_rx_wordlists at line 1531, avg 722ns/call
# 13 times (256µs+0s) by Date::Manip::Base::_rx_wordlists at line 1535, avg 20µs/call
# 5 times (6µs+0s) by Date::Manip::Base::_rx_wordlist at line 1461, avg 1µs/call
# 3 times (3µs+0s) by Date::Manip::Base::_rx_replace at line 1498, avg 1µs/call
# 3 times (2µs+0s) by Date::Manip::Base::_rx_replace at line 1491, avg 500ns/call | |||||
# spent 68µs within Date::Manip::Base::CORE:subst which was called 415 times, avg 164ns/call:
# 415 times (68µs+0s) by Date::Manip::Base::_qe_quote at line 1436, avg 164ns/call | |||||
# spent 38µs within Date::Manip::Base::CORE:substcont which was called 210 times, avg 183ns/call:
# 210 times (38µs+0s) by Date::Manip::Base::_qe_quote at line 1436, avg 183ns/call |