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