← Index
NYTProf Performance Profile   « block view • line view • sub view »
For /usr/share/koha/opac/cgi-bin/opac/opac-search.pl
  Run on Tue Oct 15 17:10:45 2013
Reported on Tue Oct 15 17:11:49 2013

Filename/usr/share/perl5/Date/Manip/TZ.pm
StatementsExecuted 394 statements in 10.2ms
Subroutines
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
321513µs762µsDate::Manip::TZ::::_moduleDate::Manip::TZ::_module
211392µs777µsDate::Manip::TZ::::_get_curr_zoneDate::Manip::TZ::_get_curr_zone
111115µs962µsDate::Manip::TZ::::zoneDate::Manip::TZ::zone
211103µs157µsDate::Manip::TZ::::_initDate::Manip::TZ::_init
32197µs117µsDate::Manip::TZ::::_all_periodsDate::Manip::TZ::_all_periods
22288µs174µsDate::Manip::TZ::::date_periodDate::Manip::TZ::date_period
107263µs63µsDate::Manip::TZ::::_zoneDate::Manip::TZ::_zone
11140µs78µsDate::Manip::TZ::::BEGIN@586Date::Manip::TZ::BEGIN@586
11135µs103µsDate::Manip::TZ::::_convertDate::Manip::TZ::_convert
21126µs810µsDate::Manip::TZ::::_set_curr_zoneDate::Manip::TZ::_set_curr_zone
41126µs26µsDate::Manip::TZ::::CORE:ftfileDate::Manip::TZ::CORE:ftfile (opcode)
11125µs39µsDate::Manip::TZ::::BEGIN@18Date::Manip::TZ::BEGIN@18
11123µs137µsDate::Manip::TZ::::convert_to_gmtDate::Manip::TZ::convert_to_gmt
11122µs24µsDate::Manip::TZ::::BEGIN@14Date::Manip::TZ::BEGIN@14
83122µs22µsDate::Manip::TZ::::CORE:matchDate::Manip::TZ::CORE:match (opcode)
11120µs23µsDate::Manip::TZ::::BEGIN@24Date::Manip::TZ::BEGIN@24
11118µs41µsDate::Manip::TZ::::BEGIN@1446Date::Manip::TZ::BEGIN@1446
11118µs18µsDate::Manip::TZ::::_periodsDate::Manip::TZ::_periods
11117µs35µsDate::Manip::TZ::::BEGIN@1450Date::Manip::TZ::BEGIN@1450
11116µs82µsDate::Manip::TZ::::BEGIN@17Date::Manip::TZ::BEGIN@17
11115µs245µsDate::Manip::TZ::::BEGIN@22Date::Manip::TZ::BEGIN@22
21114µs824µsDate::Manip::TZ::::_init_finalDate::Manip::TZ::_init_final
11114µs53µsDate::Manip::TZ::::BEGIN@26Date::Manip::TZ::BEGIN@26
11114µs31µsDate::Manip::TZ::::BEGIN@596Date::Manip::TZ::BEGIN@596
11112µs29µsDate::Manip::TZ::::BEGIN@137Date::Manip::TZ::BEGIN@137
11111µs23µsDate::Manip::TZ::::BEGIN@20Date::Manip::TZ::BEGIN@20
11111µs11µsDate::Manip::TZ::::_convert_argsDate::Manip::TZ::_convert_args
11111µs14µsDate::Manip::TZ::::BEGIN@19Date::Manip::TZ::BEGIN@19
11111µs25µsDate::Manip::TZ::::BEGIN@168Date::Manip::TZ::BEGIN@168
6319µs9µsDate::Manip::TZ::::CORE:substDate::Manip::TZ::CORE:subst (opcode)
2115µs5µsDate::Manip::TZ::::CORE:readlineDate::Manip::TZ::CORE:readline (opcode)
2115µs5µsDate::Manip::TZ::::CORE:closeDate::Manip::TZ::CORE:close (opcode)
1113µs3µ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
0182µsProfile data that couldn't be associated with a specific line:
# spent 82µs making 1 call to Date::Manip::TZ::BEGIN@17
117µspackage Date::Manip::TZ;
2# Copyright (c) 2008-2010 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
14345µs227µs
# spent 24µs (22+2) within Date::Manip::TZ::BEGIN@14 which was called: # once (22µs+2µs) by Date::Manip::Obj::BEGIN@16 at line 14
use Date::Manip::Obj;
# spent 24µs making 1 call to Date::Manip::TZ::BEGIN@14 # spent 2µs making 1 call to UNIVERSAL::import
15114µs@ISA = ('Date::Manip::Obj');
16
17478µs166µs
# spent 82µs (16+66) within Date::Manip::TZ::BEGIN@17 which was called: # once (16µs+66µs) by Date::Manip::Obj::BEGIN@16 at line 0
require 5.010000;
# spent 66µs making 1 call to feature::import
18330µs254µs
# spent 39µs (25+14) within Date::Manip::TZ::BEGIN@18 which was called: # once (25µs+14µs) by Date::Manip::Obj::BEGIN@16 at line 18
use warnings;
# spent 39µs making 1 call to Date::Manip::TZ::BEGIN@18 # spent 14µs making 1 call to warnings::import
19328µs217µs
# spent 14µs (11+3) within Date::Manip::TZ::BEGIN@19 which was called: # once (11µs+3µs) by Date::Manip::Obj::BEGIN@16 at line 19
use strict;
# spent 14µs making 1 call to Date::Manip::TZ::BEGIN@19 # spent 3µs making 1 call to strict::import
20328µs235µs
# spent 23µs (11+12) within Date::Manip::TZ::BEGIN@20 which was called: # once (11µs+12µs) by Date::Manip::Obj::BEGIN@16 at line 20
use feature 'switch';
# spent 23µs making 1 call to Date::Manip::TZ::BEGIN@20 # spent 12µs making 1 call to feature::import
21
22343µs2476µs
# spent 245µs (15+231) within Date::Manip::TZ::BEGIN@22 which was called: # once (15µs+231µs) by Date::Manip::Obj::BEGIN@16 at line 22
use IO::File;
# spent 245µs making 1 call to Date::Manip::TZ::BEGIN@22 # spent 231µs making 1 call to Exporter::import
231340µsrequire Date::Manip::Zones;
24338µs225µs
# spent 23µs (20+2) within Date::Manip::TZ::BEGIN@24 which was called: # once (20µs+2µs) by Date::Manip::Obj::BEGIN@16 at line 24
use Date::Manip::Base;
# spent 23µs making 1 call to Date::Manip::TZ::BEGIN@24 # spent 2µs making 1 call to UNIVERSAL::import
25
263400µs292µs
# spent 53µs (14+39) within Date::Manip::TZ::BEGIN@26 which was called: # once (14µs+39µs) by Date::Manip::Obj::BEGIN@16 at line 26
use vars qw($VERSION);
# spent 53µs making 1 call to Date::Manip::TZ::BEGIN@26 # spent 39µs making 1 call to vars::import
2713µs$VERSION='6.11';
28
29########################################################################
30# BASE METHODS
31########################################################################
32
33
# spent 157µs (103+54) within Date::Manip::TZ::_init which was called 2 times, avg 78µs/call: # 2 times (103µs+54µs) by Date::Manip::Obj::new at line 152 of Date/Manip/Obj.pm, avg 78µs/call
sub _init {
3410100µs my($self) = @_;
35
36 $$self{'data'} =
37 {
38 # These are the variables defined in Date::Manip::Zones
39 'Module' => \%Date::Manip::Zones::Module,
40 'ZoneNames' => \%Date::Manip::Zones::ZoneNames,
41 'Alias' => \%Date::Manip::Zones::Alias,
42 'Abbrev' => \%Date::Manip::Zones::Abbrev,
43 'Offmod' => \%Date::Manip::Zones::Offmod,
44 'FirstDate' => $Date::Manip::Zones::FirstDate,
45 'LastDate' => $Date::Manip::Zones::LastDate,
46 'LastYear' => $Date::Manip::Zones::LastYear,
47
48 # These override values from Date::Manip::Zones
49 'MyAlias' => {},
50 'MyAbbrev' => {},
51 'MyOffsets' => {},
52
53 # Each timezone/offset module that is loaded goes here
54 'Zones' => {},
55 'Offsets' => {},
56
57 # methods a list of methods used for determining the
58 # current zone
59 # dates critical dates on a per/year (UT) basis
60 # zonerx the regular expression for matching timezone
61 # names/aliases
62 # abbrx the regular expression for matching timezone
63 # abbreviations
64 # offrx the regular expression for matching a valid
65 # timezone offset
66 # zrx the regular expression to match all timezone
67 # information
68 'methods' => [],
69 'zonerx' => undef,
70 'abbrx' => undef,
71 'offrx' => undef,
72 'zrx' => undef,
73 };
74
75 # OS specific stuff
76
77 my $dmb = $$self{'objs'}{'base'};
78254µs my $os = $dmb->_os();
# spent 54µs making 2 calls to Date::Manip::Base::_os, avg 27µs/call
79
80 if ($os eq 'Unix') {
81 $$self{'data'}{'methods'} = [
82 qw(main TZ
83 env TZ
84 file /etc/TIMEZONE
85 file /etc/timezone
86 file /etc/sysconfig/clock
87 file /etc/default/init
88 ),
89 'command', '/bin/date +%Z',
90 'command', '/usr/bin/date +%Z',
91 'command', '/usr/local/bin/date +%Z',
92 qw(cmdfield /bin/date -2
93 cmdfield /usr/bin/date -2
94 cmdfield /usr/local/bin/date -2
95 gmtoff
96 ),
97 ];
98
99 } elsif ($os eq 'Windows') {
100 $$self{'data'}{'methods'} = [
101 qw(main TZ
102 env TZ
103 registry
104 gmtoff),
105 ];
106
107 } elsif ($os eq 'VMS') {
108 $$self{'data'}{'methods'} = [
109 qw(main TZ
110 env TZ
111 env SYS$TIMEZONE_RULE
112 env SYS$TIMEZONE_NAME
113 env UCX$TZ
114 env TCPIP$TZ
115 env MULTINET_TIMEZONE
116 env SYS$TIMEZONE_DIFFERENTIAL
117 gmtoff
118 ),
119 ];
120
121 } else {
122 $$self{'data'}{'methods'} = [
123 qw(main TZ
124 env TZ
125 gmtoff
126 ),
127 ];
128 }
129}
130
131
# spent 824µs (14+810) within Date::Manip::TZ::_init_final which was called 2 times, avg 412µs/call: # 2 times (14µs+810µs) by Date::Manip::Obj::new at line 161 of Date/Manip/Obj.pm, avg 412µs/call
sub _init_final {
132414µs my($self) = @_;
133
1342810µs $self->_set_curr_zone();
# spent 810µs making 2 calls to Date::Manip::TZ::_set_curr_zone, avg 405µs/call
135}
136
1373268µs246µs
# spent 29µs (12+17) within Date::Manip::TZ::BEGIN@137 which was called: # once (12µs+17µs) by Date::Manip::Obj::BEGIN@16 at line 137
no strict 'refs';
# spent 29µs making 1 call to Date::Manip::TZ::BEGIN@137 # spent 17µs making 1 call to strict::unimport
138# This loads data from an offset module
139#
140sub _offmod {
141 my($self,$offset) = @_;
142 return if (exists $$self{'data'}{'Offsets'}{$offset});
143
144 my $mod = $$self{'data'}{'Offmod'}{$offset};
145 eval "require Date::Manip::Offset::${mod}";
146 my %off = %{ "Date::Manip::Offset::${mod}::Offset" };
147
148 $$self{'data'}{'Offsets'}{$offset} = { %off };
149}
150
151# This loads data from a zone module (takes a lowercase zone)
152#
153
# spent 762µs (513+249) within Date::Manip::TZ::_module which was called 3 times, avg 254µs/call: # 2 times (7µs+0s) by Date::Manip::TZ::date_period at line 1056, avg 3µs/call # once (506µs+249µs) by Date::Manip::TZ::zone at line 782
sub _module {
1541199µs my($self,$zone) = @_;
155 return if (exists $$self{'data'}{'Zones'}{$zone}{'Loaded'});
156
157 my $mod = $$self{'data'}{'Module'}{$zone};
158 eval "require Date::Manip::TZ::${mod}";
# spent 155µs executing statements in string eval
159 my %dates = %{ "Date::Manip::TZ::${mod}::Dates" };
160 my %last = %{ "Date::Manip::TZ::${mod}::LastRule" };
161 $$self{'data'}{'Zones'}{$zone} =
162 {
163 'Dates' => { %dates },
164 'LastRule' => { %last },
165 'Loaded' => 1
166 };
167}
16832.59ms240µs
# spent 25µs (11+15) within Date::Manip::TZ::BEGIN@168 which was called: # once (11µs+15µs) by Date::Manip::Obj::BEGIN@16 at line 168
use strict 'refs';
# spent 25µs making 1 call to Date::Manip::TZ::BEGIN@168 # spent 15µs making 1 call to strict::import
169
170########################################################################
171# CHECKING/MODIFYING ZONEINFO DATA
172########################################################################
173
174
# spent 63µs within Date::Manip::TZ::_zone which was called 10 times, avg 6µs/call: # 2 times (24µs+0s) by Date::Manip::TZ::_get_curr_zone at line 500, avg 12µs/call # 2 times (7µs+0s) by Date::Manip::TZ::date_period at line 1050, avg 4µs/call # 2 times (7µs+0s) by Date::Manip::TZ::_set_curr_zone at line 367, avg 3µs/call # once (10µs+0s) by Date::Manip::Base::_config_var_setdate at line 1799 of Date/Manip/Base.pm # once (7µs+0s) by Date::Manip::TZ::zone at line 638 # once (4µs+0s) by Date::Manip::TZ::_convert at line 1299 # once (3µs+0s) by Date::Manip::TZ::_convert at line 1293
sub _zone {
1753085µs my($self,$zone) = @_;
176 $zone = lc($zone);
177
178 if (exists $$self{'data'}{'MyAlias'}{$zone}) {
179 return $$self{'data'}{'MyAlias'}{$zone};
180 } elsif (exists $$self{'data'}{'Alias'}{$zone}) {
181 return $$self{'data'}{'Alias'}{$zone};
182 } else {
183 return '';
184 }
185}
186
187sub tzdata {
188 my($self) = @_;
189 return $Date::Manip::Zones::TzdataVersion;
190}
191
192sub tzcode {
193 my($self) = @_;
194 return $Date::Manip::Zones::TzcodeVersion;
195}
196
197sub define_alias {
198 my($self,$alias,$zone) = @_;
199 $alias = lc($alias);
200
201 if ($alias eq 'reset') {
202 $$self{'data'}{'MyAlias'} = {};
203 $$self{'data'}{'zonerx'} = undef;
204 return 0;
205 }
206 if (lc($zone) eq 'reset') {
207 delete $$self{'data'}{'MyAlias'}{$alias};
208 $$self{'data'}{'zonerx'} = undef;
209 return 0;
210 }
211
212 $zone = $self->_zone($zone);
213
214 return 1 if (! $zone);
215 $$self{'data'}{'MyAlias'}{$alias} = $zone;
216 $$self{'data'}{'zonerx'} = undef;
217 return 0;
218}
219
220sub define_abbrev {
221 my($self,$abbrev,@zone) = @_;
222 $abbrev = lc($abbrev);
223
224 if ($abbrev eq 'reset') {
225 $$self{'data'}{'MyAbbrev'} = {};
226 $$self{'data'}{'abbrx'} = undef;
227 return 0;
228 }
229 if ($#zone == 0 && lc($zone[0]) eq 'reset') {
230 delete $$self{'data'}{'MyAbbrev'}{$abbrev};
231 $$self{'data'}{'abbrx'} = undef;
232 return (0);
233 }
234
235 if (! exists $$self{'data'}{'Abbrev'}{$abbrev}) {
236 return (1);
237 }
238
239 my (@z,%z);
240 my %zone = map { $_,1 } @{ $$self{'data'}{'Abbrev'}{$abbrev} };
241 foreach my $z (@zone) {
242 my $zone = $self->_zone($z);
243 return (2,$z) if (! $zone);
244 return (3,$z) if (! exists $zone{$zone});
245 next if (exists $z{$zone});
246 $z{$zone} = 1;
247 push(@z,$zone);
248 }
249
250 $$self{'data'}{'MyAbbrev'}{$abbrev} = [ @z ];
251 $$self{'data'}{'abbrx'} = undef;
252 return ();
253}
254
255sub define_offset {
256 my($self,$offset,@args) = @_;
257 my $dmb = $$self{'objs'}{'base'};
258
259 if (lc($offset) eq 'reset') {
260 $$self{'data'}{'MyOffsets'} = {};
261 return (0);
262 }
263 if ($#args == 0 && lc($args[0]) eq 'reset') {
264 delete $$self{'data'}{'MyOffsets'}{$offset};
265 return (0);
266 }
267
268 # Check that $offset is valid. If it is, load the
269 # appropriate module.
270
271 if (ref($offset)) {
272 $offset = $dmb->join('offset',$offset);
273 } else {
274 $offset = $dmb->_delta_convert('offset',$offset);
275 }
276 return (9) if (! $offset);
277 return (1) if (! exists $$self{'data'}{'Offmod'}{$offset});
278
279 $self->_offmod($offset);
280
281 # Find out whether we're handling STD, DST, or both.
282
283 my(@isdst) = (0,1);
284 if ($args[0] =~ /^std|dst|stdonly|dstonly$/i) {
285 my $tmp = lc(shift(@args));
286 if ($tmp eq 'stdonly') {
287 @isdst = (0);
288 } elsif ($tmp eq 'dstonly') {
289 @isdst = (1);
290 }
291 }
292 my @zone = @args;
293
294 if ($#isdst == 0 &&
295 ! exists($$self{'data'}{'Offsets'}{$offset}{$isdst[0]})) {
296 return (2);
297 }
298
299 # Check to see that each zone is valid, and contains this offset.
300
301 my %tmp;
302 foreach my $isdst (0,1) {
303 next if (! exists $$self{'data'}{'Offsets'}{$offset}{$isdst});
304 my @z = @{ $$self{'data'}{'Offsets'}{$offset}{$isdst} };
305 $tmp{$isdst} = { map { $_,1 } @z };
306 }
307
308 foreach my $z (@zone) {
309 my $lcz = lc($z);
310 if (! exists $$self{'data'}{'ZoneNames'}{$lcz}) {
311 return (3,$z);
312 } elsif (! exists $tmp{0}{$lcz} &&
313 ! exists $tmp{1}{$lcz}) {
314 return (4,$z);
315 } elsif ($#isdst == 0 &&
316 ! exists $tmp{$isdst[0]}{$lcz}) {
317 return (5,$z);
318 }
319 $z = $lcz;
320 }
321
322 # Set the zones accordingly.
323
324 foreach my $isdst (@isdst) {
325 my @z;
326 foreach my $z (@zone) {
327 push(@z,$z) if (exists $tmp{$isdst}{$z});
328 }
329 $$self{'data'}{'MyOffsets'}{$offset}{$isdst} = [ @z ];
330 }
331
332 return (0);
333}
334
335########################################################################
336# SYSTEM ZONE
337########################################################################
338
339sub curr_zone {
340 my($self,$reset) = @_;
341 my $dmb = $$self{'objs'}{'base'};
342
343 if ($reset) {
344 $self->_set_curr_zone();
345 }
346
347 my($ret) = $dmb->_now('systz',1);
348 return $$self{'data'}{'ZoneNames'}{$ret}
349}
350
351sub curr_zone_methods {
352 my($self,@methods) = @_;
353
354 if (${^TAINT}) {
355 warn "ERROR: [curr_zone_methods] not allowed when taint checking on\n";
356 return;
357 }
358
359 $$self{'data'}{'methods'} = [ @methods ];
360}
361
362
# spent 810µs (26+784) within Date::Manip::TZ::_set_curr_zone which was called 2 times, avg 405µs/call: # 2 times (26µs+784µs) by Date::Manip::TZ::_init_final at line 134, avg 405µs/call
sub _set_curr_zone {
363822µs my($self) = @_;
364 my $dmb = $$self{'objs'}{'base'};
3652777µs my $currzone = $self->_get_curr_zone();
# spent 777µs making 2 calls to Date::Manip::TZ::_get_curr_zone, avg 389µs/call
366
36727µs $$dmb{'data'}{'now'}{'systz'} = $self->_zone($currzone);
# spent 7µs making 2 calls to Date::Manip::TZ::_zone, avg 3µs/call
368}
369
370# This determines the system timezone using all of the methods
371# applicable to the operating system. The first match is used.
372#
373
# spent 777µs (392+385) within Date::Manip::TZ::_get_curr_zone which was called 2 times, avg 389µs/call: # 2 times (392µs+385µs) by Date::Manip::TZ::_set_curr_zone at line 365, avg 389µs/call
sub _get_curr_zone {
3742096µs my($self) = @_;
375 my $dmb = $$self{'objs'}{'base'};
376
377 my $t = time;
378 my($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime($t);
379 my $currzone = '';
380 my $dstflag = ($isdst ? 'dstonly' : 'stdonly');
381
382 my (@methods) = @{ $$self{'data'}{'methods'} };
383 METHOD: while (@methods) {
3843040µs my $method = shift(@methods);
385 my @zone = ();
386
3871823µs given ($method) {
388
38969µs when ('main') {
390 if (! @methods) {
391 warn "ERROR: [_set_curr_zone] main requires argument\n";
392 return;
393 }
394 my $var = shift(@methods);
395 push(@zone,$$::var) if (defined $$::var);
396 }
397
398612µs when ('env') {
399 if (! @methods) {
400 warn "ERROR: [_set_curr_zone] env requires argument\n";
401 return;
402 }
403 my $var = shift(@methods);
404 push(@zone,$ENV{$var}) if (exists $ENV{$var});
405 }
406
40722163µs when ('file') {
408 if (! @methods) {
409 warn "ERROR: [_set_curr_zone] file requires argument\n";
410 return;
411 }
412 my $file = shift(@methods);
413426µs next if (! -f $file);
# spent 26µs making 4 calls to Date::Manip::TZ::CORE:ftfile, avg 6µs/call
414
4152132µs my $in = new IO::File;
# spent 132µs making 2 calls to IO::File::new, avg 66µs/call
4162102µs $in->open($file) || next;
# spent 102µs making 2 calls to IO::File::open, avg 51µs/call
417 my $firstline = 1;
418256µs while (! $in->eof) {
# spent 56µs making 2 calls to IO::Handle::eof, avg 28µs/call
419854µs25µs my $line = <$in>;
# spent 5µs making 2 calls to Date::Manip::TZ::CORE:readline, avg 3µs/call
420410µs next if ($line =~ /^\s*\043/ ||
# spent 10µs making 4 calls to Date::Manip::TZ::CORE:match, avg 2µs/call
421 $line =~ /^\s*$/);
42224µs if ($line =~ /^\s*(?:TZ|TIMEZONE|ZONE)\s*=\s*(\S+)/i) {
# spent 4µs making 2 calls to Date::Manip::TZ::CORE:match, avg 2µs/call
423 my $zone = $1;
424 $zone =~ s/["']//g; # "
425 push(@zone,$zone);
426 last;
427 }
428824µs213µs if ($firstline) {
# spent 13µs making 2 calls to IO::Handle::eof, avg 7µs/call
429 $firstline = 0;
43026µs $line =~ s/\s//g;
# spent 6µs making 2 calls to Date::Manip::TZ::CORE:subst, avg 3µs/call
43122µs $line =~ s/["']//g; # "
# spent 2µs making 2 calls to Date::Manip::TZ::CORE:subst, avg 1µs/call
432 push(@zone,$line);
433 }
434 }
43525µs close(IN);
# spent 5µs making 2 calls to Date::Manip::TZ::CORE:close, avg 2µs/call
436 }
437
438 when ('command') {
439 if (! @methods) {
440 warn "ERROR: [_set_curr_zone] command requires argument\n";
441 return;
442 }
443 my $command = shift(@methods);
444 my ($out) = _cmd($command);
445 push(@zone,$out) if ($out);
446 }
447
448 when ('cmdfield') {
449 if ($#methods < 1) {
450 warn "ERROR: [_set_curr_zone] cmdfield requires 2 arguments\n";
451 return;
452 }
453 my $command = shift(@methods);
454 my $n = shift(@methods);
455 my ($out) = _cmd($command);
456 if ($out) {
457 $out =~ s/^\s*//;
458 $out =~ s/\s*$//;
459 my @out = split(/\s+/,$out);
460 push(@zone,$out[$n]) if (defined $out[$n]);
461 }
462 }
463
464 when ('gmtoff') {
465 my($secUT,$minUT,$hourUT,$mdayUT,$monUT,$yearUT,$wdayUT,$ydayUT,
466 $isdstUT) = gmtime($t);
467 if ($mdayUT>($mday+1)) {
468 # UT = 28-31 LT = 1
469 $mdayUT=0;
470 } elsif ($mdayUT<($mday-1)) {
471 # UT = 1 LT = 28-31
472 $mday=0;
473 }
474 $sec = (($mday*24 + $hour)*60 + $min)*60 + $sec;
475 $secUT = (($mdayUT*24 + $hourUT)*60 + $minUT)*60 + $secUT;
476 my $off = $sec-$secUT;
477
478 $off = $dmb->_delta_convert('time',"0:0:$off");
479 $off = $dmb->_delta_convert('offset',$off);
480 push(@zone,$off);
481 }
482
483 when ('registry') {
484 my $z = $self->_windows_registry_val();
485 push(@zone,$z) if ($z);
486 }
487
488 default {
489 warn "ERROR: [_set_curr_zone] invalid method: $method\n";
490 return;
491 }
492 }
493
494 foreach my $zone (@zone) {
495828µs $zone = lc($zone);
496 # OpenUNIX puts a colon at the start
49722µs $zone =~ s/^://;
# spent 2µs making 2 calls to Date::Manip::TZ::CORE:subst, avg 850ns/call
498
499 # If we got a zone name/alias
500224µs $currzone = $self->_zone($zone);
# spent 24µs making 2 calls to Date::Manip::TZ::_zone, avg 12µs/call
501 last METHOD if ($currzone);
502
503 # If we got an abbreviation (EST)
504 if (exists $$self{'data'}{'Abbrev'}{$zone}) {
505 $currzone = $$self{'data'}{'Abbrev'}{$zone}[0];
506 last METHOD;
507 }
508
509 # If we got an offset
510
511 $currzone = $self->zone($zone,$dstflag);
512 last METHOD if ($currzone);
513 }
514 }
515
516 if (! $currzone) {
517 warn "ERROR: Date::Manip unable to determine Time Zone.\n";
518 die;
519 }
520
521 return $currzone;
522}
523
524# This comes from the DateTime-TimeZone module
525#
526sub _windows_registry_val {
527 my($self) = @_;
528
529 require Win32::TieRegistry;
530
531 my $lmachine = new Win32::TieRegistry 'LMachine',
532 { Access => Win32::TieRegistry::KEY_READ(),
533 Delimiter => '/' }
534 or return '';
535
536 my $tzinfo = $lmachine->Open('SYSTEM/CurrentControlSet/Control/TimeZoneInformation/');
537
538 #
539 # Windows Vista, Windows 2008 Server
540 #
541
542 my $tzkn = $tzinfo->GetValue('TimeZoneKeyName');
543 if (defined($tzkn) && $tzkn) {
544 # For some reason, Vista is tacking on a bunch of stuff at the
545 # end of the timezone, starting with a chr(0). Strip it off.
546
547 my $c = chr(0);
548 my $i = index($tzkn,$c);
549 if ($i != -1) {
550 $tzkn = substr($tzkn,0,$i);
551 }
552 my $z = $self->_zone($tzkn);
553 return $z if ($z);
554 }
555
556 #
557 # Windows NT, Windows 2000, Windows XP, Windows 2003 Server
558 #
559
560 my $stdnam = $tzinfo->GetValue('StandardName');
561 my $z = $self->_zone($stdnam);
562 return $z if ($z);
563
564 #
565 # For non-English versions, we have to determine which timezone it
566 # actually is.
567 #
568
569 my $atz = $lmachine->Open('SOFTWARE/Microsoft/Windows NT/CurrentVersion/Time Zones/');
570 if (! defined($atz) || ! $atz) {
571 $atz = $lmachine->Open('SOFTWARE/Microsoft/Windows/CurrentVersion/Time Zones/');
572 }
573
574 return "" if (! defined($atz) || ! $atz);
575
576 foreach my $z ($atz->SubKeyNames()) {
577 my $tmp = $atz->Open("$z/");
578 my $znam = $tmp->GetValue('Std');
579 return $z if ($znam eq $stdnam);
580 }
581}
582
583# We will be testing commands that don't exist on all architectures,
584# so disable warnings.
585#
5863217µs2115µs
# spent 78µs (40+37) within Date::Manip::TZ::BEGIN@586 which was called: # once (40µs+37µs) by Date::Manip::Obj::BEGIN@16 at line 586
no warnings;
# spent 78µs making 1 call to Date::Manip::TZ::BEGIN@586 # spent 37µs making 1 call to warnings::unimport
587sub _cmd {
588 my($cmd) = @_;
589 local(*IN);
590 open(IN,"$cmd |") || return ();
591 my @out = <IN>;
592 close(IN);
593 chomp(@out);
594 return @out;
595}
59634.79ms249µs
# spent 31µs (14+17) within Date::Manip::TZ::BEGIN@596 which was called: # once (14µs+17µs) by Date::Manip::Obj::BEGIN@16 at line 596
use warnings;
# spent 31µs making 1 call to Date::Manip::TZ::BEGIN@596 # spent 17µs making 1 call to warnings::import
597
598########################################################################
599# DETERMINING A TIMEZONE
600########################################################################
601
602
# spent 962µs (115+847) within Date::Manip::TZ::zone which was called: # once (115µs+847µs) by Date::Manip::Base::_config_var_setdate at line 1739 of Date/Manip/Base.pm
sub zone {
6031120µs my($self,@args) = @_;
604 my $dmb = $$self{'objs'}{'base'};
605 if (! @args) {
606 my($tz) = $dmb->_now('tz',1);
607 return $$self{'data'}{'ZoneNames'}{$tz}
608 }
609
610 # Parse the arguments
611
612 my($zone,$abbrev,$offset,$dstflag) = ('','','','');
613 my(@abbrev,$date,$tmp);
614 foreach my $arg (@args) {
615
616834µs if (ref($arg) eq 'ARRAY') {
6172900ns if ($#$arg == 5) {
618 # [Y,M,D,H,Mn,S]
619 return undef if ($date);
620 $date = $arg;
621
622 } elsif ($#$arg == 2) {
623 # [H,Mn,S]
624 return undef if ($offset);
625 $offset = $dmb->join('offset',$arg);
626 return undef if (! $offset);
627
628 } else {
629 return undef;
630 }
631
632 } elsif (ref($arg)) {
633 return undef;
634
635 } else {
636 $arg = lc($arg);
637
63843µs315µs if ($arg =~ /^(std|dst|stdonly|dstonly)$/) {
# spent 8µs making 2 calls to Date::Manip::TZ::CORE:match, avg 4µs/call # spent 7µs making 1 call to Date::Manip::TZ::_zone
639 return undef if ($dstflag);
640 $dstflag = $arg;
641
642 } elsif ($tmp = $self->_zone($arg)) {
643 return undef if ($zone);
644 $zone = $tmp;
645
646 } elsif (exists $$self{'data'}{'MyAbbrev'}{$arg}) {
647 return undef if (@abbrev);
648 $abbrev = $arg;
649 @abbrev = @{ $$self{'data'}{'MyAbbrev'}{$arg} };
650 } elsif (exists $$self{'data'}{'Abbrev'}{$arg}) {
651 return undef if (@abbrev);
652 $abbrev = $arg;
653 @abbrev = @{ $$self{'data'}{'Abbrev'}{$arg} };
654
655 } elsif ($tmp = $dmb->split('offset',$arg)) {
656 return undef if ($offset);
657 $offset = $dmb->_delta_convert('offset',$arg);
658
659 } elsif ($tmp = $dmb->split('date',$arg)) {
660 return undef if ($date);
661 $date = $tmp;
662
663 } else {
664 return undef;
665 }
666 }
667 }
668
669 #
670 # Determine the zones that match all data.
671 #
672
673 my @zone;
674
675 while (1) {
676
677 # No information
678
67999µs if (! $zone &&
680 ! $abbrev &&
681 ! $offset) {
682 my($z) = $dmb->_now('tz',1);
683 @zone = (lc($z));
684 }
685
686 # $dstflag
687 #
688 # $dstflag is "dst' if
689 # zone is passed in as an offset
690 # date is passed in
691
692 $dstflag = "dst" if ($offset && $date && ! $dstflag);
693
694 my(@isdst);
69512µs if ($dstflag eq 'stdonly') {
696 @isdst = (0);
697 } elsif ($dstflag eq 'dstonly') {
698 @isdst = (1);
699 } elsif ($dstflag eq 'dst') {
700 @isdst = (1,0);
701 } else {
702 @isdst = (0,1);
703 }
704
705 # $zone
706
707 if ($zone) {
708 @zone = ($zone);
709 }
710
711 # $abbrev
712
713 if ($abbrev) {
714 my @z;
715 foreach my $isdst (@isdst) {
716 my @tmp = $self->_check_abbrev_isdst($abbrev,$isdst,@abbrev);
717 if (@tmp) {
718 if (@z) {
719 @z = _list_add(\@z,\@tmp);
720 } else {
721 @z = @tmp;
722 }
723 }
724 }
725
726 if (@zone) {
727 @zone = _list_union(\@z,\@zone);
728 } else {
729 @zone = @z;
730 }
731 last if (! @zone);
732 }
733
734 # $offset
735
736 if ($offset) {
737 return undef if (! exists $$self{'data'}{'Offmod'}{$offset});
738 $self->_offmod($offset);
739
740 my @z;
741 foreach my $isdst (@isdst) {
742 my @tmp;
743 if (exists $$self{'data'}{'MyOffsets'}{$offset}{$isdst}) {
744 @tmp = @{ $$self{'data'}{'MyOffsets'}{$offset}{$isdst} };
745 } elsif (exists $$self{'data'}{'Offsets'}{$offset}{$isdst}) {
746 @tmp = @{ $$self{'data'}{'Offsets'}{$offset}{$isdst} };
747 }
748 @tmp = $self->_check_offset_abbrev_isdst($offset,$abbrev,$isdst,@tmp)
749 if ($abbrev);
750 if (@tmp) {
751 if (@z) {
752 @z = _list_add(\@z,\@tmp);
753 } else {
754 @z = @tmp;
755 }
756 }
757 }
758
759 if (@zone) {
760 @zone = _list_union(\@zone,\@z);
761 } else {
762 @zone = @z;
763 }
764 last if (! @zone);
765 }
766
767 # $date
768
769712µs if ($date) {
770 # Get all periods for the year.
771 #
772 # Test all periods to make sure that $date is between the
773 # wallclock times AND matches other criteria. All periods
774 # must be tested since the same wallclock time can be in
775 # multiple periods.
776
777 my @tmp;
778 my $isdst = '';
779 $isdst = 0 if ($dstflag eq 'stdonly');
780 $isdst = 1 if ($dstflag eq 'dstonly');
781 ZONE: foreach my $z (@zone) {
782413µs1755µs $self->_module($z);
# spent 755µs making 1 call to Date::Manip::TZ::_module
783 my $y = $$date[0];
784170µs my @periods = $self->_all_periods($z,$y);
# spent 70µs making 1 call to Date::Manip::TZ::_all_periods
785
786 foreach my $period (@periods) {
787413µs my($begUT,$begLT,$off,$offref,$abb,$dst,$endUT,$endLT) = @$period;
78827µs next if ($dmb->cmp($date,$begLT) == -1 ||
# spent 7µs making 2 calls to Date::Manip::Base::cmp, avg 3µs/call
789 $dmb->cmp($date,$endLT) == 1 ||
790 ($offset ne '' && $offset ne $off) ||
791 ($isdst ne '' && $isdst ne $dst) ||
792 ($abbrev ne '' && lc($abbrev) ne lc($abb))
793 );
794 push(@tmp,$z);
795 next ZONE;
796 }
797 }
798 @zone = @tmp;
799 last if (! @zone);
800 }
801
802 last;
803 }
804
805 # Return the value/list
806
807 if (wantarray) {
808 my @ret;
809 foreach my $z (@zone) {
810 push(@ret,$$self{'data'}{'ZoneNames'}{$z});
811 }
812 return @ret;
813 }
814
815 return '' if (! @zone);
816 return $$self{'data'}{'ZoneNames'}{$zone[0]}
817}
818
819# This returns a list of all timezones which have the correct
820# abbrev/isdst combination.
821#
822sub _check_abbrev_isdst {
823 my($self,$abbrev,$isdst,@zones) = @_;
824
825 my @ret;
826 ZONE: foreach my $zone (@zones) {
827 $self->_module($zone);
828
829 foreach my $y (sort keys %{ $$self{'data'}{'Zones'}{$zone}{'Dates'} }) {
830 my @periods = @{ $$self{'data'}{'Zones'}{$zone}{'Dates'}{$y} };
831 foreach my $period (@periods) {
832 my($dateUT,$dateLT,$off,$offref,$abb,$dst,$endUT,$endLT) = @$period;
833 next if (lc($abbrev) ne lc($abb) ||
834 $isdst != $dst);
835 push(@ret,$zone);
836 next ZONE;
837 }
838 }
839 }
840
841 return @ret;
842}
843
844# This returns a list of all timezones which have the correct
845# abbrev/isdst combination.
846#
847sub _check_offset_abbrev_isdst {
848 my($self,$offset,$abbrev,$isdst,@zones) = @_;
849
850 my @ret;
851 ZONE: foreach my $zone (@zones) {
852 $self->_module($zone);
853
854 foreach my $y (sort keys %{ $$self{'data'}{'Zones'}{$zone}{'Dates'} }) {
855 my @periods = @{ $$self{'data'}{'Zones'}{$zone}{'Dates'}{$y} };
856 foreach my $period (@periods) {
857 my($dateUT,$dateLT,$off,$offref,$abb,$dst,$endUT,$endLT) = @$period;
858 next if (lc($abbrev) ne lc($abb) ||
859 $offset ne $off ||
860 $isdst != $dst);
861 push(@ret,$zone);
862 next ZONE;
863 }
864 }
865 }
866
867 return @ret;
868}
869
870# This finds the elements common to two lists, and preserves the order
871# from the first list.
872#
873sub _list_union {
874 my($list1,$list2) = @_;
875 my(%list2) = map { $_,1 } @$list2;
876 my(@ret);
877 foreach my $ele (@$list1) {
878 push(@ret,$ele) if (exists $list2{$ele});
879 }
880 return @ret;
881}
882
883# This adds elements from the second list to the first list, provided
884# they are not already there.
885#
886sub _list_add {
887 my($list1,$list2) = @_;
888 my(%list1) = map { $_,1 } @$list1;
889 my(@ret) = @$list1;
890 foreach my $ele (@$list2) {
891 next if (exists $list1{$ele});
892 push(@ret,$ele);
893 $list1{$ele} = 1;
894 }
895 return @ret;
896}
897
898########################################################################
899# PERIODS METHODS
900########################################################################
901
902sub all_periods {
903 my($self,$zone,$year) = @_;
904
905 my $z = $self->_zone($zone);
906 if (! $z) {
907 warn "ERROR: [periods] Invalid zone: $zone\n";
908 return;
909 }
910 $zone = $z;
911 $self->_module($zone);
912
913 return $self->_all_periods($zone,$year);
914}
915
916
# spent 117µs (97+21) within Date::Manip::TZ::_all_periods which was called 3 times, avg 39µs/call: # 2 times (47µs+0s) by Date::Manip::TZ::date_period at line 1066, avg 24µs/call # once (49µs+21µs) by Date::Manip::TZ::zone at line 784
sub _all_periods {
9171853µs my($self,$zone,$year) = @_;
918 $year += 0;
919
92079µs if (! exists $$self{'data'}{'Zones'}{$zone}{'AllDates'}{$year}) {
921
922 #
923 # $ym1 is the year prior to $year which contains a rule (which will
924 # end in $year or later). $y is $year IF the zone contains rules
925 # for this year.
926 #
927
928 my($ym1,$ym0);
929112µs if ($year > $$self{'data'}{'LastYear'} &&
930 exists $$self{'data'}{'Zones'}{$zone}{'LastRule'}{'zone'}) {
931 $ym1 = $year-1;
932 $ym0 = $year;
933
934 } else {
93513µs foreach my $y (sort { $a <=> $b }
# spent 3µs making 1 call to Date::Manip::TZ::CORE:sort
936 keys %{ $$self{'data'}{'Zones'}{$zone}{'Dates'} }) {
93733µs if ($y < $year) {
938 $ym1 = $y;
939 next;
940 }
941 $ym0 = $year if ($year == $y);
942 last;
943 }
944 }
945 $ym1 = 0 if (! $ym1);
946
947 #
948 # Get the periods from the prior year. The last one is used (any others
949 # are discarded).
950 #
951
952 my(@periods);
953
954 # $ym1 will be 0 in 0001
95526µs if ($ym1) {
956118µs my @tmp = $self->_periods($zone,$ym1);
# spent 18µs making 1 call to Date::Manip::TZ::_periods
957 push(@periods,pop(@tmp)) if (@tmp);
958 }
959
960 #
961 # Add on any periods from the current year.
962 #
963
964 if ($ym0) {
965 push(@periods,$self->_periods($zone,$year));
966 }
967
968 $$self{'data'}{'Zones'}{$zone}{'AllDates'}{$year} = [ @periods ];
969 }
970
971 # A faster 'dclone' so we don't return the actual data
972 my @ret;
973 foreach my $ele (@{ $$self{'data'}{'Zones'}{$zone}{'AllDates'}{$year} }) {
974 push(@ret,
975 [ [ @{$$ele[0]} ],[ @{$$ele[1]} ],$$ele[2],[ @{$$ele[3]} ],$$ele[4],$$ele[5],
976327µs [ @{$$ele[6]} ],[ @{$$ele[7]} ],$$ele[8],$$ele[9],$$ele[10],$$ele[11] ]);
977 }
978 return @ret;
979}
980
981sub periods {
982 my($self,$zone,$year,$year1) = @_;
983
984 my $z = $self->_zone($zone);
985 if (! $z) {
986 warn "ERROR: [periods] Invalid zone: $zone\n";
987 return;
988 }
989 $zone = $z;
990 $self->_module($zone);
991
992 if (! defined($year1)) {
993 return $self->_periods($zone,$year);
994 }
995
996 $year = 1 if (! defined($year));
997
998 my @ret;
999 my $lastyear = $$self{'data'}{'LastYear'};
1000
1001 if ($year <= $lastyear) {
1002 foreach my $y (sort { $a <=> $b }
1003 keys %{ $$self{'data'}{'Zones'}{$zone}{'Dates'} }) {
1004 last if ($y > $year1 || $y > $lastyear);
1005 next if ($y < $year);
1006 push(@ret,$self->_periods($zone,$y));
1007 }
1008 }
1009
1010 if ($year1 > $lastyear) {
1011 $year = $lastyear + 1 if ($year <= $lastyear);
1012 foreach my $y ($year..$year1) {
1013 push(@ret,$self->_periods($zone,$y));
1014 }
1015 }
1016
1017 return @ret;
1018}
1019
1020
# spent 18µs within Date::Manip::TZ::_periods which was called: # once (18µs+0s) by Date::Manip::TZ::_all_periods at line 956
sub _periods {
1021612µs my($self,$zone,$year) = @_;
1022 $year += 0;
1023
1024 if (! exists $$self{'data'}{'Zones'}{$zone}{'Dates'}{$year}) {
1025
1026 my @periods = ();
1027 if ($year > $$self{'data'}{'LastYear'}) {
1028 # Calculate periods using the LastRule method
1029 @periods = $self->_lastrule($zone,$year);
1030 }
1031
1032 $$self{'data'}{'Zones'}{$zone}{'Dates'}{$year} = [ @periods ];
1033 }
1034
1035 # A faster 'dclone' so we don't return the actual data
1036 my @ret;
1037 foreach my $ele (@{ $$self{'data'}{'Zones'}{$zone}{'Dates'}{$year} }) {
1038 push(@ret,
1039 [ [ @{$$ele[0]} ],[ @{$$ele[1]} ],$$ele[2],[ @{$$ele[3]} ],$$ele[4],$$ele[5],
104017µs [ @{$$ele[6]} ],[ @{$$ele[7]} ],$$ele[8],$$ele[9],$$ele[10],$$ele[11] ]);
1041 }
1042 return @ret;
1043}
1044
1045
# spent 174µs (88+85) within Date::Manip::TZ::date_period which was called 2 times, avg 87µs/call: # once (60µs+53µs) by Date::Manip::Base::_config_var_setdate at line 1771 of Date/Manip/Base.pm # once (29µs+32µs) by Date::Manip::TZ::_convert at line 1307
sub date_period {
10462428µs my($self,$date,$zone,$wallclock,$isdst) = @_;
1047 $wallclock = 0 if (! $wallclock);
1048 $isdst = 0 if (! $isdst);
1049
105027µs my $z = $self->_zone($zone);
# spent 7µs making 2 calls to Date::Manip::TZ::_zone, avg 4µs/call
1051 if (! $z) {
1052 warn "ERROR: [date_period] Invalid zone: $zone\n";
1053 return;
1054 }
1055 $zone = $z;
105627µs $self->_module($zone);
# spent 7µs making 2 calls to Date::Manip::TZ::_module, avg 3µs/call
1057
1058 my $dmb = $$self{'objs'}{'base'};
1059 my @date = @$date;
1060 my $year = $date[0];
1061223µs my $dates= $dmb->_join_date($date);
# spent 23µs making 2 calls to Date::Manip::Base::_join_date, avg 12µs/call
1062
10631438µs if ($wallclock) {
1064 # A wallclock date
1065
1066247µs my @period = $self->_all_periods($zone,$year);
# spent 47µs making 2 calls to Date::Manip::TZ::_all_periods, avg 24µs/call
1067 my $beg = $period[0]->[9];
1068 my $end = $period[-1]->[11];
1069 if (($dates cmp $beg) == -1) {
1070 @period = $self->_all_periods($zone,$year-1);
1071 } elsif (($dates cmp $end) == 1) {
1072 @period = $self->_all_periods($zone,$year+1);
1073 }
1074
1075 my(@per);
1076 foreach my $period (@period) {
107748µs my($begUT,$begLT,$offsetstr,$offset,$abbrev,$dst,$endUT,$endLT,
1078 $begUTs,$begLTs,$endUTs,$endLTs) = @$period;
1079 if (($dates cmp $begLTs) != -1 && ($dates cmp $endLTs) != 1) {
1080 push(@per,$period);
1081 }
1082 }
1083
1084 if ($#per == -1) {
1085 return ();
1086 } elsif ($#per == 0) {
1087 return $per[0];
1088 } elsif ($#per == 1) {
1089 if ($per[0][5] == $isdst) {
1090 return $per[0];
1091 } else {
1092 return $per[1];
1093 }
1094 } else {
1095 warn "ERROR: [date_period] Impossible error\n";
1096 return;
1097 }
1098
1099 } else {
1100 # A GMT date
1101
1102 my @period = $self->_all_periods($zone,$year);
1103 foreach my $period (@period) {
1104 my($begUT,$begLT,$offsetstr,$offset,$abbrev,$isdst,$endUT,$endLT,
1105 $begUTs,$begLTs,$endUTs,$endLTs) = @$period;
1106 if (($dates cmp $begUTs) != -1 && ($dates cmp $endUTs) != 1) {
1107 return $period;
1108 }
1109 }
1110 warn "ERROR: [date_period] Impossible error\n";
1111 return;
1112 }
1113}
1114
1115# Calculate critical dates from the last rule. If $endonly is passed
1116# in, it only calculates the ending of the zone period before the
1117# start of the first one. This is necessary so that the last period in
1118# one year can find out when it ends (which is determined in the
1119# following year).
1120#
1121# Returns:
1122# [begUT, begLT, offsetstr, offset, abb, ISDST, endUT, endLT,
1123# begUTstr, begLTstr, endUTstr, endLTstr]
1124# for each.
1125#
1126sub _lastrule {
1127 my($self,$zone,$year,$endonly) = @_;
1128
1129 #
1130 # Get the list of rules (actually, the month in which the
1131 # rule triggers a time change). If there are none, then
1132 # this zone doesn't have a LAST RULE.
1133 #
1134
1135 my @mon = (sort keys
1136 %{ $$self{'data'}{'Zones'}{$zone}{'LastRule'}{'rules'} });
1137 return () if (! @mon);
1138
1139 #
1140 # Analyze each time change.
1141 #
1142
1143 my @dates = ();
1144 my $dmb = $$self{'objs'}{'base'};
1145
1146 my $stdoff = $$self{'data'}{'Zones'}{$zone}{'LastRule'}{'zone'}{'stdoff'};
1147 my $dstoff = $$self{'data'}{'Zones'}{$zone}{'LastRule'}{'zone'}{'dstoff'};
1148
1149 my (@period);
1150
1151 foreach my $mon (@mon) {
1152 my $flag =
1153 $$self{'data'}{'Zones'}{$zone}{'LastRule'}{'rules'}{$mon}{'flag'};
1154 my $dow =
1155 $$self{'data'}{'Zones'}{$zone}{'LastRule'}{'rules'}{$mon}{'dow'};
1156 my $num =
1157 $$self{'data'}{'Zones'}{$zone}{'LastRule'}{'rules'}{$mon}{'num'};
1158 my $isdst=
1159 $$self{'data'}{'Zones'}{$zone}{'LastRule'}{'rules'}{$mon}{'isdst'};
1160 my $time =
1161 $$self{'data'}{'Zones'}{$zone}{'LastRule'}{'rules'}{$mon}{'time'};
1162 my $type =
1163 $$self{'data'}{'Zones'}{$zone}{'LastRule'}{'rules'}{$mon}{'type'};
1164 my $abb =
1165 $$self{'data'}{'Zones'}{$zone}{'LastRule'}{'rules'}{$mon}{'abb'};
1166
1167 # The end of the current period and the beginning of the next
1168 my($endUT,$endLT,$begUT,$begLT) =
1169 $dmb->_critical_date($year,$mon,$flag,$num,$dow,
1170 $isdst,$time,$type,$stdoff,$dstoff);
1171 return ($endUT,$endLT) if ($endonly);
1172
1173 if (@period) {
1174 push(@period,$endUT,$endLT);
1175 push(@dates,[@period]);
1176 }
1177 my $offsetstr = ($isdst ? $dstoff : $stdoff);
1178 my $offset = $dmb->split('offset',$offsetstr);
1179
1180 @period = ($begUT,$begLT,$offsetstr,$offset,$abb,$isdst);
1181 }
1182
1183 push(@period,$self->_lastrule($zone,$year+1,1));
1184 push(@dates,[@period]);
1185
1186 foreach my $period (@dates) {
1187 my($begUT,$begLT,$offsetstr,$offset,$abbrev,$dst,$endUT,$endLT) = @$period;
1188 my $begUTstr = $dmb->join("date",$begUT);
1189 my $begLTstr = $dmb->join("date",$begLT);
1190 my $endUTstr = $dmb->join("date",$endUT);
1191 my $endLTstr = $dmb->join("date",$endLT);
1192 $period = [$begUT,$begLT,$offsetstr,$offset,$abbrev,$dst,$endUT,$endLT,
1193 $begUTstr,$begLTstr,$endUTstr,$endLTstr];
1194 }
1195
1196 return @dates;
1197}
1198
1199########################################################################
1200# CONVERSION
1201########################################################################
1202
1203sub convert {
1204 my($self,$date,$from,$to,$isdst) = @_;
1205 $self->_convert('convert',$date,$from,$to,$isdst);
1206}
1207
1208
# spent 137µs (23+114) within Date::Manip::TZ::convert_to_gmt which was called: # once (23µs+114µs) by Date::Manip::Base::_config_var_setdate at line 1815 of Date/Manip/Base.pm
sub convert_to_gmt {
1209621µs my($self,$date,@arg) = @_;
1210111µs my($err,$from,$isdst) = _convert_args('convert_to_gmt',@arg);
# spent 11µs making 1 call to Date::Manip::TZ::_convert_args
1211 return (1) if ($err);
1212
1213 my $dmb = $$self{'objs'}{'base'};
1214
1215 if (! $from) {
1216 ($from) = $dmb->_now('tz',1);
1217 }
12181103µs $self->_convert('convert_to_gmt',$date,$from,'GMT',$isdst);
# spent 103µs making 1 call to Date::Manip::TZ::_convert
1219}
1220
1221sub convert_from_gmt {
1222 my($self,$date,@arg) = @_;
1223 my($err,$to,$isdst) = _convert_args('convert_from_gmt',@arg);
1224 return (1) if ($err);
1225
1226 my $dmb = $$self{'objs'}{'base'};
1227
1228 if (! $to) {
1229 ($to) = $dmb->_now('tz',1);
1230 }
1231 $self->_convert('convert_from_gmt',$date,'GMT',$to,$isdst);
1232}
1233
1234sub convert_to_local {
1235 my($self,$date,@arg) = @_;
1236 my($err,$from,$isdst) = _convert_args('convert_to_local',@arg);
1237 return (1) if ($err);
1238
1239 my $dmb = $$self{'objs'}{'base'};
1240
1241 if (! $from) {
1242 $from = 'GMT';
1243 }
1244 $self->_convert('convert_to_local',$date,$from,$dmb->_now('tz',1),$isdst);
1245}
1246
1247sub convert_from_local {
1248 my($self,$date,@arg) = @_;
1249 my($err,$to,$isdst) = _convert_args('convert_from_local',@arg);
1250 return (1) if ($err);
1251
1252 my $dmb = $$self{'objs'}{'base'};
1253
1254 if (! $to) {
1255 $to = 'GMT';
1256 }
1257 $self->_convert('convert_from_local',$date,$dmb->_now('tz',1),$to,$isdst);
1258}
1259
1260
# spent 11µs within Date::Manip::TZ::_convert_args which was called: # once (11µs+0s) by Date::Manip::TZ::convert_to_gmt at line 1210
sub _convert_args {
126127µs my($caller,@args) = @_;
1262
126316µs if ($#args == -1) {
1264 return (0,'',0);
1265 } elsif ($#args == 0) {
1266 if ($args[0] eq '0' ||
1267 $args[0] eq '1') {
1268 return (0,'',$args[0]);
1269 } else {
1270 return (0,$args[0],0);
1271 }
1272 } elsif ($#args == 1) {
1273 return (0,@args);
1274 } else {
1275 return (1,'',0);
1276 }
1277}
1278
1279
# spent 103µs (35+68) within Date::Manip::TZ::_convert which was called: # once (35µs+68µs) by Date::Manip::TZ::convert_to_gmt at line 1218
sub _convert {
1280610µs my($self,$caller,$date,$from,$to,$isdst) = @_;
1281 my $dmb = $$self{'objs'}{'base'};
1282
1283 # Handle $date as a reference and a string
1284 my (@date);
1285 if (ref($date)) {
1286 @date = @$date;
1287 } else {
1288 @date = @{ $dmb->split('date',$date) };
1289 $date = [@date];
1290 }
1291
129266µs if ($from ne $to) {
129313µs my $tmp = $self->_zone($from);
# spent 3µs making 1 call to Date::Manip::TZ::_zone
1294 if (! $tmp) {
1295 return (2);
1296 }
1297 $from = $tmp;
1298
129914µs $tmp = $self->_zone($to);
# spent 4µs making 1 call to Date::Manip::TZ::_zone
1300 if (! $tmp) {
1301 return (3);
1302 }
1303 $to = $tmp;
1304 }
1305
1306410µs if ($from eq $to) {
1307161µs my $per = $self->date_period($date,$from,1,$isdst);
# spent 61µs making 1 call to Date::Manip::TZ::date_period
1308 my $offset = $$per[3];
1309 my $abb = $$per[4];
1310 return (0,$date,$offset,$isdst,$abb);
1311 }
1312
1313 # Convert $date from $from to GMT
1314
1315 if ($from ne "Etc/GMT") {
1316 my $per = $self->date_period($date,$from,1,$isdst);
1317 if (! $per) {
1318 return (4);
1319 }
1320 my $offset = $$per[3];
1321 @date = @{ $dmb->calc_date_time(\@date,$offset,1) };
1322 }
1323
1324 # Convert $date from GMT to $to
1325
1326 $isdst = 0;
1327 my $offset = [0,0,0];
1328 my $abb = 'GMT';
1329
1330 if ($to ne "Etc/GMT") {
1331 my $per = $self->date_period([@date],$to,0);
1332 $offset = $$per[3];
1333 $isdst = $$per[5];
1334 $abb = $$per[4];
1335 @date = @{ $dmb->calc_date_time(\@date,$offset) };
1336 }
1337
1338 return (0,[@date],$offset,$isdst,$abb);
1339}
1340
1341########################################################################
1342# REGULAR EXPRESSIONS FOR TIMEZONE INFORMATION
1343########################################################################
1344
1345# Returns a regular expression capable of matching all timezone names
1346# and aliases.
1347#
1348# The regular expression will have the following named matches:
1349# zone = a zone name or alias
1350#
1351sub _zonerx {
1352 my($self) = @_;
1353 return $$self{'data'}{'zonerx'} if (defined $$self{'data'}{'zonerx'});
1354 my @zone = (keys %{ $$self{'data'}{'Alias'} },
1355 keys %{ $$self{'data'}{'MyAlias'} });
1356 @zone = sort _sortByLength(@zone);
1357 foreach my $zone (@zone) {
1358 $zone =~ s/\057/\\057/g; # /
1359 $zone =~ s/\055/\\055/g; # -
1360 $zone =~ s/\056/\\056/g; # .
1361 $zone =~ s/\050/\\050/g; # (
1362 $zone =~ s/\051/\\051/g; # )
1363 $zone =~ s/\053/\\053/g; # +
1364 }
1365 my $re = join('|',@zone);
1366 $$self{'data'}{'zonerx'} = qr/(?<zone>$re)/i;
1367 return $$self{'data'}{'zonerx'};
1368}
1369
1370# Returns a regular expression capable of matching all abbreviations.
1371#
1372# The regular expression will have the following named matches:
1373# abb = a zone abbreviation
1374#
1375sub _abbrx {
1376 my($self) = @_;
1377 return $$self{'data'}{'abbrx'} if (defined $$self{'data'}{'abbrx'});
1378 my @abb = (keys %{ $$self{'data'}{'Abbrev'} },
1379 keys %{ $$self{'data'}{'MyAbbrev'} });
1380 @abb = sort _sortByLength(@abb);
1381 foreach my $abb (@abb) {
1382 $abb =~ s/\055/\\055/g; # -
1383 $abb =~ s/\053/\\053/g; # +
1384 }
1385 my $re = join('|',@abb);
1386 $$self{'data'}{'abbrx'} = qr/(?<abb>$re)/i;
1387 return $$self{'data'}{'abbrx'};
1388}
1389
1390# Returns a regular expression capable of matching a valid timezone as
1391# an offset. Known formats are:
1392# +07 +07 (HST)
1393# +0700 +0700 (HST)
1394# +07:00 +07:00 (HST)
1395# +070000 +070000 (HST)
1396# +07:00:00 +07:00:00 (HST)
1397#
1398# The regular expression will have the following named matches:
1399# off = the offset
1400# abb = the abbreviation
1401#
1402sub _offrx {
1403 my($self) = @_;
1404 return $$self{'data'}{'offrx'} if (defined $$self{'data'}{'offrx'});
1405
1406 my($hr) = qr/(?:[0-1][0-9]|2[0-3])/; # 00 - 23
1407 my($mn) = qr/(?:[0-5][0-9])/; # 00 - 59
1408 my($ss) = qr/(?:[0-5][0-9])/; # 00 - 59
1409 my($abb)= $self->_abbrx();
1410
1411 my($re) = qr/ (?<off> [+-] (?: $hr:$mn:$ss |
1412 $hr$mn$ss |
1413 $hr:?$mn |
1414 $hr
1415 )
1416 )
1417 (?: \s* \( $abb \))? /ix;
1418
1419 $$self{'data'}{'offrx'} = $re;
1420 return $$self{'data'}{'offrx'};
1421}
1422
1423# Returns a regular expression capable of matching all timezone
1424# information available. It will match a full timezone, an
1425# abbreviation, or an offset/abbreviation combination. The regular
1426# expression will have the following named matches:
1427# tzstring = the full string matched
1428# in addition to the matches from the _zonerx, _abbrx, and _offrx
1429# functions.
1430#
1431sub _zrx {
1432 my($self) = @_;
1433 return $$self{'data'}{'zrx'} if (defined $$self{'data'}{'zrx'});
1434
1435 my $zonerx = $self->_zonerx(); # (?<zone>america/new_york|...)
1436 my $zoneabbrx = $self->_abbrx(); # (?<abb>edt|est|...)
1437 my $zoneoffrx = $self->_offrx(); # (?<off>07:00) (?<abb>GMT)
1438
1439 my $zrx = qr/(?<tzstring>$zonerx|$zoneabbrx|$zoneoffrx)/;
1440 $$self{'data'}{'zrx'} = $zrx;
1441 return $zrx;
1442}
1443
1444# This sorts from longest to shortest element
1445#
1446380µs264µs
# spent 41µs (18+23) within Date::Manip::TZ::BEGIN@1446 which was called: # once (18µs+23µs) by Date::Manip::Obj::BEGIN@16 at line 1446
no strict 'vars';
# spent 41µs making 1 call to Date::Manip::TZ::BEGIN@1446 # spent 23µs making 1 call to strict::unimport
1447sub _sortByLength {
1448 return (length $b <=> length $a);
1449}
1450381µs254µs
# spent 35µs (17+18) within Date::Manip::TZ::BEGIN@1450 which was called: # once (17µs+18µs) by Date::Manip::Obj::BEGIN@16 at line 1450
use strict 'vars';
# spent 35µs making 1 call to Date::Manip::TZ::BEGIN@1450 # spent 18µs making 1 call to strict::import
1451
1452116µs1;
1453# Local Variables:
1454# mode: cperl
1455# indent-tabs-mode: nil
1456# cperl-indent-level: 3
1457# cperl-continued-statement-offset: 2
1458# cperl-continued-brace-offset: 0
1459# cperl-brace-offset: 0
1460# cperl-brace-imaginary-offset: 0
1461# cperl-label-offset: -2
1462# End:
 
# spent 5µs within Date::Manip::TZ::CORE:close which was called 2 times, avg 2µs/call: # 2 times (5µs+0s) by Date::Manip::TZ::_get_curr_zone at line 435, avg 2µs/call
sub Date::Manip::TZ::CORE:close; # opcode
# spent 26µs within Date::Manip::TZ::CORE:ftfile which was called 4 times, avg 6µs/call: # 4 times (26µs+0s) by Date::Manip::TZ::_get_curr_zone at line 413, avg 6µs/call
sub Date::Manip::TZ::CORE:ftfile; # opcode
# spent 22µs within Date::Manip::TZ::CORE:match which was called 8 times, avg 3µs/call: # 4 times (10µs+0s) by Date::Manip::TZ::_get_curr_zone at line 420, avg 2µs/call # 2 times (8µs+0s) by Date::Manip::TZ::zone at line 638, avg 4µs/call # 2 times (4µs+0s) by Date::Manip::TZ::_get_curr_zone at line 422, avg 2µs/call
sub Date::Manip::TZ::CORE:match; # opcode
# spent 5µs within Date::Manip::TZ::CORE:readline which was called 2 times, avg 3µs/call: # 2 times (5µs+0s) by Date::Manip::TZ::_get_curr_zone at line 419, avg 3µs/call
sub Date::Manip::TZ::CORE:readline; # opcode
# spent 3µs within Date::Manip::TZ::CORE:sort which was called: # once (3µs+0s) by Date::Manip::TZ::_all_periods at line 935
sub Date::Manip::TZ::CORE:sort; # opcode
# spent 9µs within Date::Manip::TZ::CORE:subst which was called 6 times, avg 2µs/call: # 2 times (6µs+0s) by Date::Manip::TZ::_get_curr_zone at line 430, avg 3µs/call # 2 times (2µs+0s) by Date::Manip::TZ::_get_curr_zone at line 431, avg 1µs/call # 2 times (2µs+0s) by Date::Manip::TZ::_get_curr_zone at line 497, avg 850ns/call
sub Date::Manip::TZ::CORE:subst; # opcode
Report produced by the NYTProf 4.04 Perl profiler, developed by Tim Bunce and Adam Kaplan.