← Index
NYTProf Performance Profile   « line view »
For ../dm5dm6_ex3
  Run on Tue Feb 24 07:41:47 2015
Reported on Tue Feb 24 07:41:51 2015

Filename/home/sulbeck/local/lib/perl5/5.20.1/Date/Manip/TZ_Base.pm
StatementsExecuted 24619 statements in 17.1ms
Subroutines
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
24301111.2ms19.0msDate::Manip::TZ_Base::::_fix_yearDate::Manip::TZ_Base::_fix_year
2437634.62ms4.62msDate::Manip::TZ_Base::::_configDate::Manip::TZ_Base::_config
1332148µs318µsDate::Manip::TZ_Base::::_nowDate::Manip::TZ_Base::_now (recurses: max depth 1, inclusive time 11µs)
11168µs153µsDate::Manip::TZ_Base::::_update_nowDate::Manip::TZ_Base::_update_now
1414135µs3.34msDate::Manip::TZ_Base::::_config_varDate::Manip::TZ_Base::_config_var
121116µs16µsDate::Manip::TZ_Base::::CORE:matchDate::Manip::TZ_Base::CORE:match (opcode)
11114µs22µsDate::Manip::TZ_Base::::BEGIN@404Date::Manip::TZ_Base::BEGIN@404
1116µs9µsDate::Manip::TZ_Base::::BEGIN@10Date::Manip::TZ_Base::BEGIN@10
1114µs9µsDate::Manip::TZ_Base::::BEGIN@408Date::Manip::TZ_Base::BEGIN@408
1114µs68µsDate::Manip::TZ_Base::::BEGIN@12Date::Manip::TZ_Base::BEGIN@12
1113µs10µsDate::Manip::TZ_Base::::BEGIN@11Date::Manip::TZ_Base::BEGIN@11
1112µs2µ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;
10210µ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 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
use strict;
# spent 10µs making 1 call to Date::Manip::TZ_Base::BEGIN@11 # spent 7µs making 1 call to strict::import
122872µs2132µ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
1410sour ($VERSION);
151200ns$VERSION='6.49';
1612µ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
END { undef $VERSION; }
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
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 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 {
43142µs my $base = ($istz ? $$self{'base'} : $self);
441429µs143.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#
50sub _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
119sub _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
135sub _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
sub _config {
1632437563µs my($self,$var,$val) = @_;
164
1652437311µs my $sect = 'conf';
166
167 #
168 # $self->_conf(VAR, VAL) sets the value of a variable
169 #
170
1712437505µs $var = lc($var);
1722437302µ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
18024374.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
sub _fix_year {
1912430460µs my($self,$y) = @_;
1922430976µs my $istz = ref($self) eq 'Date::Manip::TZ';
19324302.24ms24303.16ms my $base = ($istz ? $self->base() : $self);
# spent 3.16ms making 2430 calls to Date::Manip::Obj::base, avg 1µs/call
194
19524301.87ms24304.60ms my $method = $base->_config('yytoyyyy');
# spent 4.60ms making 2430 calls to Date::Manip::TZ_Base::_config, avg 2µs/call
196
19724304.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
sub _now {
2721312µs my($self,$op,$noupdate) = @_;
273134µs my $istz = ref($self) eq 'Date::Manip::TZ';
274139µs1312µ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
279133µs if (! defined $noupdate) {
2801230µs1216µ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 {
283121µs $noupdate = 1;
284 }
285 }
286135µs $noupdate = 0 if (! exists $$base{'data'}{'now'}{'date'});
2871352µs1153µ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
291135µs my @tmpnow = @{ $$base{'data'}{'tmpnow'} };
2921310µs my @now = (@tmpnow ? @tmpnow : @{ $$base{'data'}{'now'}{'date'} });
293
2941314µs if ($op eq 'tz') {
295 if (exists $$base{'data'}{'now'}{'tz'}) {
296 return $$base{'data'}{'now'}{'tz'};
297 } else {
298715µ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
sub _update_now {
3441600ns my($self) = @_;
3451600ns my $istz = ref($self) eq 'Date::Manip::TZ';
34611µs11µ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.
3491800ns 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
3561800ns 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
3731700ns my $time = time;
374110µs my($s,$mn,$h,$d,$m,$y,$wday,$yday,$isdst) = localtime($time);
37512µs my($s0,$mn0,$h0,$d0,$m0,$y0) = gmtime($time);
376
3771700ns $y += 1900;
3781100ns $m++;
379
3801200ns $y0 += 1900;
3811100ns $m0++;
382
383117µs130µ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
38512µs $$base{'data'}{'now'}{'date'} = [$y,$m,$d,$h,$mn,$s];
3861400ns $$base{'data'}{'now'}{'isdst'} = $isdst;
3871600ns $$base{'data'}{'now'}{'offset'}= $off;
388
3891300ns my $abb = '???';
3901700ns if (ref($self) eq 'Date::Manip::TZ') {
391123µs10s 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
39212µs142µ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
3931500ns $abb = $$per[4];
394 }
395
3961600ns $$base{'data'}{'now'}{'abb'} = $abb;
397
39812µs return;
399}
400
401###############################################################################
402# This sorts from longest to shortest element
403#
404228µs229µ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
no strict 'vars';
# spent 22µs making 1 call to Date::Manip::TZ_Base::BEGIN@404 # spent 7µs making 1 call to strict::unimport
405sub _sortByLength {
406 return (length $b <=> length $a);
407}
408217µs214µ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
use strict 'vars';
# spent 9µs making 1 call to Date::Manip::TZ_Base::BEGIN@408 # spent 5µs making 1 call to strict::import
409
41012µs1;
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
sub Date::Manip::TZ_Base::CORE:match; # opcode