| Filename | /home/sulbeck/local/lib/perl5/5.20.1/Date/Manip/TZ_Base.pm |
| Statements | Executed 53779 statements in 29.5ms |
| Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
|---|---|---|---|---|---|
| 2443 | 4 | 2 | 13.8ms | 20.5ms | Date::Manip::TZ_Base::_now (recurses: max depth 1, inclusive time 12µs) |
| 2430 | 1 | 1 | 10.2ms | 17.4ms | Date::Manip::TZ_Base::_fix_year |
| 2437 | 6 | 3 | 4.37ms | 4.37ms | Date::Manip::TZ_Base::_config |
| 2442 | 1 | 1 | 264µs | 264µs | Date::Manip::TZ_Base::CORE:match (opcode) |
| 14 | 14 | 1 | 39µs | 3.28ms | Date::Manip::TZ_Base::_config_var |
| 1 | 1 | 1 | 37µs | 4.35ms | Date::Manip::TZ_Base::_update_now |
| 1 | 1 | 1 | 6µs | 9µs | Date::Manip::TZ_Base::BEGIN@10 |
| 1 | 1 | 1 | 5µs | 13µs | Date::Manip::TZ_Base::BEGIN@399 |
| 1 | 1 | 1 | 4µs | 68µs | Date::Manip::TZ_Base::BEGIN@12 |
| 1 | 1 | 1 | 4µs | 8µs | Date::Manip::TZ_Base::BEGIN@403 |
| 1 | 1 | 1 | 3µs | 9µs | Date::Manip::TZ_Base::BEGIN@11 |
| 1 | 1 | 1 | 1µs | 1µs | Date::Manip::TZ_Base::END |
| 0 | 0 | 0 | 0s | 0s | Date::Manip::TZ_Base::_config_file |
| 0 | 0 | 0 | 0s | 0s | Date::Manip::TZ_Base::_config_file_section |
| 0 | 0 | 0 | 0s | 0s | Date::Manip::TZ_Base::_config_file_var |
| 0 | 0 | 0 | 0s | 0s | Date::Manip::TZ_Base::_sortByLength |
| Line | State ments |
Time on line |
Calls | Time in subs |
Code |
|---|---|---|---|---|---|
| 1 | package Date::Manip::TZ_Base; | ||||
| 2 | # Copyright (c) 2010-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 | ######################################################################## | ||||
| 8 | |||||
| 9 | 1 | 5µs | require 5.010000; | ||
| 10 | 2 | 11µs | 2 | 12µs | # spent 9µs (6+3) within Date::Manip::TZ_Base::BEGIN@10 which was called:
# once (6µs+3µs) by Date::Manip::Base::BEGIN@15 at line 10 # spent 9µs making 1 call to Date::Manip::TZ_Base::BEGIN@10
# spent 3µs making 1 call to warnings::import |
| 11 | 2 | 11µs | 2 | 16µs | # spent 9µs (3+7) within Date::Manip::TZ_Base::BEGIN@11 which was called:
# once (3µs+7µs) by Date::Manip::Base::BEGIN@15 at line 11 # spent 9µs making 1 call to Date::Manip::TZ_Base::BEGIN@11
# spent 6µs making 1 call to strict::import |
| 12 | 2 | 859µs | 2 | 131µs | # spent 68µs (4+64) within Date::Manip::TZ_Base::BEGIN@12 which was called:
# once (4µs+64µs) by Date::Manip::Base::BEGIN@15 at line 12 # spent 68µs making 1 call to Date::Manip::TZ_Base::BEGIN@12
# spent 64µs making 1 call to Exporter::import |
| 13 | |||||
| 14 | 1 | 100ns | our ($VERSION); | ||
| 15 | 1 | 200ns | $VERSION='6.49'; | ||
| 16 | 1 | 2µs | # spent 1µs within Date::Manip::TZ_Base::END which was called:
# once (1µs+0s) by main::RUNTIME at line 0 of ../dm5dm6_ex3 | ||
| 17 | |||||
| 18 | ######################################################################## | ||||
| 19 | # METHODS | ||||
| 20 | ######################################################################## | ||||
| 21 | |||||
| 22 | # spent 3.28ms (39µs+3.24) within Date::Manip::TZ_Base::_config_var which was called 14 times, avg 234µs/call:
# once (3µs+3.00ms) by Date::Manip::Base::_init_config at line 201 of Date/Manip/Base.pm
# once (3µs+77µs) by Date::Manip::Base::_init_config at line 190 of Date/Manip/Base.pm
# once (9µs+41µs) by Date::Manip::Base::_init_config at line 191 of Date/Manip/Base.pm
# once (5µs+31µs) by Date::Manip::Base::_init_config at line 189 of Date/Manip/Base.pm
# once (2µs+23µs) by Date::Manip::Base::_init_config at line 199 of Date/Manip/Base.pm
# once (2µs+20µs) by Date::Manip::Base::_init_config at line 200 of Date/Manip/Base.pm
# once (2µs+12µs) by Date::Manip::Base::_init_config at line 198 of Date/Manip/Base.pm
# once (3µs+11µs) by Date::Manip::Base::_init_config at line 202 of Date/Manip/Base.pm
# once (2µs+7µs) by Date::Manip::Base::_init_config at line 195 of Date/Manip/Base.pm
# once (2µs+7µs) by Date::Manip::Base::_init_config at line 203 of Date/Manip/Base.pm
# once (3µs+4µs) by Date::Manip::Base::_init_config at line 192 of Date/Manip/Base.pm
# once (2µs+3µs) by Date::Manip::Base::_init_config at line 194 of Date/Manip/Base.pm
# once (2µs+2µs) by Date::Manip::Base::_init_config at line 196 of Date/Manip/Base.pm
# once (2µs+2µs) by Date::Manip::Base::_init_config at line 197 of Date/Manip/Base.pm | ||||
| 23 | 14 | 3µs | my($self,$var,$val) = @_; | ||
| 24 | 14 | 2µs | $var = lc($var); | ||
| 25 | |||||
| 26 | # A simple flag used to force a new configuration, but has | ||||
| 27 | # no other affect. | ||||
| 28 | 14 | 2µs | return if ($var eq 'ignore'); | ||
| 29 | |||||
| 30 | 14 | 3µs | my $istz = ref($self) eq 'Date::Manip::TZ'; | ||
| 31 | |||||
| 32 | 14 | 2µs | if ($istz && ($var eq 'tz' || | ||
| 33 | $var eq 'forcedate' || | ||||
| 34 | $var eq 'setdate' || | ||||
| 35 | $var eq 'configfile')) { | ||||
| 36 | return $self->_config_var_tz($var,$val); | ||||
| 37 | } else { | ||||
| 38 | 14 | 1µs | my $base = ($istz ? $$self{'base'} : $self); | ||
| 39 | 14 | 25µs | 14 | 3.24ms | return $base->_config_var_base($var,$val); # spent 3.24ms making 14 calls to Date::Manip::Base::_config_var_base, avg 232µs/call |
| 40 | } | ||||
| 41 | } | ||||
| 42 | |||||
| 43 | # This reads a config file | ||||
| 44 | # | ||||
| 45 | sub _config_file { | ||||
| 46 | my($self,$file) = @_; | ||||
| 47 | |||||
| 48 | return if (! $file); | ||||
| 49 | |||||
| 50 | if (! -f $file) { | ||||
| 51 | warn "ERROR: [config_file] file doesn't exist: $file\n"; | ||||
| 52 | return; | ||||
| 53 | } | ||||
| 54 | if (! -r $file) { | ||||
| 55 | warn "ERROR: [config_file] file not readable: $file\n"; | ||||
| 56 | return; | ||||
| 57 | } | ||||
| 58 | |||||
| 59 | my $in = new IO::File; | ||||
| 60 | if (! $in->open($file)) { | ||||
| 61 | warn "ERROR: [config_file] unable to open file: $file: $!\n"; | ||||
| 62 | return; | ||||
| 63 | } | ||||
| 64 | my @in = <$in>; | ||||
| 65 | $in->close(); | ||||
| 66 | |||||
| 67 | my $sect = 'conf'; | ||||
| 68 | my %sect; | ||||
| 69 | |||||
| 70 | chomp(@in); | ||||
| 71 | foreach my $line (@in) { | ||||
| 72 | $line =~ s/^\s+//o; | ||||
| 73 | $line =~ s/\s+$//o; | ||||
| 74 | next if (! $line or $line =~ /^\043/o); | ||||
| 75 | |||||
| 76 | if ($line =~ /^\*/o) { | ||||
| 77 | # New section | ||||
| 78 | $sect = $self->_config_file_section($line); | ||||
| 79 | } else { | ||||
| 80 | $sect{$sect} = 1; | ||||
| 81 | $self->_config_file_var($sect,$line); | ||||
| 82 | } | ||||
| 83 | } | ||||
| 84 | |||||
| 85 | # If we did a holidays section, we need to create a regular | ||||
| 86 | # expression with all of the holiday names. | ||||
| 87 | |||||
| 88 | my $istz = ref($self) eq 'Date::Manip::TZ'; | ||||
| 89 | my $base = ($istz ? $$self{'base'} : $self); | ||||
| 90 | |||||
| 91 | if (exists $sect{'holidays'}) { | ||||
| 92 | my @hol = @{ $$base{'data'}{'sections'}{'holidays'} }; | ||||
| 93 | my @nam; | ||||
| 94 | while (@hol) { | ||||
| 95 | my $junk = shift(@hol); | ||||
| 96 | my $hol = shift(@hol); | ||||
| 97 | push(@nam,$hol) if ($hol); | ||||
| 98 | } | ||||
| 99 | |||||
| 100 | if (@nam) { | ||||
| 101 | @nam = sort _sortByLength(@nam); | ||||
| 102 | my $hol = '(?<holiday>' . join('|',map { "\Q$_\E" } @nam) . ')'; | ||||
| 103 | my $yr = '(?<y>\d\d\d\d|\d\d)'; | ||||
| 104 | |||||
| 105 | my $rx = "$hol\\s*$yr|" . # Christmas 2009 | ||||
| 106 | "$yr\\s*$hol|" . # 2009 Christmas | ||||
| 107 | "$hol"; # Christmas | ||||
| 108 | |||||
| 109 | $$base{'data'}{'rx'}{'holidays'} = qr/^(?:$rx)$/i; | ||||
| 110 | } | ||||
| 111 | } | ||||
| 112 | } | ||||
| 113 | |||||
| 114 | sub _config_file_section { | ||||
| 115 | my($self,$line) = @_; | ||||
| 116 | |||||
| 117 | my $istz = ref($self) eq 'Date::Manip::TZ'; | ||||
| 118 | my $base = ($istz ? $$self{'base'} : $self); | ||||
| 119 | |||||
| 120 | $line =~ s/^\*//o; | ||||
| 121 | $line =~ s/\s*$//o; | ||||
| 122 | my $sect = lc($line); | ||||
| 123 | if (! exists $$base{'data'}{'sections'}{$sect}) { | ||||
| 124 | warn "WARNING: [config_file] unknown section created: $sect\n"; | ||||
| 125 | $base->_section($sect); | ||||
| 126 | } | ||||
| 127 | return $sect; | ||||
| 128 | } | ||||
| 129 | |||||
| 130 | sub _config_file_var { | ||||
| 131 | my($self,$sect,$line) = @_; | ||||
| 132 | |||||
| 133 | my $istz = ref($self) eq 'Date::Manip::TZ'; | ||||
| 134 | my $base = ($istz ? $$self{'base'} : $self); | ||||
| 135 | |||||
| 136 | my($var,$val); | ||||
| 137 | if ($line =~ /^\s*(.*?)\s*=\s*(.*?)\s*$/o) { | ||||
| 138 | ($var,$val) = ($1,$2); | ||||
| 139 | } else { | ||||
| 140 | die "ERROR: invalid Date::Manip config file line:\n $line\n"; | ||||
| 141 | } | ||||
| 142 | |||||
| 143 | if ($sect eq 'conf') { | ||||
| 144 | $var = lc($var); | ||||
| 145 | $self->_config($var,$val); | ||||
| 146 | } else { | ||||
| 147 | $base->_section($sect,$var,$val); | ||||
| 148 | } | ||||
| 149 | } | ||||
| 150 | |||||
| 151 | # $val = $self->config(VAR); | ||||
| 152 | # Returns the value of a variable. | ||||
| 153 | # | ||||
| 154 | # $self->config([SECT], VAR, VAL) sets the value of a variable | ||||
| 155 | # Sets the value of a variable. | ||||
| 156 | # | ||||
| 157 | # spent 4.37ms within Date::Manip::TZ_Base::_config which was called 2437 times, avg 2µs/call:
# 2430 times (4.35ms+0s) by Date::Manip::TZ_Base::_fix_year at line 190, avg 2µs/call
# 2 times (7µs+0s) by Date::Manip::Base::_calc_workweek at line 213 of Date/Manip/Base.pm, avg 4µs/call
# 2 times (2µs+0s) by Date::Manip::Base::_calc_workweek at line 214 of Date/Manip/Base.pm, avg 1µs/call
# once (6µs+0s) by Date::Manip::Date::_other_rx at line 1338 of Date/Manip/Date.pm
# once (2µs+0s) by Date::Manip::Base::_config_var_workweekbeg at line 1233 of Date/Manip/Base.pm
# once (1µs+0s) by Date::Manip::Base::_config_var_workweekend at line 1250 of Date/Manip/Base.pm | ||||
| 158 | 2437 | 529µs | my($self,$var,$val) = @_; | ||
| 159 | |||||
| 160 | 2437 | 290µs | my $sect = 'conf'; | ||
| 161 | |||||
| 162 | # | ||||
| 163 | # $self->_conf(VAR, VAL) sets the value of a variable | ||||
| 164 | # | ||||
| 165 | |||||
| 166 | 2437 | 513µs | $var = lc($var); | ||
| 167 | 2437 | 260µs | if (defined $val) { | ||
| 168 | return $self->_config_var($var,$val); | ||||
| 169 | } | ||||
| 170 | |||||
| 171 | # | ||||
| 172 | # $self->_conf(VAR) returns the value of a variable | ||||
| 173 | # | ||||
| 174 | |||||
| 175 | 2437 | 4.30ms | if (exists $$self{'data'}{'sections'}{$sect}{$var}) { | ||
| 176 | return $$self{'data'}{'sections'}{$sect}{$var}; | ||||
| 177 | } else { | ||||
| 178 | warn "ERROR: [config] invalid config variable: $var\n"; | ||||
| 179 | return ''; | ||||
| 180 | } | ||||
| 181 | } | ||||
| 182 | |||||
| 183 | ######################################################################## | ||||
| 184 | |||||
| 185 | # spent 17.4ms (10.2+7.21) within Date::Manip::TZ_Base::_fix_year which was called 2430 times, avg 7µs/call:
# 2430 times (10.2ms+7.21ms) by Date::Manip::Date::_def_date at line 2157 of Date/Manip/Date.pm, avg 7µs/call | ||||
| 186 | 2430 | 425µs | my($self,$y) = @_; | ||
| 187 | 2430 | 887µs | my $istz = ref($self) eq 'Date::Manip::TZ'; | ||
| 188 | 2430 | 1.61ms | 2430 | 2.85ms | my $base = ($istz ? $self->base() : $self); # spent 2.85ms making 2430 calls to Date::Manip::Obj::base, avg 1µs/call |
| 189 | |||||
| 190 | 2430 | 1.78ms | 2430 | 4.35ms | my $method = $base->_config('yytoyyyy'); # spent 4.35ms making 2430 calls to Date::Manip::TZ_Base::_config, avg 2µs/call |
| 191 | |||||
| 192 | 2430 | 3.81ms | return $y if (length($y)==4); | ||
| 193 | return undef if (length($y)!=2); | ||||
| 194 | |||||
| 195 | my $curr_y; | ||||
| 196 | if (ref($self) eq 'Date::Manip::TZ') { | ||||
| 197 | $curr_y = $self->_now('y',1); | ||||
| 198 | } else { | ||||
| 199 | $curr_y = ( localtime(time) )[5]; | ||||
| 200 | $curr_y += 1900; | ||||
| 201 | } | ||||
| 202 | |||||
| 203 | if ($method eq 'c') { | ||||
| 204 | return substr($curr_y,0,2) . $y; | ||||
| 205 | |||||
| 206 | } elsif ($method =~ /^c(\d\d)$/) { | ||||
| 207 | return "$1$y"; | ||||
| 208 | |||||
| 209 | } elsif ($method =~ /^c(\d\d)(\d\d)$/) { | ||||
| 210 | return "$1$y" + ($y<$2 ? 100 : 0); | ||||
| 211 | |||||
| 212 | } else { | ||||
| 213 | my $y1 = $curr_y - $method; | ||||
| 214 | my $y2 = $y1 + 99; | ||||
| 215 | $y1 =~ /^(\d\d)/; | ||||
| 216 | $y = "$1$y"; | ||||
| 217 | if ($y<$y1) { | ||||
| 218 | $y += 100; | ||||
| 219 | } | ||||
| 220 | if ($y>$y2) { | ||||
| 221 | $y -= 100; | ||||
| 222 | } | ||||
| 223 | return $y; | ||||
| 224 | } | ||||
| 225 | } | ||||
| 226 | |||||
| 227 | ############################################################################### | ||||
| 228 | # Functions for setting the default date/time | ||||
| 229 | |||||
| 230 | # Many date operations use a default time and/or date to set some | ||||
| 231 | # or all values. This function may be used to set or examine the | ||||
| 232 | # default time. | ||||
| 233 | # | ||||
| 234 | # _now allows you to get the current date and/or time in the | ||||
| 235 | # local timezone. | ||||
| 236 | # | ||||
| 237 | # The function performed depends on $op and are described in the | ||||
| 238 | # following table: | ||||
| 239 | # | ||||
| 240 | # $op function | ||||
| 241 | # ------------------ ---------------------------------- | ||||
| 242 | # undef Returns the current default values | ||||
| 243 | # (y,m,d,h,mn,s) without updating | ||||
| 244 | # the time (it'll update if it has | ||||
| 245 | # never been set). | ||||
| 246 | # | ||||
| 247 | # 'now' Updates now and returns | ||||
| 248 | # (y,m,d,h,mn,s) | ||||
| 249 | # | ||||
| 250 | # 'time' Updates now and Returns (h,mn,s) | ||||
| 251 | # | ||||
| 252 | # 'y' Returns the default value of one | ||||
| 253 | # 'm' of the fields (no update) | ||||
| 254 | # 'd' | ||||
| 255 | # 'h' | ||||
| 256 | # 'mn' | ||||
| 257 | # 's' | ||||
| 258 | # | ||||
| 259 | # 'systz' Returns the system timezone | ||||
| 260 | # | ||||
| 261 | # 'isdst' Returns the 'now' values if set, | ||||
| 262 | # 'tz' or system time values otherwise. | ||||
| 263 | # 'offset' | ||||
| 264 | # 'abb' | ||||
| 265 | # | ||||
| 266 | # spent 20.5ms (13.8+6.66) within Date::Manip::TZ_Base::_now which was called 2443 times, avg 8µs/call:
# 2430 times (13.8ms+6.66ms) by Date::Manip::Date::_parse_check at line 1019 of Date/Manip/Date.pm, avg 8µs/call
# 6 times (38µs+7µs) by Date::Manip::Date::_parse_delta at line 1813 of Date/Manip/Date.pm, avg 8µs/call
# 6 times (34µs+7µs) by Date::Manip::Date::_parse_delta at line 1814 of Date/Manip/Date.pm, avg 7µs/call
# once (11µs+-11µs) by Date::Manip::TZ_Base::_update_now at line 386 | ||||
| 267 | 2443 | 486µs | my($self,$op,$noupdate) = @_; | ||
| 268 | 2443 | 676µs | my $istz = ref($self) eq 'Date::Manip::TZ'; | ||
| 269 | 2443 | 1.36ms | 2443 | 2.06ms | my $base = ($istz ? $self->base() : $self); # spent 2.06ms making 2443 calls to Date::Manip::Obj::base, avg 842ns/call |
| 270 | |||||
| 271 | # Update "NOW" if we're checking 'now', 'time', or the date | ||||
| 272 | # is not set already. | ||||
| 273 | |||||
| 274 | 2443 | 476µs | if (! defined $noupdate) { | ||
| 275 | 2442 | 2.60ms | 2442 | 264µs | if ($op =~ /(?:now|time)/) { # spent 264µs making 2442 calls to Date::Manip::TZ_Base::CORE:match, avg 108ns/call |
| 276 | $noupdate = 0; | ||||
| 277 | } else { | ||||
| 278 | 2442 | 330µs | $noupdate = 1; | ||
| 279 | } | ||||
| 280 | } | ||||
| 281 | 2443 | 780µs | $noupdate = 0 if (! exists $$base{'data'}{'now'}{'date'}); | ||
| 282 | 2443 | 180µs | 1 | 4.35ms | $self->_update_now() unless ($noupdate); # spent 4.35ms making 1 call to Date::Manip::TZ_Base::_update_now |
| 283 | |||||
| 284 | # Now return the value of the operation | ||||
| 285 | |||||
| 286 | 2443 | 953µs | my @tmpnow = @{ $$base{'data'}{'tmpnow'} }; | ||
| 287 | 2443 | 1.72ms | my @now = (@tmpnow ? @tmpnow : @{ $$base{'data'}{'now'}{'date'} }); | ||
| 288 | |||||
| 289 | 2443 | 941µs | if ($op eq 'tz') { | ||
| 290 | if (exists $$base{'data'}{'now'}{'tz'}) { | ||||
| 291 | return $$base{'data'}{'now'}{'tz'}; | ||||
| 292 | } else { | ||||
| 293 | 2437 | 3.63ms | return $$base{'data'}{'now'}{'systz'}; | ||
| 294 | } | ||||
| 295 | |||||
| 296 | } elsif ($op eq 'systz') { | ||||
| 297 | return $$base{'data'}{'now'}{'systz'}; | ||||
| 298 | |||||
| 299 | } elsif ($op eq 'isdst') { | ||||
| 300 | return $$base{'data'}{'now'}{'isdst'}; | ||||
| 301 | |||||
| 302 | } elsif ($op eq 'offset') { | ||||
| 303 | return @{ $$base{'data'}{'now'}{'offset'} }; | ||||
| 304 | |||||
| 305 | } elsif ($op eq 'abb') { | ||||
| 306 | return $$base{'data'}{'now'}{'abb'}; | ||||
| 307 | |||||
| 308 | } elsif ($op eq 'now') { | ||||
| 309 | return @now; | ||||
| 310 | |||||
| 311 | } elsif ($op eq 'y') { | ||||
| 312 | return $now[0]; | ||||
| 313 | |||||
| 314 | } elsif ($op eq 'time') { | ||||
| 315 | return @now[3..5]; | ||||
| 316 | |||||
| 317 | } elsif ($op eq 'm') { | ||||
| 318 | return $now[1]; | ||||
| 319 | |||||
| 320 | } elsif ($op eq 'd') { | ||||
| 321 | return $now[2]; | ||||
| 322 | |||||
| 323 | } elsif ($op eq 'h') { | ||||
| 324 | return $now[3]; | ||||
| 325 | |||||
| 326 | } elsif ($op eq 'mn') { | ||||
| 327 | return $now[4]; | ||||
| 328 | |||||
| 329 | } elsif ($op eq 's') { | ||||
| 330 | return $now[5]; | ||||
| 331 | |||||
| 332 | } else { | ||||
| 333 | warn "ERROR: [now] invalid argument list: $op\n"; | ||||
| 334 | return (); | ||||
| 335 | } | ||||
| 336 | } | ||||
| 337 | |||||
| 338 | # spent 4.35ms (37µs+4.31) within Date::Manip::TZ_Base::_update_now which was called:
# once (37µs+4.31ms) by Date::Manip::TZ_Base::_now at line 282 | ||||
| 339 | 1 | 400ns | my($self) = @_; | ||
| 340 | 1 | 600ns | my $istz = ref($self) eq 'Date::Manip::TZ'; | ||
| 341 | 1 | 800ns | 1 | 500ns | my $base = ($istz ? $self->base() : $self); # spent 500ns making 1 call to Date::Manip::Obj::base |
| 342 | |||||
| 343 | # If we've called ForceDate, don't change it. | ||||
| 344 | 1 | 800ns | return if ($$base{'data'}{'now'}{'force'}); | ||
| 345 | |||||
| 346 | # If we've called SetDate (which will only happen if a | ||||
| 347 | # Date::Manip:TZ object is available), figure out what 'now' is | ||||
| 348 | # based on the number of seconds that have elapsed since it was | ||||
| 349 | # set. This will ONLY happen if TZ has been loaded. | ||||
| 350 | |||||
| 351 | 1 | 800ns | if ($$base{'data'}{'now'}{'set'}) { | ||
| 352 | my $date = $$base{'data'}{'now'}{'setdate'}; | ||||
| 353 | my $secs = time - $$base{'data'}{'now'}{'setsecs'}; | ||||
| 354 | |||||
| 355 | $date = $base->calc_date_time($date,[0,0,$secs]); # 'now' in GMT | ||||
| 356 | my $zone = $self->_now('tz',1); | ||||
| 357 | my ($err,$date2,$offset,$isdst,$abbrev) = $self->convert_from_gmt($date,$zone); | ||||
| 358 | |||||
| 359 | $$base{'data'}{'now'}{'date'} = $date2; | ||||
| 360 | $$base{'data'}{'now'}{'isdst'} = $isdst; | ||||
| 361 | $$base{'data'}{'now'}{'offset'} = $offset; | ||||
| 362 | $$base{'data'}{'now'}{'abb'} = $abbrev; | ||||
| 363 | return; | ||||
| 364 | } | ||||
| 365 | |||||
| 366 | # Otherwise, we'll use the system time. | ||||
| 367 | |||||
| 368 | 1 | 900ns | my $time = time; | ||
| 369 | 1 | 12µs | my($s,$mn,$h,$d,$m,$y,$wday,$yday,$isdst) = localtime($time); | ||
| 370 | 1 | 1µs | my($s0,$mn0,$h0,$d0,$m0,$y0) = gmtime($time); | ||
| 371 | |||||
| 372 | 1 | 900ns | $y += 1900; | ||
| 373 | 1 | 300ns | $m++; | ||
| 374 | |||||
| 375 | 1 | 200ns | $y0 += 1900; | ||
| 376 | 1 | 100ns | $m0++; | ||
| 377 | |||||
| 378 | 1 | 4µs | 1 | 21µs | my $off = $base->calc_date_date([$y,$m,$d,$h,$mn,$s],[$y0,$m0,$d0,$h0,$mn0,$s0],1); # spent 21µs making 1 call to Date::Manip::Base::calc_date_date |
| 379 | |||||
| 380 | 1 | 1µs | $$base{'data'}{'now'}{'date'} = [$y,$m,$d,$h,$mn,$s]; | ||
| 381 | 1 | 700ns | $$base{'data'}{'now'}{'isdst'} = $isdst; | ||
| 382 | 1 | 700ns | $$base{'data'}{'now'}{'offset'}= $off; | ||
| 383 | |||||
| 384 | 1 | 300ns | my $abb = '???'; | ||
| 385 | 1 | 500ns | if (ref($self) eq 'Date::Manip::TZ') { | ||
| 386 | 1 | 3µs | 1 | 0s | my $zone = $self->_now('tz',1); # spent 12µs making 1 call to Date::Manip::TZ_Base::_now, recursion: max depth 1, sum of overlapping time 12µs |
| 387 | 1 | 2µs | 1 | 4.28ms | my $per = $self->date_period([$y,$m,$d,$h,$mn,$s],$zone,1,$isdst); # spent 4.28ms making 1 call to Date::Manip::TZ::date_period |
| 388 | 1 | 900ns | $abb = $$per[4]; | ||
| 389 | } | ||||
| 390 | |||||
| 391 | 1 | 800ns | $$base{'data'}{'now'}{'abb'} = $abb; | ||
| 392 | |||||
| 393 | 1 | 2µs | return; | ||
| 394 | } | ||||
| 395 | |||||
| 396 | ############################################################################### | ||||
| 397 | # This sorts from longest to shortest element | ||||
| 398 | # | ||||
| 399 | 2 | 28µs | 2 | 21µs | # spent 13µs (5+8) within Date::Manip::TZ_Base::BEGIN@399 which was called:
# once (5µs+8µs) by Date::Manip::Base::BEGIN@15 at line 399 # spent 13µs making 1 call to Date::Manip::TZ_Base::BEGIN@399
# spent 8µs making 1 call to strict::unimport |
| 400 | sub _sortByLength { | ||||
| 401 | return (length $b <=> length $a); | ||||
| 402 | } | ||||
| 403 | 2 | 17µs | 2 | 13µs | # spent 8µs (4+5) within Date::Manip::TZ_Base::BEGIN@403 which was called:
# once (4µs+5µs) by Date::Manip::Base::BEGIN@15 at line 403 # spent 8µs making 1 call to Date::Manip::TZ_Base::BEGIN@403
# spent 5µs making 1 call to strict::import |
| 404 | |||||
| 405 | 1 | 2µs | 1; | ||
| 406 | # Local Variables: | ||||
| 407 | # mode: cperl | ||||
| 408 | # indent-tabs-mode: nil | ||||
| 409 | # cperl-indent-level: 3 | ||||
| 410 | # cperl-continued-statement-offset: 2 | ||||
| 411 | # cperl-continued-brace-offset: 0 | ||||
| 412 | # cperl-brace-offset: 0 | ||||
| 413 | # cperl-brace-imaginary-offset: 0 | ||||
| 414 | # cperl-label-offset: 0 | ||||
| 415 | # End: | ||||
# spent 264µs within Date::Manip::TZ_Base::CORE:match which was called 2442 times, avg 108ns/call:
# 2442 times (264µs+0s) by Date::Manip::TZ_Base::_now at line 275, avg 108ns/call |