← Index
NYTProf Performance Profile   « line view »
For svc/members/upsert
  Run on Tue Jan 13 11:50:22 2015
Reported on Tue Jan 13 12:09:48 2015

Filename/usr/share/perl5/Date/Manip/TZ.pm
StatementsExecuted 453 statements in 8.53ms
Subroutines
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
3211.09ms1.14msDate::Manip::TZ::::_moduleDate::Manip::TZ::_module
211262µs286µsDate::Manip::TZ::::_initDate::Manip::TZ::_init
211216µs392µsDate::Manip::TZ::::_get_curr_zoneDate::Manip::TZ::_get_curr_zone
111157µs374µsDate::Manip::TZ::::BEGIN@1601Date::Manip::TZ::BEGIN@1601
11169µs1.46msDate::Manip::TZ::::_config_var_setdateDate::Manip::TZ::_config_var_setdate
11162µs1.25msDate::Manip::TZ::::zoneDate::Manip::TZ::zone
32142µs54µsDate::Manip::TZ::::_all_periodsDate::Manip::TZ::_all_periods
11140µs50µsDate::Manip::TZ::::BEGIN@1605Date::Manip::TZ::BEGIN@1605
22137µs70µsDate::Manip::TZ::::date_periodDate::Manip::TZ::date_period
107127µs27µsDate::Manip::TZ::::_zoneDate::Manip::TZ::_zone
11122µs22µsDate::Manip::TZ::::CORE:regcompDate::Manip::TZ::CORE:regcomp (opcode)
11116µs47µsDate::Manip::TZ::::_convertDate::Manip::TZ::_convert
21116µs412µsDate::Manip::TZ::::_set_curr_zoneDate::Manip::TZ::_set_curr_zone
94116µs16µsDate::Manip::TZ::::CORE:matchDate::Manip::TZ::CORE:match (opcode)
105112µs12µsDate::Manip::TZ::::CORE:substDate::Manip::TZ::CORE:subst (opcode)
11111µs1.47msDate::Manip::TZ::::_config_var_tzDate::Manip::TZ::_config_var_tz
11110µs24µsDate::Manip::TZ::::BEGIN@721Date::Manip::TZ::BEGIN@721
11110µs10µsDate::Manip::TZ::::_periodsDate::Manip::TZ::_periods
21110µs10µsDate::Manip::TZ::::ENDDate::Manip::TZ::END
11110µs61µsDate::Manip::TZ::::convert_to_gmtDate::Manip::TZ::convert_to_gmt
1119µs9µsDate::Manip::TZ::::BEGIN@14Date::Manip::TZ::BEGIN@14
1118µs110µsDate::Manip::TZ::::BEGIN@22Date::Manip::TZ::BEGIN@22
1118µs12µsDate::Manip::TZ::::BEGIN@731Date::Manip::TZ::BEGIN@731
4118µs8µsDate::Manip::TZ::::CORE:ftfileDate::Manip::TZ::CORE:ftfile (opcode)
1117µs12µsDate::Manip::TZ::::BEGIN@19Date::Manip::TZ::BEGIN@19
1116µs15µsDate::Manip::TZ::::BEGIN@158Date::Manip::TZ::BEGIN@158
2116µs418µsDate::Manip::TZ::::_init_finalDate::Manip::TZ::_init_final
4416µs6µsDate::Manip::TZ::::CORE:qrDate::Manip::TZ::CORE:qr (opcode)
1116µs13µsDate::Manip::TZ::::BEGIN@189Date::Manip::TZ::BEGIN@189
1115µs14µsDate::Manip::TZ::::BEGIN@20Date::Manip::TZ::BEGIN@20
1114µs4µsDate::Manip::TZ::::BEGIN@15Date::Manip::TZ::BEGIN@15
1114µs4µsDate::Manip::TZ::::_convert_argsDate::Manip::TZ::_convert_args
1114µs4µsDate::Manip::TZ::::BEGIN@24Date::Manip::TZ::BEGIN@24
2112µs2µsDate::Manip::TZ::::CORE:readlineDate::Manip::TZ::CORE:readline (opcode)
2111µs1µsDate::Manip::TZ::::CORE:closeDate::Manip::TZ::CORE:close (opcode)
1111µs1µsDate::Manip::TZ::::CORE:sortDate::Manip::TZ::CORE:sort (opcode)
0000s0sDate::Manip::TZ::::_abbrxDate::Manip::TZ::_abbrx
0000s0sDate::Manip::TZ::::_check_abbrev_isdstDate::Manip::TZ::_check_abbrev_isdst
0000s0sDate::Manip::TZ::::_check_offset_abbrev_isdstDate::Manip::TZ::_check_offset_abbrev_isdst
0000s0sDate::Manip::TZ::::_cmdDate::Manip::TZ::_cmd
0000s0sDate::Manip::TZ::::_lastruleDate::Manip::TZ::_lastrule
0000s0sDate::Manip::TZ::::_list_addDate::Manip::TZ::_list_add
0000s0sDate::Manip::TZ::::_list_unionDate::Manip::TZ::_list_union
0000s0sDate::Manip::TZ::::_offmodDate::Manip::TZ::_offmod
0000s0sDate::Manip::TZ::::_offrxDate::Manip::TZ::_offrx
0000s0sDate::Manip::TZ::::_sortByLengthDate::Manip::TZ::_sortByLength
0000s0sDate::Manip::TZ::::_windows_registry_valDate::Manip::TZ::_windows_registry_val
0000s0sDate::Manip::TZ::::_zonerxDate::Manip::TZ::_zonerx
0000s0sDate::Manip::TZ::::_zrxDate::Manip::TZ::_zrx
0000s0sDate::Manip::TZ::::all_periodsDate::Manip::TZ::all_periods
0000s0sDate::Manip::TZ::::convertDate::Manip::TZ::convert
0000s0sDate::Manip::TZ::::convert_from_gmtDate::Manip::TZ::convert_from_gmt
0000s0sDate::Manip::TZ::::convert_from_localDate::Manip::TZ::convert_from_local
0000s0sDate::Manip::TZ::::convert_to_localDate::Manip::TZ::convert_to_local
0000s0sDate::Manip::TZ::::curr_zoneDate::Manip::TZ::curr_zone
0000s0sDate::Manip::TZ::::curr_zone_methodsDate::Manip::TZ::curr_zone_methods
0000s0sDate::Manip::TZ::::define_abbrevDate::Manip::TZ::define_abbrev
0000s0sDate::Manip::TZ::::define_aliasDate::Manip::TZ::define_alias
0000s0sDate::Manip::TZ::::define_offsetDate::Manip::TZ::define_offset
0000s0sDate::Manip::TZ::::periodsDate::Manip::TZ::periods
0000s0sDate::Manip::TZ::::tzcodeDate::Manip::TZ::tzcode
0000s0sDate::Manip::TZ::::tzdataDate::Manip::TZ::tzdata
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;
2# Copyright (c) 2008-2014 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
14225µs19µs
# spent 9µs within Date::Manip::TZ::BEGIN@14 which was called: # once (9µs+0s) by Date::Manip::Date::BEGIN@27 at line 14
use Date::Manip::Obj;
# spent 9µs making 1 call to Date::Manip::TZ::BEGIN@14
15233µs14µs
# spent 4µs within Date::Manip::TZ::BEGIN@15 which was called: # once (4µs+0s) by Date::Manip::Date::BEGIN@27 at line 15
use Date::Manip::TZ_Base;
# spent 4µs making 1 call to Date::Manip::TZ::BEGIN@15
1617µs@ISA = qw(Date::Manip::Obj Date::Manip::TZ_Base);
17
1817µsrequire 5.010000;
19218µs216µs
# spent 12µs (7+5) within Date::Manip::TZ::BEGIN@19 which was called: # once (7µs+5µs) by Date::Manip::Date::BEGIN@27 at line 19
use warnings;
# spent 12µs making 1 call to Date::Manip::TZ::BEGIN@19 # spent 4µs making 1 call to warnings::import
20219µs223µs
# spent 14µs (5+9) within Date::Manip::TZ::BEGIN@20 which was called: # once (5µs+9µs) by Date::Manip::Date::BEGIN@27 at line 20
use strict;
# spent 14µs making 1 call to Date::Manip::TZ::BEGIN@20 # spent 9µs making 1 call to strict::import
21
22226µs2212µs
# spent 110µs (8+102) within Date::Manip::TZ::BEGIN@22 which was called: # once (8µs+102µs) by Date::Manip::Date::BEGIN@27 at line 22
use IO::File;
# spent 110µs making 1 call to Date::Manip::TZ::BEGIN@22 # spent 102µs making 1 call to Exporter::import
2311.03msrequire Date::Manip::Zones;
242318µs14µs
# spent 4µs within Date::Manip::TZ::BEGIN@24 which was called: # once (4µs+0s) by Date::Manip::Date::BEGIN@27 at line 24
use Date::Manip::Base;
# spent 4µs making 1 call to Date::Manip::TZ::BEGIN@24
25
261300nsour $VERSION;
271400ns$VERSION='6.47';
2812µsEND { undef $VERSION; }
29
30# To get rid of a 'used only once' warnings.
31
# spent 10µs within Date::Manip::TZ::END which was called 2 times, avg 5µs/call: # 2 times (10µs+0s) by main::RUNTIME at line 131 of C4/Service.pm, avg 5µs/call
END {
3211µs my $tmp = \%Date::Manip::Zones::Module;
331800ns $tmp = \%Date::Manip::Zones::ZoneNames;
341400ns $tmp = \%Date::Manip::Zones::Alias;
351500ns $tmp = \%Date::Manip::Zones::Abbrev;
361200ns $tmp = \%Date::Manip::Zones::Offmod;
371700ns $tmp = $Date::Manip::Zones::FirstDate;
381300ns $tmp = $Date::Manip::Zones::LastDate;
391200ns $tmp = $Date::Manip::Zones::LastYear;
401300ns $tmp = $Date::Manip::Zones::TzcodeVersion;
4114µs $tmp = $Date::Manip::Zones::TzdataVersion;
42}
43
44########################################################################
45# BASE METHODS
46########################################################################
47
48
# spent 286µs (262+24) within Date::Manip::TZ::_init which was called 2 times, avg 143µs/call: # 2 times (262µs+24µs) by Date::Manip::Obj::new at line 162 of Date/Manip/Obj.pm, avg 143µs/call
sub _init {
492600ns my($self) = @_;
50
512236µs $$self{'data'} =
52 {
53 # These are the variables defined in Date::Manip::Zones
54 'Module' => \%Date::Manip::Zones::Module,
55 'ZoneNames' => \%Date::Manip::Zones::ZoneNames,
56 'Alias' => \%Date::Manip::Zones::Alias,
57 'Abbrev' => \%Date::Manip::Zones::Abbrev,
58 'Offmod' => \%Date::Manip::Zones::Offmod,
59 'FirstDate' => $Date::Manip::Zones::FirstDate,
60 'LastDate' => $Date::Manip::Zones::LastDate,
61 'LastYear' => $Date::Manip::Zones::LastYear,
62
63 # These override values from Date::Manip::Zones
64 'MyAlias' => {},
65 'MyAbbrev' => {},
66 'MyOffsets' => {},
67
68 # Each timezone/offset module that is loaded goes here
69 'Zones' => {},
70 'Offsets' => {},
71
72 # methods a list of methods used for determining the
73 # current zone
74 # path the PATH to set for determining the current
75 # zone
76 # dates critical dates on a per/year (UT) basis
77 # zonerx the regular expression for matching timezone
78 # names/aliases
79 # abbrx the regular expression for matching timezone
80 # abbreviations
81 # offrx the regular expression for matching a valid
82 # timezone offset
83 # zrx the regular expression to match all timezone
84 # information
85 'methods' => [],
86 'path' => undef,
87 'zonerx' => undef,
88 'abbrx' => undef,
89 'offrx' => undef,
90 'zrx' => undef,
91 };
92
93 # OS specific stuff
94
9521µs my $dmb = $$self{'base'};
9624µs224µs my $os = $dmb->_os();
# spent 24µs making 2 calls to Date::Manip::Base::_os, avg 12µs/call
97
9825µs if ($os eq 'Unix') {
9921µs $$self{'data'}{'path'} = '/bin:/usr/bin';
100213µs $$self{'data'}{'methods'} = [
101 qw(main TZ
102 env zone TZ
103 file /etc/TIMEZONE
104 file /etc/timezone
105 file /etc/sysconfig/clock
106 file /etc/default/init
107 ),
108 'command', '/bin/date +%Z',
109 'command', '/usr/bin/date +%Z',
110 'command', '/usr/local/bin/date +%Z',
111 qw(cmdfield /bin/date -2
112 cmdfield /usr/bin/date -2
113 cmdfield /usr/local/bin/date -2
114 ),
115 'command', '/bin/date +%z',
116 'command', '/usr/bin/date +%z',
117 'command', '/usr/local/bin/date +%z',
118 'gmtoff'
119 ];
120
121 } elsif ($os eq 'Windows') {
122 $$self{'data'}{'methods'} = [
123 qw(main TZ
124 env zone TZ
125 registry
126 gmtoff),
127 ];
128
129 } elsif ($os eq 'VMS') {
130 $$self{'data'}{'methods'} = [
131 qw(main TZ
132 env zone TZ
133 env zone SYS$TIMEZONE_NAME
134 env zone UCX$TZ
135 env zone TCPIP$TZ
136 env zone MULTINET_TIMEZONE
137 env offset SYS$TIMEZONE_DIFFERENTIAL
138 gmtoff
139 ),
140 ];
141
142 } else {
143 $$self{'data'}{'methods'} = [
144 qw(main TZ
145 env zone TZ
146 gmtoff
147 ),
148 ];
149 }
150}
151
152
# spent 418µs (6+412) within Date::Manip::TZ::_init_final which was called 2 times, avg 209µs/call: # 2 times (6µs+412µs) by Date::Manip::Obj::new at line 165 of Date/Manip/Obj.pm, avg 209µs/call
sub _init_final {
1532400ns my($self) = @_;
154
15527µs2412µs $self->_set_curr_zone();
# spent 412µs making 2 calls to Date::Manip::TZ::_set_curr_zone, avg 206µs/call
156}
157
1582165µs224µs
# spent 15µs (6+9) within Date::Manip::TZ::BEGIN@158 which was called: # once (6µs+9µs) by Date::Manip::Date::BEGIN@27 at line 158
no strict 'refs';
# spent 15µs making 1 call to Date::Manip::TZ::BEGIN@158 # spent 9µs making 1 call to strict::unimport
159# This loads data from an offset module
160#
161sub _offmod {
162 my($self,$offset) = @_;
163 return if (exists $$self{'data'}{'Offsets'}{$offset});
164
165 my $mod = $$self{'data'}{'Offmod'}{$offset};
166 eval "require Date::Manip::Offset::${mod}";
167 my %off = %{ "Date::Manip::Offset::${mod}::Offset" };
168
169 $$self{'data'}{'Offsets'}{$offset} = { %off };
170}
171
172# This loads data from a zone module (takes a lowercase zone)
173#
174
# spent 1.14ms (1.09+53µs) within Date::Manip::TZ::_module which was called 3 times, avg 380µs/call: # 2 times (3µs+0s) by Date::Manip::TZ::date_period at line 1194, avg 2µs/call # once (1.08ms+53µs) by Date::Manip::TZ::zone at line 919
sub _module {
1753900ns my($self,$zone) = @_;
17636µs return if (exists $$self{'data'}{'Zones'}{$zone}{'Loaded'});
177
17811µs my $mod = $$self{'data'}{'Module'}{$zone};
179143µs eval "require Date::Manip::TZ::${mod}";
# spent 870µs executing statements in string eval
18013µs my %dates = %{ "Date::Manip::TZ::${mod}::Dates" };
18112µs my %last = %{ "Date::Manip::TZ::${mod}::LastRule" };
18218µs $$self{'data'}{'Zones'}{$zone} =
183 {
184 'Dates' => { %dates },
185 'LastRule' => { %last },
186 'Loaded' => 1
187 };
188}
18922.10ms221µs
# spent 13µs (6+8) within Date::Manip::TZ::BEGIN@189 which was called: # once (6µs+8µs) by Date::Manip::Date::BEGIN@27 at line 189
use strict 'refs';
# spent 13µs making 1 call to Date::Manip::TZ::BEGIN@189 # spent 8µs making 1 call to strict::import
190
191########################################################################
192# CHECKING/MODIFYING ZONEINFO DATA
193########################################################################
194
195
# spent 27µs within Date::Manip::TZ::_zone which was called 10 times, avg 3µs/call: # 2 times (10µs+0s) by Date::Manip::TZ::_get_curr_zone at line 635, avg 5µs/call # 2 times (4µs+0s) by Date::Manip::TZ::date_period at line 1188, avg 2µs/call # 2 times (4µs+0s) by Date::Manip::TZ::_set_curr_zone at line 388, avg 2µs/call # once (4µs+0s) by Date::Manip::TZ::zone at line 773 # once (2µs+0s) by Date::Manip::TZ::_convert at line 1437 # once (2µs+0s) by Date::Manip::TZ::_config_var_setdate at line 1805 # once (2µs+0s) by Date::Manip::TZ::_convert at line 1431
sub _zone {
196103µs my($self,$zone) = @_;
197103µs $zone = lc($zone);
198
1991032µs if (exists $$self{'data'}{'MyAlias'}{$zone}) {
200 return $$self{'data'}{'MyAlias'}{$zone};
201 } elsif (exists $$self{'data'}{'Alias'}{$zone}) {
202 return $$self{'data'}{'Alias'}{$zone};
203 } else {
204 return '';
205 }
206}
207
208sub tzdata {
209 my($self) = @_;
210 return $Date::Manip::Zones::TzdataVersion;
211}
212
213sub tzcode {
214 my($self) = @_;
215 return $Date::Manip::Zones::TzcodeVersion;
216}
217
218sub define_alias {
219 my($self,$alias,$zone) = @_;
220 $alias = lc($alias);
221
222 if ($alias eq 'reset') {
223 $$self{'data'}{'MyAlias'} = {};
224 $$self{'data'}{'zonerx'} = undef;
225 return 0;
226 }
227 if (lc($zone) eq 'reset') {
228 delete $$self{'data'}{'MyAlias'}{$alias};
229 $$self{'data'}{'zonerx'} = undef;
230 return 0;
231 }
232
233 $zone = $self->_zone($zone);
234
235 return 1 if (! $zone);
236 $$self{'data'}{'MyAlias'}{$alias} = $zone;
237 $$self{'data'}{'zonerx'} = undef;
238 return 0;
239}
240
241sub define_abbrev {
242 my($self,$abbrev,@zone) = @_;
243 $abbrev = lc($abbrev);
244
245 if ($abbrev eq 'reset') {
246 $$self{'data'}{'MyAbbrev'} = {};
247 $$self{'data'}{'abbrx'} = undef;
248 return 0;
249 }
250 if ($#zone == 0 && lc($zone[0]) eq 'reset') {
251 delete $$self{'data'}{'MyAbbrev'}{$abbrev};
252 $$self{'data'}{'abbrx'} = undef;
253 return (0);
254 }
255
256 if (! exists $$self{'data'}{'Abbrev'}{$abbrev}) {
257 return (1);
258 }
259
260 my (@z,%z);
261 my %zone = map { $_,1 } @{ $$self{'data'}{'Abbrev'}{$abbrev} };
262 foreach my $z (@zone) {
263 my $zone = $self->_zone($z);
264 return (2,$z) if (! $zone);
265 return (3,$z) if (! exists $zone{$zone});
266 next if (exists $z{$zone});
267 $z{$zone} = 1;
268 push(@z,$zone);
269 }
270
271 $$self{'data'}{'MyAbbrev'}{$abbrev} = [ @z ];
272 $$self{'data'}{'abbrx'} = undef;
273 return ();
274}
275
276sub define_offset {
277 my($self,$offset,@args) = @_;
278 my $dmb = $$self{'base'};
279
280 if (lc($offset) eq 'reset') {
281 $$self{'data'}{'MyOffsets'} = {};
282 return (0);
283 }
284 if ($#args == 0 && lc($args[0]) eq 'reset') {
285 delete $$self{'data'}{'MyOffsets'}{$offset};
286 return (0);
287 }
288
289 # Check that $offset is valid. If it is, load the
290 # appropriate module.
291
292 if (ref($offset)) {
293 $offset = $dmb->join('offset',$offset);
294 } else {
295 $offset = $dmb->_delta_convert('offset',$offset);
296 }
297 return (9) if (! $offset);
298 return (1) if (! exists $$self{'data'}{'Offmod'}{$offset});
299
300 $self->_offmod($offset);
301
302 # Find out whether we're handling STD, DST, or both.
303
304 my(@isdst) = (0,1);
305 if ($args[0] =~ /^std|dst|stdonly|dstonly$/i) {
306 my $tmp = lc(shift(@args));
307 if ($tmp eq 'stdonly') {
308 @isdst = (0);
309 } elsif ($tmp eq 'dstonly') {
310 @isdst = (1);
311 }
312 }
313 my @zone = @args;
314
315 if ($#isdst == 0 &&
316 ! exists($$self{'data'}{'Offsets'}{$offset}{$isdst[0]})) {
317 return (2);
318 }
319
320 # Check to see that each zone is valid, and contains this offset.
321
322 my %tmp;
323 foreach my $isdst (0,1) {
324 next if (! exists $$self{'data'}{'Offsets'}{$offset}{$isdst});
325 my @z = @{ $$self{'data'}{'Offsets'}{$offset}{$isdst} };
326 $tmp{$isdst} = { map { $_,1 } @z };
327 }
328
329 foreach my $z (@zone) {
330 my $lcz = lc($z);
331 if (! exists $$self{'data'}{'ZoneNames'}{$lcz}) {
332 return (3,$z);
333 } elsif (! exists $tmp{0}{$lcz} &&
334 ! exists $tmp{1}{$lcz}) {
335 return (4,$z);
336 } elsif ($#isdst == 0 &&
337 ! exists $tmp{$isdst[0]}{$lcz}) {
338 return (5,$z);
339 }
340 $z = $lcz;
341 }
342
343 # Set the zones accordingly.
344
345 foreach my $isdst (@isdst) {
346 my @z;
347 foreach my $z (@zone) {
348 push(@z,$z) if (exists $tmp{$isdst}{$z});
349 }
350 $$self{'data'}{'MyOffsets'}{$offset}{$isdst} = [ @z ];
351 }
352
353 return (0);
354}
355
356########################################################################
357# SYSTEM ZONE
358########################################################################
359
360sub curr_zone {
361 my($self,$reset) = @_;
362 my $dmb = $$self{'base'};
363
364 if ($reset) {
365 $self->_set_curr_zone();
366 }
367
368 my($ret) = $self->_now('systz',1);
369 return $$self{'data'}{'ZoneNames'}{$ret}
370}
371
372sub curr_zone_methods {
373 my($self,@methods) = @_;
374
375 if (${^TAINT}) {
376 warn "ERROR: [curr_zone_methods] not allowed when taint checking on\n";
377 return;
378 }
379
380 $$self{'data'}{'methods'} = [ @methods ];
381}
382
383
# spent 412µs (16+396) within Date::Manip::TZ::_set_curr_zone which was called 2 times, avg 206µs/call: # 2 times (16µs+396µs) by Date::Manip::TZ::_init_final at line 155, avg 206µs/call
sub _set_curr_zone {
3842700ns my($self) = @_;
38521µs my $dmb = $$self{'base'};
38624µs2392µs my $currzone = $self->_get_curr_zone();
# spent 392µs making 2 calls to Date::Manip::TZ::_get_curr_zone, avg 196µs/call
387
38827µs24µs $$dmb{'data'}{'now'}{'systz'} = $self->_zone($currzone);
# spent 4µs making 2 calls to Date::Manip::TZ::_zone, avg 2µs/call
389}
390
391# This determines the system timezone using all of the methods
392# applicable to the operating system. The first match is used.
393#
394
# spent 392µs (216+176) within Date::Manip::TZ::_get_curr_zone which was called 2 times, avg 196µs/call: # 2 times (216µs+176µs) by Date::Manip::TZ::_set_curr_zone at line 386, avg 196µs/call
sub _get_curr_zone {
3952500ns my($self) = @_;
3962900ns my $dmb = $$self{'base'};
397
39821µs my $t = time;
399231µs my($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime($t);
4002600ns my $currzone = '';
4012700ns my $dstflag = ($isdst ? 'dstonly' : 'stdonly');
402
40326µs my (@methods) = @{ $$self{'data'}{'methods'} };
40422µs my $debug = ($ENV{DATE_MANIP_DEBUG} ? 1 : 0);
405
40628µs defined $$self{'data'}{'path'}
407 and local $ENV{PATH} = $$self{'data'}{'path'};
408
409 METHOD:
41021µs while (@methods) {
41182µs my $method = shift(@methods);
41282µs my @zone = ();
413
41484µs if ($method eq 'main') {
415
4162400ns if (! @methods) {
417 warn "ERROR: [_set_curr_zone] main requires argument\n";
418 return;
419 }
4202700ns my $var = shift(@methods);
4212800ns push(@zone,$$::var) if (defined $$::var);
422
4232600ns if ($debug) {
424 print "*** DEBUG *** main $var = " .
425 (defined $$::var ? $$::var : 'undef') . "\n";
426 }
427
428 } elsif ($method eq 'env') {
4292900ns if (@methods < 2) {
430 warn "ERROR: [_set_curr_zone] env requires 2 argument\n";
431 return;
432 }
43322µs my $type = lc( shift(@methods) );
4342800ns if ($type ne 'zone' &&
435 $type ne 'offset') {
436 warn "ERROR: [_set_curr_zone] env requires 'offset' or 'zone' as the first argument\n";
437 return;
438 }
43921µs my $var = shift(@methods);
44021µs if (exists $ENV{$var}) {
441 if ($type eq 'zone') {
442 push(@zone,$ENV{$var});
443 } else {
444 my $off = $ENV{$var};
445 $off = $dmb->_delta_convert('time',"0:0:$off");
446 $off = $dmb->_delta_convert('offset',$off);
447 push(@zone,$off);
448 }
449 }
450
4512800ns if ($debug) {
452 print "*** DEBUG *** env $type $var ";
453 if (exists $ENV{$var}) {
454 print $ENV{$var};
455 print $zone[$#zone] if ($type eq 'offset');
456 print "\n";
457 } else {
458 print "-no result-\n";
459 }
460 }
461
462 } elsif ($method eq 'file') {
4634700ns if (! @methods) {
464 warn "ERROR: [_set_curr_zone] file requires argument\n";
465 return;
466 }
4674800ns my $file = shift(@methods);
468419µs48µs next if (! -f $file);
# spent 8µs making 4 calls to Date::Manip::TZ::CORE:ftfile, avg 2µs/call
469
47029µs250µs my $in = new IO::File;
# spent 50µs making 2 calls to IO::File::new, avg 25µs/call
47124µs251µs $in->open($file) || next;
# spent 51µs making 2 calls to IO::File::open, avg 26µs/call
4722800ns my $firstline = 1;
473
4742300ns my @z;
475221µs227µs while (! $in->eof) {
# spent 27µs making 2 calls to IO::Handle::eof, avg 14µs/call
47628µs22µs my $line = <$in>;
# spent 2µs making 2 calls to Date::Manip::TZ::CORE:readline, avg 1µs/call
477214µs45µs next if ($line =~ /^\s*\043/ ||
# spent 5µs making 4 calls to Date::Manip::TZ::CORE:match, avg 1µs/call
478 $line =~ /^\s*$/);
479
480 # We're looking for lines of the form:
481 # TZ = string
482 # TIMEZONE = string
483 # ZONE = string
484 #
485 # 'string' can be:
486 # the name of a timezone enclosed in single/double quotes
487 # with everything after the closing quote ignored (the
488 # name of the timezone may have spaces instead of underscores)
489 #
490 # a space delimited list of tokens, the first of which
491 # is the time zone
492 #
493 # the name of a timezone with underscores replaced by
494 # spaces and nothing after the timezone
495 #
496 # For some reason, RHEL6 desktop version stores timezones as
497 # America/New York
498 # instead of
499 # America/New_York
500 # which is why we have to handle the space/underscore
501 # substitution.
502
50324µs2800ns if ($line =~ /^\s*(?:TZ|TIMEZONE|ZONE)\s*=\s*(.*)\s*$/) {
# spent 800ns making 2 calls to Date::Manip::TZ::CORE:match, avg 400ns/call
504 my $val = $1;
505 @z = ();
506 last if (! $val);
507
508 if ($val =~ /^(["'])(.*?)\1/) {
509 my $z = $2;
510 last if (! $z);
511 $z =~ s/\s+/_/g;
512 push(@zone,$z);
513
514 } elsif ($val =~ /\s/) {
515 $val =~ /^(\S+)/;
516 push(@zone,$1);
517 $val =~ s/\s+/_/g;
518 push(@zone,$val);
519
520 } else {
521 push(@zone,$val);
522 }
523
524 last;
525 }
52624µs29µs if ($firstline) {
# spent 9µs making 2 calls to IO::Handle::eof, avg 4µs/call
5272700ns $firstline = 0;
52828µs24µs $line =~ s/^\s*//;
# spent 4µs making 2 calls to Date::Manip::TZ::CORE:subst, avg 2µs/call
52928µs25µs $line =~ s/\s*$//;
# spent 5µs making 2 calls to Date::Manip::TZ::CORE:subst, avg 2µs/call
53024µs21µs $line =~ s/["']//g; # "
# spent 1µs making 2 calls to Date::Manip::TZ::CORE:subst, avg 600ns/call
53123µs2800ns $line =~ s/\s+/_/g;
# spent 800ns making 2 calls to Date::Manip::TZ::CORE:subst, avg 400ns/call
53222µs push(@z,$line);
533 }
534 }
53528µs21µs close(IN);
# spent 1µs making 2 calls to Date::Manip::TZ::CORE:close, avg 650ns/call
536
53721µs push(@zone,@z) if (@z);
538
539210µs if ($debug) {
540 print "*** DEBUG *** file $file\n";
541 if (@z) {
542 print " @z\n";
543 } else {
544 print " -no result-\n";
545 }
546 }
547
548 } elsif ($method eq 'command') {
549 if (! @methods) {
550 warn "ERROR: [_set_curr_zone] command requires argument\n";
551 return;
552 }
553 my $command = shift(@methods);
554 my ($out) = _cmd($command);
555 push(@zone,$out) if ($out);
556
557 if ($debug) {
558 print "*** DEBUG *** command $command\n";
559 if ($out) {
560 print " $out\n";
561 } else {
562 print " -no result-\n";
563 }
564 }
565
566 } elsif ($method eq 'cmdfield') {
567 if ($#methods < 1) {
568 warn "ERROR: [_set_curr_zone] cmdfield requires 2 arguments\n";
569 return;
570 }
571 my $command = shift(@methods);
572 my $n = shift(@methods);
573 my ($out) = _cmd($command);
574 my @z;
575
576 if ($out) {
577 $out =~ s/^\s*//;
578 $out =~ s/\s*$//;
579 my @out = split(/\s+/,$out);
580 push(@z,$out[$n]) if (defined $out[$n]);
581 }
582
583 push(@zone,@z) if (@z);
584
585 if ($debug) {
586 print "*** DEBUG *** cmdfield $command $n\n";
587 if (@z) {
588 print " @z\n";
589 } else {
590 print " -no result-\n";
591 }
592 }
593
594 } elsif ($method eq 'gmtoff') {
595 my($secUT,$minUT,$hourUT,$mdayUT,$monUT,$yearUT,$wdayUT,$ydayUT,
596 $isdstUT) = gmtime($t);
597 if ($mdayUT>($mday+1)) {
598 # UT = 28-31 LT = 1
599 $mdayUT=0;
600 } elsif ($mdayUT<($mday-1)) {
601 # UT = 1 LT = 28-31
602 $mday=0;
603 }
604 $sec = (($mday*24 + $hour)*60 + $min)*60 + $sec;
605 $secUT = (($mdayUT*24 + $hourUT)*60 + $minUT)*60 + $secUT;
606 my $off = $sec-$secUT;
607
608 $off = $dmb->_delta_convert('time',"0:0:$off");
609 $off = $dmb->_delta_convert('offset',$off);
610 push(@zone,$off);
611
612 if ($debug) {
613 print "*** DEBUG *** gmtoff $off\n";
614 }
615
616 } elsif ($method eq 'registry') {
617 my $z = $self->_windows_registry_val();
618 push(@zone,$z) if ($z);
619
620 if ($debug) {
621 print "*** DEBUG *** registry $z\n";
622 }
623
624 } else {
625 warn "ERROR: [_set_curr_zone] invalid method: $method\n";
626 return;
627 }
628
62964µs foreach my $zone (@zone) {
63022µs $zone = lc($zone);
631 # OpenUNIX puts a colon at the start
63225µs21µs $zone =~ s/^://;
# spent 1µs making 2 calls to Date::Manip::TZ::CORE:subst, avg 500ns/call
633
634 # If we got a zone name/alias
63524µs210µs $currzone = $self->_zone($zone);
# spent 10µs making 2 calls to Date::Manip::TZ::_zone, avg 5µs/call
63623µs last METHOD if ($currzone);
637
638 # If we got an abbreviation (EST)
639 if (exists $$self{'data'}{'Abbrev'}{$zone}) {
640 $currzone = $$self{'data'}{'Abbrev'}{$zone}[0];
641 last METHOD;
642 }
643
644 # If we got an offset
645
646 $currzone = $self->zone($zone,$dstflag);
647 last METHOD if ($currzone);
648 }
649 }
650
6512600ns if (! $currzone) {
652 warn "ERROR: Date::Manip unable to determine Time Zone.\n";
653 die;
654 }
655
656222µs return $currzone;
657}
658
659# This comes from the DateTime-TimeZone module
660#
661sub _windows_registry_val {
662 my($self) = @_;
663
664 require Win32::TieRegistry;
665
666 my $lmachine = new Win32::TieRegistry 'LMachine',
667 { Access => Win32::TieRegistry::KEY_READ(),
668 Delimiter => '/' }
669 or return '';
670
671 my $tzinfo = $lmachine->Open('SYSTEM/CurrentControlSet/Control/TimeZoneInformation/');
672
673 #
674 # Windows Vista, Windows 2008 Server
675 #
676
677 my $tzkn = $tzinfo->GetValue('TimeZoneKeyName');
678 if (defined($tzkn) && $tzkn) {
679 # For some reason, Vista is tacking on a bunch of stuff at the
680 # end of the timezone, starting with a chr(0). Strip it off.
681
682 my $c = chr(0);
683 my $i = index($tzkn,$c);
684 if ($i != -1) {
685 $tzkn = substr($tzkn,0,$i);
686 }
687 my $z = $self->_zone($tzkn);
688 return $z if ($z);
689 }
690
691 #
692 # Windows NT, Windows 2000, Windows XP, Windows 2003 Server
693 #
694
695 my $stdnam = $tzinfo->GetValue('StandardName');
696 my $z = $self->_zone($stdnam);
697 return $z if ($z);
698
699 #
700 # For non-English versions, we have to determine which timezone it
701 # actually is.
702 #
703
704 my $atz = $lmachine->Open('SOFTWARE/Microsoft/Windows NT/CurrentVersion/Time Zones/');
705 if (! defined($atz) || ! $atz) {
706 $atz = $lmachine->Open('SOFTWARE/Microsoft/Windows/CurrentVersion/Time Zones/');
707 }
708
709 return "" if (! defined($atz) || ! $atz);
710
711 foreach my $z ($atz->SubKeyNames()) {
712 my $tmp = $atz->Open("$z/");
713 my $znam = $tmp->GetValue('Std');
714 return $z if ($znam eq $stdnam);
715 }
716}
717
718# We will be testing commands that don't exist on all architectures,
719# so disable warnings.
720#
721277µs237µs
# spent 24µs (10+13) within Date::Manip::TZ::BEGIN@721 which was called: # once (10µs+13µs) by Date::Manip::Date::BEGIN@27 at line 721
no warnings;
# spent 24µs making 1 call to Date::Manip::TZ::BEGIN@721 # spent 13µs making 1 call to warnings::unimport
722sub _cmd {
723 my($cmd) = @_;
724 local(*IN);
725 open(IN,"$cmd |") || return ();
726 my @out = <IN>;
727 close(IN);
728 chomp(@out);
729 return @out;
730}
73122.82ms215µs
# spent 12µs (8+4) within Date::Manip::TZ::BEGIN@731 which was called: # once (8µs+4µs) by Date::Manip::Date::BEGIN@27 at line 731
use warnings;
# spent 12µs making 1 call to Date::Manip::TZ::BEGIN@731 # spent 4µs making 1 call to warnings::import
732
733########################################################################
734# DETERMINING A TIMEZONE
735########################################################################
736
737
# spent 1.25ms (62µs+1.19) within Date::Manip::TZ::zone which was called: # once (62µs+1.19ms) by Date::Manip::TZ::_config_var_setdate at line 1745
sub zone {
7381800ns my($self,@args) = @_;
7391600ns my $dmb = $$self{'base'};
7401500ns if (! @args) {
741 my($tz) = $self->_now('tz',1);
742 return $$self{'data'}{'ZoneNames'}{$tz}
743 }
744
745 # Parse the arguments
746
7471900ns my($zone,$abbrev,$offset,$dstflag) = ('','','','');
7481200ns my(@abbrev,$date,$tmp);
74911µs foreach my $arg (@args) {
750
75132µs if (ref($arg) eq 'ARRAY') {
7521800ns if ($#$arg == 5) {
753 # [Y,M,D,H,Mn,S]
7541100ns return undef if ($date);
7551200ns $date = $arg;
756
757 } elsif ($#$arg == 2) {
758 # [H,Mn,S]
759 return undef if ($offset);
760 $offset = $dmb->join('offset',$arg);
761 return undef if (! $offset);
762
763 } else {
764 return undef;
765 }
766
767 } elsif (ref($arg)) {
768 return undef;
769
770 } else {
77121µs $arg = lc($arg);
772
773223µs38µs if ($arg =~ /^(std|dst|stdonly|dstonly)$/) {
# spent 4µs making 1 call to Date::Manip::TZ::_zone # spent 4µs making 2 calls to Date::Manip::TZ::CORE:match, avg 2µs/call
7741200ns return undef if ($dstflag);
7751400ns $dstflag = $arg;
776
777 } elsif ($tmp = $self->_zone($arg)) {
7781200ns return undef if ($zone);
7791300ns $zone = $tmp;
780
781 } elsif (exists $$self{'data'}{'MyAbbrev'}{$arg}) {
782 return undef if (@abbrev);
783 $abbrev = $arg;
784 @abbrev = @{ $$self{'data'}{'MyAbbrev'}{$arg} };
785 } elsif (exists $$self{'data'}{'Abbrev'}{$arg}) {
786 return undef if (@abbrev);
787 $abbrev = $arg;
788 @abbrev = @{ $$self{'data'}{'Abbrev'}{$arg} };
789
790 } elsif ($tmp = $dmb->split('offset',$arg)) {
791 return undef if ($offset);
792 $offset = $dmb->_delta_convert('offset',$arg);
793
794 } elsif ($tmp = $dmb->split('date',$arg)) {
795 return undef if ($date);
796 $date = $tmp;
797
798 } else {
799 return undef;
800 }
801 }
802 }
803
804 #
805 # Determine the zones that match all data.
806 #
807
8081200ns my @zone;
809
8101200ns while (1) {
811
812 # No information
813
8141200ns if (! $zone &&
815 ! $abbrev &&
816 ! $offset) {
817 my($z) = $self->_now('tz',1);
818 @zone = (lc($z));
819 }
820
821 # $dstflag
822 #
823 # $dstflag is "dst' if
824 # zone is passed in as an offset
825 # date is passed in
826
8271300ns $dstflag = "dst" if ($offset && $date && ! $dstflag);
828
8291400ns my(@isdst);
83011µs if ($dstflag eq 'stdonly') {
831 @isdst = (0);
832 } elsif ($dstflag eq 'dstonly') {
833 @isdst = (1);
834 } elsif ($dstflag eq 'dst') {
835 @isdst = (1,0);
836 } else {
8371900ns @isdst = (0,1);
838 }
839
840 # $zone
841
8421600ns if ($zone) {
843 @zone = ($zone);
844 }
845
846 # $abbrev
847
8481200ns if ($abbrev) {
849 my @z;
850 foreach my $isdst (@isdst) {
851 my @tmp = $self->_check_abbrev_isdst($abbrev,$isdst,@abbrev);
852 if (@tmp) {
853 if (@z) {
854 @z = _list_add(\@z,\@tmp);
855 } else {
856 @z = @tmp;
857 }
858 }
859 }
860
861 if (@zone) {
862 @zone = _list_union(\@z,\@zone);
863 } else {
864 @zone = @z;
865 }
866 last if (! @zone);
867 }
868
869 # $offset
870
8711300ns if ($offset) {
872 return undef if (! exists $$self{'data'}{'Offmod'}{$offset});
873 $self->_offmod($offset);
874
875 my @z;
876 foreach my $isdst (@isdst) {
877 my @tmp;
878 if (exists $$self{'data'}{'MyOffsets'}{$offset}{$isdst}) {
879 @tmp = @{ $$self{'data'}{'MyOffsets'}{$offset}{$isdst} };
880 } elsif (exists $$self{'data'}{'Offsets'}{$offset}{$isdst}) {
881 @tmp = @{ $$self{'data'}{'Offsets'}{$offset}{$isdst} };
882 }
883 @tmp = $self->_check_offset_abbrev_isdst($offset,$abbrev,$isdst,@tmp)
884 if ($abbrev);
885 if (@tmp) {
886 if (@z) {
887 @z = _list_add(\@z,\@tmp);
888 } else {
889 @z = @tmp;
890 }
891 }
892 }
893
894 if (@zone) {
895 @zone = _list_union(\@zone,\@z);
896 } else {
897 @zone = @z;
898 }
899 last if (! @zone);
900 }
901
902 # $date
903
9041400ns if ($date) {
905 # Get all periods for the year.
906 #
907 # Test all periods to make sure that $date is between the
908 # wallclock times AND matches other criteria. All periods
909 # must be tested since the same wallclock time can be in
910 # multiple periods.
911
9121200ns my @tmp;
9131400ns my $isdst = '';
9141100ns $isdst = 0 if ($dstflag eq 'stdonly');
9151100ns $isdst = 1 if ($dstflag eq 'dstonly');
916
917 ZONE:
91811µs foreach my $z (@zone) {
91913µs11.14ms $self->_module($z);
# spent 1.14ms making 1 call to Date::Manip::TZ::_module
9201600ns my $y = $$date[0];
92113µs142µs my @periods = $self->_all_periods($z,$y);
# spent 42µs making 1 call to Date::Manip::TZ::_all_periods
922
9231500ns foreach my $period (@periods) {
9241900ns my($begUT,$begLT,$off,$offref,$abb,$dst,$endUT,$endLT) = @$period;
92515µs24µs next if ($dmb->cmp($date,$begLT) == -1 ||
# spent 4µs making 2 calls to Date::Manip::Base::cmp, avg 2µs/call
926 $dmb->cmp($date,$endLT) == 1 ||
927 ($offset ne '' && $offset ne $off) ||
928 ($isdst ne '' && $isdst ne $dst) ||
929 ($abbrev ne '' && lc($abbrev) ne lc($abb))
930 );
9311500ns push(@tmp,$z);
93212µs next ZONE;
933 }
934 }
9351400ns @zone = @tmp;
9361400ns last if (! @zone);
937 }
938
9391600ns last;
940 }
941
942 # Return the value/list
943
9441900ns if (wantarray) {
945 my @ret;
946 foreach my $z (@zone) {
947 push(@ret,$$self{'data'}{'ZoneNames'}{$z});
948 }
949 return @ret;
950 }
951
9521300ns return '' if (! @zone);
95315µs return $$self{'data'}{'ZoneNames'}{$zone[0]}
954}
955
956# This returns a list of all timezones which have the correct
957# abbrev/isdst combination.
958#
959sub _check_abbrev_isdst {
960 my($self,$abbrev,$isdst,@zones) = @_;
961
962 my @ret;
963 ZONE:
964 foreach my $zone (@zones) {
965 $self->_module($zone);
966
967 foreach my $y (sort keys %{ $$self{'data'}{'Zones'}{$zone}{'Dates'} }) {
968 my @periods = @{ $$self{'data'}{'Zones'}{$zone}{'Dates'}{$y} };
969 foreach my $period (@periods) {
970 my($dateUT,$dateLT,$off,$offref,$abb,$dst,$endUT,$endLT) = @$period;
971 next if (lc($abbrev) ne lc($abb) ||
972 $isdst != $dst);
973 push(@ret,$zone);
974 next ZONE;
975 }
976 }
977 }
978
979 return @ret;
980}
981
982# This returns a list of all timezones which have the correct
983# abbrev/isdst combination.
984#
985sub _check_offset_abbrev_isdst {
986 my($self,$offset,$abbrev,$isdst,@zones) = @_;
987
988 my @ret;
989 ZONE: foreach my $zone (@zones) {
990 $self->_module($zone);
991
992 foreach my $y (sort keys %{ $$self{'data'}{'Zones'}{$zone}{'Dates'} }) {
993 my @periods = @{ $$self{'data'}{'Zones'}{$zone}{'Dates'}{$y} };
994 foreach my $period (@periods) {
995 my($dateUT,$dateLT,$off,$offref,$abb,$dst,$endUT,$endLT) = @$period;
996 next if (lc($abbrev) ne lc($abb) ||
997 $offset ne $off ||
998 $isdst != $dst);
999 push(@ret,$zone);
1000 next ZONE;
1001 }
1002 }
1003 }
1004
1005 return @ret;
1006}
1007
1008# This finds the elements common to two lists, and preserves the order
1009# from the first list.
1010#
1011sub _list_union {
1012 my($list1,$list2) = @_;
1013 my(%list2) = map { $_,1 } @$list2;
1014 my(@ret);
1015 foreach my $ele (@$list1) {
1016 push(@ret,$ele) if (exists $list2{$ele});
1017 }
1018 return @ret;
1019}
1020
1021# This adds elements from the second list to the first list, provided
1022# they are not already there.
1023#
1024sub _list_add {
1025 my($list1,$list2) = @_;
1026 my(%list1) = map { $_,1 } @$list1;
1027 my(@ret) = @$list1;
1028 foreach my $ele (@$list2) {
1029 next if (exists $list1{$ele});
1030 push(@ret,$ele);
1031 $list1{$ele} = 1;
1032 }
1033 return @ret;
1034}
1035
1036########################################################################
1037# PERIODS METHODS
1038########################################################################
1039
1040sub all_periods {
1041 my($self,$zone,$year) = @_;
1042
1043 my $z = $self->_zone($zone);
1044 if (! $z) {
1045 warn "ERROR: [periods] Invalid zone: $zone\n";
1046 return;
1047 }
1048 $zone = $z;
1049 $self->_module($zone);
1050
1051 return $self->_all_periods($zone,$year);
1052}
1053
1054
# spent 54µs (42+12) within Date::Manip::TZ::_all_periods which was called 3 times, avg 18µs/call: # 2 times (12µs+0s) by Date::Manip::TZ::date_period at line 1204, avg 6µs/call # once (31µs+12µs) by Date::Manip::TZ::zone at line 921
sub _all_periods {
105531µs my($self,$zone,$year) = @_;
10563800ns $year += 0;
1057
105833µs if (! exists $$self{'data'}{'Zones'}{$zone}{'AllDates'}{$year}) {
1059
1060 #
1061 # $ym1 is the year prior to $year which contains a rule (which will
1062 # end in $year or later). $y is $year IF the zone contains rules
1063 # for this year.
1064 #
1065
10661200ns my($ym1,$ym0);
106712µs if ($year > $$self{'data'}{'LastYear'} &&
1068 exists $$self{'data'}{'Zones'}{$zone}{'LastRule'}{'zone'}) {
1069 $ym1 = $year-1;
1070 $ym0 = $year;
1071
1072 } else {
107318µs11µs foreach my $y (sort { $a <=> $b }
# spent 1µs making 1 call to Date::Manip::TZ::CORE:sort
1074 keys %{ $$self{'data'}{'Zones'}{$zone}{'Dates'} }) {
10751500ns if ($y < $year) {
10761400ns $ym1 = $y;
10771400ns next;
1078 }
1079 $ym0 = $year if ($year == $y);
1080 last;
1081 }
1082 }
10831300ns $ym1 = 0 if (! $ym1);
1084
1085 #
1086 # Get the periods from the prior year. The last one is used (any others
1087 # are discarded).
1088 #
1089
10901100ns my(@periods);
1091
1092 # $ym1 will be 0 in 0001
10931500ns if ($ym1) {
109413µs110µs my @tmp = $self->_periods($zone,$ym1);
# spent 10µs making 1 call to Date::Manip::TZ::_periods
10951800ns push(@periods,pop(@tmp)) if (@tmp);
1096 }
1097
1098 #
1099 # Add on any periods from the current year.
1100 #
1101
11021200ns if ($ym0) {
1103 push(@periods,$self->_periods($zone,$year));
1104 }
1105
110612µs $$self{'data'}{'Zones'}{$zone}{'AllDates'}{$year} = [ @periods ];
1107 }
1108
1109 # A faster 'dclone' so we don't return the actual data
11103500ns my @ret;
111133µs foreach my $ele (@{ $$self{'data'}{'Zones'}{$zone}{'AllDates'}{$year} }) {
1112 push(@ret,
1113 [ [ @{$$ele[0]} ],[ @{$$ele[1]} ],$$ele[2],[ @{$$ele[3]} ],$$ele[4],$$ele[5],
1114312µs [ @{$$ele[6]} ],[ @{$$ele[7]} ],$$ele[8],$$ele[9],$$ele[10],$$ele[11] ]);
1115 }
111636µs return @ret;
1117}
1118
1119sub periods {
1120 my($self,$zone,$year,$year1) = @_;
1121
1122 my $z = $self->_zone($zone);
1123 if (! $z) {
1124 warn "ERROR: [periods] Invalid zone: $zone\n";
1125 return;
1126 }
1127 $zone = $z;
1128 $self->_module($zone);
1129
1130 if (! defined($year1)) {
1131 return $self->_periods($zone,$year);
1132 }
1133
1134 $year = 1 if (! defined($year));
1135
1136 my @ret;
1137 my $lastyear = $$self{'data'}{'LastYear'};
1138
1139 if ($year <= $lastyear) {
1140 foreach my $y (sort { $a <=> $b }
1141 keys %{ $$self{'data'}{'Zones'}{$zone}{'Dates'} }) {
1142 last if ($y > $year1 || $y > $lastyear);
1143 next if ($y < $year);
1144 push(@ret,$self->_periods($zone,$y));
1145 }
1146 }
1147
1148 if ($year1 > $lastyear) {
1149 $year = $lastyear + 1 if ($year <= $lastyear);
1150 foreach my $y ($year..$year1) {
1151 push(@ret,$self->_periods($zone,$y));
1152 }
1153 }
1154
1155 return @ret;
1156}
1157
1158
# spent 10µs within Date::Manip::TZ::_periods which was called: # once (10µs+0s) by Date::Manip::TZ::_all_periods at line 1094
sub _periods {
11591700ns my($self,$zone,$year) = @_;
11601400ns $year += 0;
1161
116211µs if (! exists $$self{'data'}{'Zones'}{$zone}{'Dates'}{$year}) {
1163
1164 my @periods = ();
1165 if ($year > $$self{'data'}{'LastYear'}) {
1166 # Calculate periods using the LastRule method
1167 @periods = $self->_lastrule($zone,$year);
1168 }
1169
1170 $$self{'data'}{'Zones'}{$zone}{'Dates'}{$year} = [ @periods ];
1171 }
1172
1173 # A faster 'dclone' so we don't return the actual data
11741100ns my @ret;
117512µs foreach my $ele (@{ $$self{'data'}{'Zones'}{$zone}{'Dates'}{$year} }) {
1176 push(@ret,
1177 [ [ @{$$ele[0]} ],[ @{$$ele[1]} ],$$ele[2],[ @{$$ele[3]} ],$$ele[4],$$ele[5],
117814µs [ @{$$ele[6]} ],[ @{$$ele[7]} ],$$ele[8],$$ele[9],$$ele[10],$$ele[11] ]);
1179 }
118014µs return @ret;
1181}
1182
1183
# spent 70µs (37+33) within Date::Manip::TZ::date_period which was called 2 times, avg 35µs/call: # once (24µs+19µs) by Date::Manip::TZ::_config_var_setdate at line 1778 # once (13µs+13µs) by Date::Manip::TZ::_convert at line 1445
sub date_period {
11842900ns my($self,$date,$zone,$wallclock,$isdst) = @_;
11852500ns $wallclock = 0 if (! $wallclock);
11862600ns $isdst = 0 if (! $isdst);
1187
118822µs24µs my $z = $self->_zone($zone);
# spent 4µs making 2 calls to Date::Manip::TZ::_zone, avg 2µs/call
11892400ns if (! $z) {
1190 warn "ERROR: [date_period] Invalid zone: $zone\n";
1191 return;
1192 }
11932300ns $zone = $z;
119422µs23µs $self->_module($zone);
# spent 3µs making 2 calls to Date::Manip::TZ::_module, avg 2µs/call
1195
11962800ns my $dmb = $$self{'base'};
119721µs my @date = @$date;
11982400ns my $year = $date[0];
119923µs214µs my $dates= $dmb->_date_fields(@$date);
# spent 14µs making 2 calls to Date::Manip::Base::_date_fields, avg 7µs/call
1200
12012600ns if ($wallclock) {
1202 # A wallclock date
1203
120422µs212µs my @period = $self->_all_periods($zone,$year);
# spent 12µs making 2 calls to Date::Manip::TZ::_all_periods, avg 6µs/call
12052800ns my $beg = $period[0]->[9];
12062500ns my $end = $period[-1]->[11];
120721µs if (($dates cmp $beg) == -1) {
1208 @period = $self->_all_periods($zone,$year-1);
1209 } elsif (($dates cmp $end) == 1) {
1210 @period = $self->_all_periods($zone,$year+1);
1211 }
1212
12132400ns my(@per);
121421µs foreach my $period (@period) {
121522µs my($begUT,$begLT,$offsetstr,$offset,$abbrev,$dst,$endUT,$endLT,
1216 $begUTs,$begLTs,$endUTs,$endLTs) = @$period;
121723µs if (($dates cmp $begLTs) != -1 && ($dates cmp $endLTs) != 1) {
1218 push(@per,$period);
1219 }
1220 }
1221
122228µs if ($#per == -1) {
1223 return ();
1224 } elsif ($#per == 0) {
1225 return $per[0];
1226 } elsif ($#per == 1) {
1227 if ($per[0][5] == $isdst) {
1228 return $per[0];
1229 } else {
1230 return $per[1];
1231 }
1232 } else {
1233 warn "ERROR: [date_period] Impossible error\n";
1234 return;
1235 }
1236
1237 } else {
1238 # A GMT date
1239
1240 my @period = $self->_all_periods($zone,$year);
1241 foreach my $period (@period) {
1242 my($begUT,$begLT,$offsetstr,$offset,$abbrev,$isdst,$endUT,$endLT,
1243 $begUTs,$begLTs,$endUTs,$endLTs) = @$period;
1244 if (($dates cmp $begUTs) != -1 && ($dates cmp $endUTs) != 1) {
1245 return $period;
1246 }
1247 }
1248 warn "ERROR: [date_period] Impossible error\n";
1249 return;
1250 }
1251}
1252
1253# Calculate critical dates from the last rule. If $endonly is passed
1254# in, it only calculates the ending of the zone period before the
1255# start of the first one. This is necessary so that the last period in
1256# one year can find out when it ends (which is determined in the
1257# following year).
1258#
1259# Returns:
1260# [begUT, begLT, offsetstr, offset, abb, ISDST, endUT, endLT,
1261# begUTstr, begLTstr, endUTstr, endLTstr]
1262# for each.
1263#
1264sub _lastrule {
1265 my($self,$zone,$year,$endonly) = @_;
1266
1267 #
1268 # Get the list of rules (actually, the month in which the
1269 # rule triggers a time change). If there are none, then
1270 # this zone doesn't have a LAST RULE.
1271 #
1272
1273 my @mon = (sort keys
1274 %{ $$self{'data'}{'Zones'}{$zone}{'LastRule'}{'rules'} });
1275 return () if (! @mon);
1276
1277 #
1278 # Analyze each time change.
1279 #
1280
1281 my @dates = ();
1282 my $dmb = $$self{'base'};
1283
1284 my $stdoff = $$self{'data'}{'Zones'}{$zone}{'LastRule'}{'zone'}{'stdoff'};
1285 my $dstoff = $$self{'data'}{'Zones'}{$zone}{'LastRule'}{'zone'}{'dstoff'};
1286
1287 my (@period);
1288
1289 foreach my $mon (@mon) {
1290 my $flag =
1291 $$self{'data'}{'Zones'}{$zone}{'LastRule'}{'rules'}{$mon}{'flag'};
1292 my $dow =
1293 $$self{'data'}{'Zones'}{$zone}{'LastRule'}{'rules'}{$mon}{'dow'};
1294 my $num =
1295 $$self{'data'}{'Zones'}{$zone}{'LastRule'}{'rules'}{$mon}{'num'};
1296 my $isdst=
1297 $$self{'data'}{'Zones'}{$zone}{'LastRule'}{'rules'}{$mon}{'isdst'};
1298 my $time =
1299 $$self{'data'}{'Zones'}{$zone}{'LastRule'}{'rules'}{$mon}{'time'};
1300 my $type =
1301 $$self{'data'}{'Zones'}{$zone}{'LastRule'}{'rules'}{$mon}{'type'};
1302 my $abb =
1303 $$self{'data'}{'Zones'}{$zone}{'LastRule'}{'rules'}{$mon}{'abb'};
1304
1305 # The end of the current period and the beginning of the next
1306 my($endUT,$endLT,$begUT,$begLT) =
1307 $dmb->_critical_date($year,$mon,$flag,$num,$dow,
1308 $isdst,$time,$type,$stdoff,$dstoff);
1309 return ($endUT,$endLT) if ($endonly);
1310
1311 if (@period) {
1312 push(@period,$endUT,$endLT);
1313 push(@dates,[@period]);
1314 }
1315 my $offsetstr = ($isdst ? $dstoff : $stdoff);
1316 my $offset = $dmb->split('offset',$offsetstr);
1317
1318 @period = ($begUT,$begLT,$offsetstr,$offset,$abb,$isdst);
1319 }
1320
1321 push(@period,$self->_lastrule($zone,$year+1,1));
1322 push(@dates,[@period]);
1323
1324 foreach my $period (@dates) {
1325 my($begUT,$begLT,$offsetstr,$offset,$abbrev,$dst,$endUT,$endLT) = @$period;
1326 my $begUTstr = $dmb->join("date",$begUT);
1327 my $begLTstr = $dmb->join("date",$begLT);
1328 my $endUTstr = $dmb->join("date",$endUT);
1329 my $endLTstr = $dmb->join("date",$endLT);
1330 $period = [$begUT,$begLT,$offsetstr,$offset,$abbrev,$dst,$endUT,$endLT,
1331 $begUTstr,$begLTstr,$endUTstr,$endLTstr];
1332 }
1333
1334 return @dates;
1335}
1336
1337########################################################################
1338# CONVERSION
1339########################################################################
1340
1341sub convert {
1342 my($self,$date,$from,$to,$isdst) = @_;
1343 $self->_convert('convert',$date,$from,$to,$isdst);
1344}
1345
1346
# spent 61µs (10+51) within Date::Manip::TZ::convert_to_gmt which was called: # once (10µs+51µs) by Date::Manip::TZ::_config_var_setdate at line 1821
sub convert_to_gmt {
13471700ns my($self,$date,@arg) = @_;
134813µs14µs my($err,$from,$isdst) = _convert_args('convert_to_gmt',@arg);
# spent 4µs making 1 call to Date::Manip::TZ::_convert_args
13491300ns return (1) if ($err);
1350
13511500ns my $dmb = $$self{'base'};
1352
13531200ns if (! $from) {
1354 $from = $self->_now('tz',1);
1355 }
135615µs147µs $self->_convert('convert_to_gmt',$date,$from,'GMT',$isdst);
# spent 47µs making 1 call to Date::Manip::TZ::_convert
1357}
1358
1359sub convert_from_gmt {
1360 my($self,$date,@arg) = @_;
1361 my($err,$to,$isdst) = _convert_args('convert_from_gmt',@arg);
1362 return (1) if ($err);
1363
1364 my $dmb = $$self{'base'};
1365
1366 if (! $to) {
1367 $to = $self->_now('tz',1);
1368 }
1369 $self->_convert('convert_from_gmt',$date,'GMT',$to,$isdst);
1370}
1371
1372sub convert_to_local {
1373 my($self,$date,@arg) = @_;
1374 my($err,$from,$isdst) = _convert_args('convert_to_local',@arg);
1375 return (1) if ($err);
1376
1377 my $dmb = $$self{'base'};
1378
1379 if (! $from) {
1380 $from = 'GMT';
1381 }
1382 $self->_convert('convert_to_local',$date,$from,$self->_now('tz',1),$isdst);
1383}
1384
1385sub convert_from_local {
1386 my($self,$date,@arg) = @_;
1387 my($err,$to,$isdst) = _convert_args('convert_from_local',@arg);
1388 return (1) if ($err);
1389
1390 my $dmb = $$self{'base'};
1391
1392 if (! $to) {
1393 $to = 'GMT';
1394 }
1395 $self->_convert('convert_from_local',$date,$self->_now('tz',1),$to,$isdst);
1396}
1397
1398
# spent 4µs within Date::Manip::TZ::_convert_args which was called: # once (4µs+0s) by Date::Manip::TZ::convert_to_gmt at line 1348
sub _convert_args {
13991600ns my($caller,@args) = @_;
1400
140111µs if ($#args == -1) {
1402 return (0,'',0);
1403 } elsif ($#args == 0) {
1404 if ($args[0] eq '0' ||
1405 $args[0] eq '1') {
1406 return (0,'',$args[0]);
1407 } else {
140813µs return (0,$args[0],0);
1409 }
1410 } elsif ($#args == 1) {
1411 return (0,@args);
1412 } else {
1413 return (1,'',0);
1414 }
1415}
1416
1417
# spent 47µs (16+30) within Date::Manip::TZ::_convert which was called: # once (16µs+30µs) by Date::Manip::TZ::convert_to_gmt at line 1356
sub _convert {
14181600ns my($self,$caller,$date,$from,$to,$isdst) = @_;
14191500ns my $dmb = $$self{'base'};
1420
1421 # Handle $date as a reference and a string
14221100ns my (@date);
142312µs if (ref($date)) {
1424 @date = @$date;
1425 } else {
1426 @date = @{ $dmb->split('date',$date) };
1427 $date = [@date];
1428 }
1429
14301600ns if ($from ne $to) {
143111µs12µs my $tmp = $self->_zone($from);
# spent 2µs making 1 call to Date::Manip::TZ::_zone
14321400ns if (! $tmp) {
1433 return (2);
1434 }
14351200ns $from = $tmp;
1436
14371800ns12µs $tmp = $self->_zone($to);
# spent 2µs making 1 call to Date::Manip::TZ::_zone
14381100ns if (! $tmp) {
1439 return (3);
1440 }
14411400ns $to = $tmp;
1442 }
1443
14441700ns if ($from eq $to) {
144511µs127µs my $per = $self->date_period($date,$from,1,$isdst);
# spent 27µs making 1 call to Date::Manip::TZ::date_period
14461300ns my $offset = $$per[3];
14471400ns my $abb = $$per[4];
144814µs return (0,$date,$offset,$isdst,$abb);
1449 }
1450
1451 # Convert $date from $from to GMT
1452
1453 if ($from ne "Etc/GMT") {
1454 my $per = $self->date_period($date,$from,1,$isdst);
1455 if (! $per) {
1456 return (4);
1457 }
1458 my $offset = $$per[3];
1459 @date = @{ $dmb->calc_date_time(\@date,$offset,1) };
1460 }
1461
1462 # Convert $date from GMT to $to
1463
1464 $isdst = 0;
1465 my $offset = [0,0,0];
1466 my $abb = 'GMT';
1467
1468 if ($to ne "Etc/GMT") {
1469 my $per = $self->date_period([@date],$to,0);
1470 $offset = $$per[3];
1471 $isdst = $$per[5];
1472 $abb = $$per[4];
1473 @date = @{ $dmb->calc_date_time(\@date,$offset) };
1474 }
1475
1476 return (0,[@date],$offset,$isdst,$abb);
1477}
1478
1479########################################################################
1480# REGULAR EXPRESSIONS FOR TIMEZONE INFORMATION
1481########################################################################
1482
1483# Returns a regular expression capable of matching all timezone names
1484# and aliases.
1485#
1486# The regular expression will have the following named matches:
1487# zone = a zone name or alias
1488#
1489sub _zonerx {
1490 my($self) = @_;
1491 return $$self{'data'}{'zonerx'} if (defined $$self{'data'}{'zonerx'});
1492 my @zone = (keys %{ $$self{'data'}{'Alias'} },
1493 keys %{ $$self{'data'}{'MyAlias'} });
1494 @zone = sort _sortByLength(@zone);
1495 foreach my $zone (@zone) {
1496 $zone =~ s/\057/\\057/g; # /
1497 $zone =~ s/\055/\\055/g; # -
1498 $zone =~ s/\056/\\056/g; # .
1499 $zone =~ s/\050/\\050/g; # (
1500 $zone =~ s/\051/\\051/g; # )
1501 $zone =~ s/\053/\\053/g; # +
1502 }
1503 my $re = join('|',@zone);
1504 $$self{'data'}{'zonerx'} = qr/(?<zone>$re)/i;
1505 return $$self{'data'}{'zonerx'};
1506}
1507
1508# Returns a regular expression capable of matching all abbreviations.
1509#
1510# The regular expression will have the following named matches:
1511# abb = a zone abbreviation
1512#
1513sub _abbrx {
1514 my($self) = @_;
1515 return $$self{'data'}{'abbrx'} if (defined $$self{'data'}{'abbrx'});
1516 my @abb = (keys %{ $$self{'data'}{'Abbrev'} },
1517 keys %{ $$self{'data'}{'MyAbbrev'} });
1518 @abb = sort _sortByLength(@abb);
1519 foreach my $abb (@abb) {
1520 $abb =~ s/\055/\\055/g; # -
1521 $abb =~ s/\053/\\053/g; # +
1522 }
1523 my $re = join('|',@abb);
1524 $$self{'data'}{'abbrx'} = qr/(?<abb>$re)/i;
1525 return $$self{'data'}{'abbrx'};
1526}
1527
1528# Returns a regular expression capable of matching a valid timezone as
1529# an offset. Known formats are:
1530# +07 +07 (HST)
1531# +0700 +0700 (HST)
1532# +07:00 +07:00 (HST)
1533# +070000 +070000 (HST)
1534# +07:00:00 +07:00:00 (HST)
1535#
1536# The regular expression will have the following named matches:
1537# off = the offset
1538# abb = the abbreviation
1539#
1540# If $simple is passed in, it will return the simple form (i.e. no
1541# appended abbreviation).
1542#
1543sub _offrx {
1544 my($self,$simple) = @_;
1545 if ($simple) {
1546 return $$self{'data'}{'offsimprx'} if (defined $$self{'data'}{'offsimprx'});
1547 } else {
1548 return $$self{'data'}{'offrx'} if (defined $$self{'data'}{'offrx'});
1549 }
1550
1551 my($hr) = qr/(?:[0-1][0-9]|2[0-3])/; # 00 - 23
1552 my($mn) = qr/(?:[0-5][0-9])/; # 00 - 59
1553 my($ss) = qr/(?:[0-5][0-9])/; # 00 - 59
1554 my($abb)= $self->_abbrx();
1555
1556 my($re) = qr/ (?<off> [+-] (?: $hr:$mn:$ss |
1557 $hr$mn$ss |
1558 $hr:?$mn |
1559 $hr
1560 )
1561 )
1562 (?: \s* (?: \( $abb \) | $abb))? /ix;
1563 my($re2) = qr/ (?<off> [+-] (?: $hr:$mn:$ss |
1564 $hr$mn$ss |
1565 $hr:?$mn |
1566 $hr
1567 )
1568 ) /ix;
1569 my $simprx = qr/(?<tzstring>$re2)/;
1570
1571 $$self{'data'}{'offsimprx'} = $simprx;
1572 $$self{'data'}{'offrx'} = $re;
1573
1574 return $$self{'data'}{'offsimprx'} if ($simple);
1575 return $$self{'data'}{'offrx'};
1576}
1577
1578# Returns a regular expression capable of matching all timezone
1579# information available. It will match a full timezone, an
1580# abbreviation, or an offset/abbreviation combination. The regular
1581# expression will have the following named matches:
1582# tzstring = the full string matched
1583# in addition to the matches from the _zonerx, _abbrx, and _offrx
1584# functions.
1585#
1586sub _zrx {
1587 my($self,$simple) = @_;
1588 return $$self{'data'}{'zrx'} if (defined $$self{'data'}{'zrx'});
1589
1590 my $zonerx = $self->_zonerx(); # (?<zone>america/new_york|...)
1591 my $zoneabbrx = $self->_abbrx(); # (?<abb>edt|est|...)
1592 my $zoneoffrx = $self->_offrx(); # (?<off>07:00) (?<abb>GMT)
1593
1594 my $zrx = qr/(?<tzstring>$zoneabbrx|$zoneoffrx|$zonerx)/;
1595 $$self{'data'}{'zrx'} = $zrx;
1596 return $zrx;
1597}
1598
1599# This sorts from longest to shortest element
1600#
16012202µs2591µs
# spent 374µs (157+217) within Date::Manip::TZ::BEGIN@1601 which was called: # once (157µs+217µs) by Date::Manip::Date::BEGIN@27 at line 1601
no strict 'vars';
# spent 374µs making 1 call to Date::Manip::TZ::BEGIN@1601 # spent 217µs making 1 call to strict::unimport
1602sub _sortByLength {
1603 return (length $b <=> length $a);
1604}
16052761µs261µs
# spent 50µs (40+10) within Date::Manip::TZ::BEGIN@1605 which was called: # once (40µs+10µs) by Date::Manip::Date::BEGIN@27 at line 1605
use strict 'vars';
# spent 50µs making 1 call to Date::Manip::TZ::BEGIN@1605 # spent 10µs making 1 call to strict::import
1606
1607########################################################################
1608# CONFIG VARS
1609########################################################################
1610
1611# This sets a config variable. It also performs all side effects from
1612# setting that variable.
1613#
1614
# spent 1.47ms (11µs+1.46) within Date::Manip::TZ::_config_var_tz which was called: # once (11µs+1.46ms) by Date::Manip::TZ_Base::_config_var at line 32 of Date/Manip/TZ_Base.pm
sub _config_var_tz {
16151600ns my($self,$var,$val) = @_;
1616
161711µs if ($var eq 'tz') {
1618 my $err = $self->_config_var_setdate("now,$val",0);
1619 return if ($err);
1620 $$self{'data'}{'sections'}{'conf'}{'forcedate'} = 0;
1621 $val = 1;
1622
1623 } elsif ($var eq 'setdate') {
162412µs11.46ms my $err = $self->_config_var_setdate($val,0);
# spent 1.46ms making 1 call to Date::Manip::TZ::_config_var_setdate
16251200ns return if ($err);
162612µs $$self{'data'}{'sections'}{'conf'}{'forcedate'} = 0;
16271300ns $val = 1;
1628
1629 } elsif ($var eq 'forcedate') {
1630 my $err = $self->_config_var_setdate($val,1);
1631 return if ($err);
1632 $$self{'data'}{'sections'}{'conf'}{'setdate'} = 0;
1633 $val = 1;
1634
1635 } elsif ($var eq 'configfile') {
1636 $self->_config_file($val);
1637 return;
1638 }
1639
16401600ns my $base = $$self{'base'};
16411900ns $$base{'data'}{'sections'}{'conf'}{$var} = $val;
164212µs return;
1643}
1644
1645
# spent 1.46ms (69µs+1.39) within Date::Manip::TZ::_config_var_setdate which was called: # once (69µs+1.39ms) by Date::Manip::TZ::_config_var_tz at line 1624
sub _config_var_setdate {
16461400ns my($self,$val,$force) = @_;
16471700ns my $base = $$self{'base'};
1648
164916µs12µs my $dstrx = qr/(?:,\s*(stdonly|dstonly|std|dst))?/i;
# spent 2µs making 1 call to Date::Manip::TZ::CORE:qr
165012µs1600ns my $zonrx = qr/,\s*(.+)/;
# spent 600ns making 1 call to Date::Manip::TZ::CORE:qr
165115µs13µs my $da1rx = qr/(\d\d\d\d)(\d\d)(\d\d)(\d\d):(\d\d):(\d\d)/;
# spent 3µs making 1 call to Date::Manip::TZ::CORE:qr
165212µs1700ns my $da2rx = qr/(\d\d\d\d)\-(\d\d)\-(\d\d)\-(\d\d):(\d\d):(\d\d)/;
# spent 700ns making 1 call to Date::Manip::TZ::CORE:qr
16531900ns my $time = time;
1654
16551200ns my($op,$date,$dstflag,$zone,@date,$offset,$abb);
1656
1657 #
1658 # Parse the argument
1659 #
1660
1661134µs228µs if ($val =~ /^now${dstrx}${zonrx}$/oi) {
# spent 22µs making 1 call to Date::Manip::TZ::CORE:regcomp # spent 6µs making 1 call to Date::Manip::TZ::CORE:match
1662 # now,ZONE
1663 # now,DSTFLAG,ZONE
1664 # Sets now to the system date/time but sets the timezone to be ZONE
1665
16661300ns $op = 'nowzone';
166712µs ($dstflag,$zone) = ($1,$2);
1668
1669 } elsif ($val =~ /^zone${dstrx}${zonrx}$/oi) {
1670 # zone,ZONE
1671 # zone,DSTFLAG,ZONE
1672 # Converts 'now' to the alternate zone
1673
1674 $op = 'zone';
1675 ($dstflag,$zone) = ($1,$2);
1676
1677 } elsif ($val =~ /^${da1rx}${dstrx}${zonrx}$/o ||
1678 $val =~ /^${da2rx}${dstrx}${zonrx}$/o) {
1679 # DATE,ZONE
1680 # DATE,DSTFLAG,ZONE
1681 # Sets the date and zone
1682
1683 $op = 'datezone';
1684 my($y,$m,$d,$h,$mn,$s);
1685 ($y,$m,$d,$h,$mn,$s,$dstflag,$zone) = ($1,$2,$3,$4,$5,$6,$7,$8);
1686 $date = [$y,$m,$d,$h,$mn,$s];
1687
1688 } elsif ($val =~ /^${da1rx}$/o ||
1689 $val =~ /^${da2rx}$/o) {
1690 # DATE
1691 # Sets the date in the system timezone
1692
1693 $op = 'date';
1694 my($y,$m,$d,$h,$mn,$s) = ($1,$2,$3,$4,$5,$6);
1695 $date = [$y,$m,$d,$h,$mn,$s];
1696 $zone = $self->_now('systz',1);
1697
1698 } elsif (lc($val) eq 'now') {
1699 # now
1700 # Resets everything
1701
1702 my $systz = $$base{'data'}{'now'}{'systz'};
1703 $base->_init_now();
1704 $$base{'data'}{'now'}{'systz'} = $systz;
1705 return 0;
1706
1707 } else {
1708 warn "ERROR: [config_var] invalid SetDate/ForceDate value: $val\n";
1709 return 1;
1710 }
1711
17121600ns $dstflag = 'std' if (! $dstflag);
1713
1714 #
1715 # Get the date we're setting 'now' to
1716 #
1717
17181700ns if ($op eq 'nowzone') {
1719 # Use the system localtime
1720
172119µs my($s,$mn,$h,$d,$m,$y) = localtime($time);
17221900ns $y += 1900;
17231200ns $m++;
172411µs $date = [$y,$m,$d,$h,$mn,$s];
1725
1726 } elsif ($op eq 'zone') {
1727 # Use the system GMT time
1728
1729 my($s,$mn,$h,$d,$m,$y) = gmtime($time);
1730 $y += 1900;
1731 $m++;
1732 $date = [$y,$m,$d,$h,$mn,$s];
1733 }
1734
1735 #
1736 # Find out what zone was passed in. It can be an alias or an offset.
1737 #
1738
17391400ns if ($zone) {
17401100ns my ($err,@args);
17411700ns push(@args,$date) if ($date);
17421700ns push(@args,$zone);
17431200ns push(@args,$dstflag);
1744
174513µs11.25ms $zone = $self->zone(@args);
# spent 1.25ms making 1 call to Date::Manip::TZ::zone
17461700ns if (! $zone) {
1747 warn "ERROR: [config_var] invalid zone in SetDate: @args\n";
1748 return 1;
1749 }
1750
1751 } else {
1752 $zone = $$base{'data'}{'now'}{'systz'};
1753 }
1754
1755 #
1756 # Handle the zone
1757 #
1758
17591300ns my($isdst,@isdst);
176011µs if ($dstflag eq 'std') {
1761 @isdst = (0,1);
1762 } elsif ($dstflag eq 'stdonly') {
1763 @isdst = (0);
1764 } elsif ($dstflag eq 'dst') {
1765 @isdst = (1,0);
1766 } else {
1767 @isdst = (1);
1768 }
1769
17701700ns if ($op eq 'nowzone' ||
1771 $op eq 'datezone' ||
1772 $op eq 'date') {
1773
1774 # Check to make sure that the date can exist in this zone.
17751200ns my $per;
177611µs foreach my $dst (@isdst) {
17772600ns next if ($per);
177813µs143µs $per = $self->date_period($date,$zone,1,$dst);
# spent 43µs making 1 call to Date::Manip::TZ::date_period
1779 }
1780
17811200ns if (! $per) {
1782 warn "ERROR: [config_var] invalid date: SetDate: $date, $zone\n";
1783 return 1;
1784 }
17851500ns $isdst = $$per[5];
17861300ns $abb = $$per[4];
17871900ns $offset = $$per[3];
1788
1789 } elsif ($op eq 'zone') {
1790
1791 # Convert to that zone
1792 my($err);
1793 ($err,$date,$offset,$isdst,$abb) = $self->convert_from_gmt($date,$zone);
1794 if ($err) {
1795 warn "ERROR: [config_var] invalid SetDate date/offset values: $date, $zone\n";
1796 return 1;
1797 }
1798 }
1799
1800 #
1801 # Set NOW
1802 #
1803
180411µs $$base{'data'}{'now'}{'date'} = $date;
180512µs12µs $$base{'data'}{'now'}{'tz'} = $self->_zone($zone);
# spent 2µs making 1 call to Date::Manip::TZ::_zone
18061600ns $$base{'data'}{'now'}{'isdst'} = $isdst;
180711µs $$base{'data'}{'now'}{'abb'} = $abb;
180811µs $$base{'data'}{'now'}{'offset'} = $offset;
1809
1810 #
1811 # Treate SetDate/ForceDate
1812 #
1813
18141800ns if ($force) {
1815 $$base{'data'}{'now'}{'force'} = 1;
1816 $$base{'data'}{'now'}{'set'} = 0;
1817 } else {
18181800ns $$base{'data'}{'now'}{'force'} = 0;
181911µs $$base{'data'}{'now'}{'set'} = 1;
18201600ns $$base{'data'}{'now'}{'setsecs'} = $time;
182112µs161µs my($err,$setdate) = $self->convert_to_gmt($date,$zone);
# spent 61µs making 1 call to Date::Manip::TZ::convert_to_gmt
18221900ns $$base{'data'}{'now'}{'setdate'} = $setdate;
1823 }
1824
182516µs return 0;
1826}
1827
182813µs1;
1829# Local Variables:
1830# mode: cperl
1831# indent-tabs-mode: nil
1832# cperl-indent-level: 3
1833# cperl-continued-statement-offset: 2
1834# cperl-continued-brace-offset: 0
1835# cperl-brace-offset: 0
1836# cperl-brace-imaginary-offset: 0
1837# cperl-label-offset: 0
1838# End:
 
# spent 1µs within Date::Manip::TZ::CORE:close which was called 2 times, avg 650ns/call: # 2 times (1µs+0s) by Date::Manip::TZ::_get_curr_zone at line 535, avg 650ns/call
sub Date::Manip::TZ::CORE:close; # opcode
# spent 8µs within Date::Manip::TZ::CORE:ftfile which was called 4 times, avg 2µs/call: # 4 times (8µs+0s) by Date::Manip::TZ::_get_curr_zone at line 468, avg 2µs/call
sub Date::Manip::TZ::CORE:ftfile; # opcode
# spent 16µs within Date::Manip::TZ::CORE:match which was called 9 times, avg 2µs/call: # 4 times (5µs+0s) by Date::Manip::TZ::_get_curr_zone at line 477, avg 1µs/call # 2 times (4µs+0s) by Date::Manip::TZ::zone at line 773, avg 2µs/call # 2 times (800ns+0s) by Date::Manip::TZ::_get_curr_zone at line 503, avg 400ns/call # once (6µs+0s) by Date::Manip::TZ::_config_var_setdate at line 1661
sub Date::Manip::TZ::CORE:match; # opcode
# spent 6µs within Date::Manip::TZ::CORE:qr which was called 4 times, avg 2µs/call: # once (3µs+0s) by Date::Manip::TZ::_config_var_setdate at line 1651 # once (2µs+0s) by Date::Manip::TZ::_config_var_setdate at line 1649 # once (700ns+0s) by Date::Manip::TZ::_config_var_setdate at line 1652 # once (600ns+0s) by Date::Manip::TZ::_config_var_setdate at line 1650
sub Date::Manip::TZ::CORE:qr; # opcode
# spent 2µs within Date::Manip::TZ::CORE:readline which was called 2 times, avg 1µs/call: # 2 times (2µs+0s) by Date::Manip::TZ::_get_curr_zone at line 476, avg 1µs/call
sub Date::Manip::TZ::CORE:readline; # opcode
# spent 22µs within Date::Manip::TZ::CORE:regcomp which was called: # once (22µs+0s) by Date::Manip::TZ::_config_var_setdate at line 1661
sub Date::Manip::TZ::CORE:regcomp; # opcode
# spent 1µs within Date::Manip::TZ::CORE:sort which was called: # once (1µs+0s) by Date::Manip::TZ::_all_periods at line 1073
sub Date::Manip::TZ::CORE:sort; # opcode
# spent 12µs within Date::Manip::TZ::CORE:subst which was called 10 times, avg 1µs/call: # 2 times (5µs+0s) by Date::Manip::TZ::_get_curr_zone at line 529, avg 2µs/call # 2 times (4µs+0s) by Date::Manip::TZ::_get_curr_zone at line 528, avg 2µs/call # 2 times (1µs+0s) by Date::Manip::TZ::_get_curr_zone at line 530, avg 600ns/call # 2 times (1µs+0s) by Date::Manip::TZ::_get_curr_zone at line 632, avg 500ns/call # 2 times (800ns+0s) by Date::Manip::TZ::_get_curr_zone at line 531, avg 400ns/call
sub Date::Manip::TZ::CORE:subst; # opcode
Report produced by the NYTProf 5.06 Perl profiler, developed by Tim Bunce and Adam Kaplan.