← Index
NYTProf Performance Profile   « line view »
For ../dm5dm6_ex3
  Run on Mon Feb 23 08:36:56 2015
Reported on Mon Feb 23 08:37:02 2015

Filename/home/sulbeck/local/lib/perl5/5.20.1/Date/Manip/TZ_Base.pm
StatementsExecuted 53779 statements in 29.5ms
Subroutines
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
24434213.8ms20.5msDate::Manip::TZ_Base::::_nowDate::Manip::TZ_Base::_now (recurses: max depth 1, inclusive time 12µs)
24301110.2ms17.4msDate::Manip::TZ_Base::::_fix_yearDate::Manip::TZ_Base::_fix_year
2437634.37ms4.37msDate::Manip::TZ_Base::::_configDate::Manip::TZ_Base::_config
244211264µs264µsDate::Manip::TZ_Base::::CORE:matchDate::Manip::TZ_Base::CORE:match (opcode)
1414139µs3.28msDate::Manip::TZ_Base::::_config_varDate::Manip::TZ_Base::_config_var
11137µs4.35msDate::Manip::TZ_Base::::_update_nowDate::Manip::TZ_Base::_update_now
1116µs9µsDate::Manip::TZ_Base::::BEGIN@10Date::Manip::TZ_Base::BEGIN@10
1115µs13µsDate::Manip::TZ_Base::::BEGIN@399Date::Manip::TZ_Base::BEGIN@399
1114µs68µsDate::Manip::TZ_Base::::BEGIN@12Date::Manip::TZ_Base::BEGIN@12
1114µs8µsDate::Manip::TZ_Base::::BEGIN@403Date::Manip::TZ_Base::BEGIN@403
1113µs9µsDate::Manip::TZ_Base::::BEGIN@11Date::Manip::TZ_Base::BEGIN@11
1111µs1µsDate::Manip::TZ_Base::::ENDDate::Manip::TZ_Base::END
0000s0sDate::Manip::TZ_Base::::_config_fileDate::Manip::TZ_Base::_config_file
0000s0sDate::Manip::TZ_Base::::_config_file_sectionDate::Manip::TZ_Base::_config_file_section
0000s0sDate::Manip::TZ_Base::::_config_file_varDate::Manip::TZ_Base::_config_file_var
0000s0sDate::Manip::TZ_Base::::_sortByLengthDate::Manip::TZ_Base::_sortByLength
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments
Time
on line
Calls Time
in subs
Code
1package Date::Manip::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
915µsrequire 5.010000;
10211µs212µ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
use warnings;
# spent 9µs making 1 call to Date::Manip::TZ_Base::BEGIN@10 # spent 3µs making 1 call to warnings::import
11211µs216µ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
use strict;
# spent 9µs making 1 call to Date::Manip::TZ_Base::BEGIN@11 # spent 6µs making 1 call to strict::import
122859µs2131µ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
use IO::File;
# spent 68µs making 1 call to Date::Manip::TZ_Base::BEGIN@12 # spent 64µs making 1 call to Exporter::import
13
141100nsour ($VERSION);
151200ns$VERSION='6.49';
1612µ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
END { undef $VERSION; }
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
sub _config_var {
23143µs my($self,$var,$val) = @_;
24142µs $var = lc($var);
25
26 # A simple flag used to force a new configuration, but has
27 # no other affect.
28142µs return if ($var eq 'ignore');
29
30143µs my $istz = ref($self) eq 'Date::Manip::TZ';
31
32142µ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 {
38141µs my $base = ($istz ? $$self{'base'} : $self);
391425µs143.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#
45sub _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
114sub _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
130sub _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
sub _config {
1582437529µs my($self,$var,$val) = @_;
159
1602437290µs my $sect = 'conf';
161
162 #
163 # $self->_conf(VAR, VAL) sets the value of a variable
164 #
165
1662437513µs $var = lc($var);
1672437260µ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
17524374.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
sub _fix_year {
1862430425µs my($self,$y) = @_;
1872430887µs my $istz = ref($self) eq 'Date::Manip::TZ';
18824301.61ms24302.85ms my $base = ($istz ? $self->base() : $self);
# spent 2.85ms making 2430 calls to Date::Manip::Obj::base, avg 1µs/call
189
19024301.78ms24304.35ms my $method = $base->_config('yytoyyyy');
# spent 4.35ms making 2430 calls to Date::Manip::TZ_Base::_config, avg 2µs/call
191
19224303.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
sub _now {
2672443486µs my($self,$op,$noupdate) = @_;
2682443676µs my $istz = ref($self) eq 'Date::Manip::TZ';
26924431.36ms24432.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
2742443476µs if (! defined $noupdate) {
27524422.60ms2442264µ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 {
2782442330µs $noupdate = 1;
279 }
280 }
2812443780µs $noupdate = 0 if (! exists $$base{'data'}{'now'}{'date'});
2822443180µs14.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
2862443953µs my @tmpnow = @{ $$base{'data'}{'tmpnow'} };
28724431.72ms my @now = (@tmpnow ? @tmpnow : @{ $$base{'data'}{'now'}{'date'} });
288
2892443941µs if ($op eq 'tz') {
290 if (exists $$base{'data'}{'now'}{'tz'}) {
291 return $$base{'data'}{'now'}{'tz'};
292 } else {
29324373.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
sub _update_now {
3391400ns my($self) = @_;
3401600ns my $istz = ref($self) eq 'Date::Manip::TZ';
3411800ns1500ns 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.
3441800ns 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
3511800ns 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
3681900ns my $time = time;
369112µs my($s,$mn,$h,$d,$m,$y,$wday,$yday,$isdst) = localtime($time);
37011µs my($s0,$mn0,$h0,$d0,$m0,$y0) = gmtime($time);
371
3721900ns $y += 1900;
3731300ns $m++;
374
3751200ns $y0 += 1900;
3761100ns $m0++;
377
37814µs121µ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
38011µs $$base{'data'}{'now'}{'date'} = [$y,$m,$d,$h,$mn,$s];
3811700ns $$base{'data'}{'now'}{'isdst'} = $isdst;
3821700ns $$base{'data'}{'now'}{'offset'}= $off;
383
3841300ns my $abb = '???';
3851500ns if (ref($self) eq 'Date::Manip::TZ') {
38613µs10s 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
38712µs14.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
3881900ns $abb = $$per[4];
389 }
390
3911800ns $$base{'data'}{'now'}{'abb'} = $abb;
392
39312µs return;
394}
395
396###############################################################################
397# This sorts from longest to shortest element
398#
399228µs221µ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
no strict 'vars';
# spent 13µs making 1 call to Date::Manip::TZ_Base::BEGIN@399 # spent 8µs making 1 call to strict::unimport
400sub _sortByLength {
401 return (length $b <=> length $a);
402}
403217µs213µ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
use strict 'vars';
# spent 8µs making 1 call to Date::Manip::TZ_Base::BEGIN@403 # spent 5µs making 1 call to strict::import
404
40512µs1;
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
sub Date::Manip::TZ_Base::CORE:match; # opcode