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

Filename/home/sulbeck/local/lib/perl5/5.20.1/Date/Manip/TZ.pm
StatementsExecuted 1957871 statements in 797ms
Subroutines
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
243011487ms1.33sDate::Manip::TZ::::__zoneDate::Manip::TZ::__zone
33611464ms472msDate::Manip::TZ::::_moduleDate::Manip::TZ::_module
11228621159ms193msDate::Manip::TZ::::_all_periodsDate::Manip::TZ::_all_periods
24231158.9ms58.9msDate::Manip::TZ::::_list_addDate::Manip::TZ::_list_add
48593253.0ms88.3msDate::Manip::TZ::::date_periodDate::Manip::TZ::date_period
121134.6ms37.4msDate::Manip::TZ::::_check_abbrev_isdstDate::Manip::TZ::_check_abbrev_isdst
26002120.7ms20.7msDate::Manip::TZ::::_periodsDate::Manip::TZ::_periods
19844117.4ms17.4msDate::Manip::TZ::::CORE:sortDate::Manip::TZ::CORE:sort (opcode)
72914210.6ms10.6msDate::Manip::TZ::::_zoneDate::Manip::TZ::_zone
101019.38ms9.38msDate::Manip::TZ::::CORE:regcompDate::Manip::TZ::CORE:regcomp (opcode)
2424115.64ms6.07msDate::Manip::TZ::::_offmodDate::Manip::TZ::_offmod
4414.79ms15.7msDate::Manip::TZ::::_zrxDate::Manip::TZ::_zrx
111320µs498µsDate::Manip::TZ::::_get_curr_zoneDate::Manip::TZ::_get_curr_zone
5762141297µs297µsDate::Manip::TZ::::CORE:substDate::Manip::TZ::CORE:subst (opcode)
11125µs32µsDate::Manip::TZ::::_initDate::Manip::TZ::_init
913124µs24µsDate::Manip::TZ::::CORE:matchDate::Manip::TZ::CORE:match (opcode)
1313111µs11µsDate::Manip::TZ::::CORE:qrDate::Manip::TZ::CORE:qr (opcode)
74119µs9µsDate::Manip::TZ::::CORE:readlineDate::Manip::TZ::CORE:readline (opcode)
2118µs8µsDate::Manip::TZ::::ENDDate::Manip::TZ::END
1117µs16µsDate::Manip::TZ::::BEGIN@721Date::Manip::TZ::BEGIN@721
1117µs515µsDate::Manip::TZ::::_set_curr_zoneDate::Manip::TZ::_set_curr_zone
1116µs14µsDate::Manip::TZ::::BEGIN@1612Date::Manip::TZ::BEGIN@1612
1115µs106µsDate::Manip::TZ::::BEGIN@22Date::Manip::TZ::BEGIN@22
1115µs5µsDate::Manip::TZ::::BEGIN@14Date::Manip::TZ::BEGIN@14
1115µs8µsDate::Manip::TZ::::BEGIN@731Date::Manip::TZ::BEGIN@731
1114µs10µsDate::Manip::TZ::::BEGIN@189Date::Manip::TZ::BEGIN@189
1114µs11µsDate::Manip::TZ::::BEGIN@158Date::Manip::TZ::BEGIN@158
1114µs7µsDate::Manip::TZ::::BEGIN@19Date::Manip::TZ::BEGIN@19
1114µs9µsDate::Manip::TZ::::BEGIN@1616Date::Manip::TZ::BEGIN@1616
1113µs3µsDate::Manip::TZ::::BEGIN@24Date::Manip::TZ::BEGIN@24
3113µs3µsDate::Manip::TZ::::CORE:ftfileDate::Manip::TZ::CORE:ftfile (opcode)
1113µs10µsDate::Manip::TZ::::BEGIN@20Date::Manip::TZ::BEGIN@20
1113µs518µsDate::Manip::TZ::::_init_finalDate::Manip::TZ::_init_final
1112µs2µsDate::Manip::TZ::::BEGIN@15Date::Manip::TZ::BEGIN@15
111500ns500nsDate::Manip::TZ::::CORE:closeDate::Manip::TZ::CORE:close (opcode)
0000s0sDate::Manip::TZ::::_check_offset_abbrev_isdstDate::Manip::TZ::_check_offset_abbrev_isdst
0000s0sDate::Manip::TZ::::_cmdDate::Manip::TZ::_cmd
0000s0sDate::Manip::TZ::::_config_var_setdateDate::Manip::TZ::_config_var_setdate
0000s0sDate::Manip::TZ::::_config_var_tzDate::Manip::TZ::_config_var_tz
0000s0sDate::Manip::TZ::::_convertDate::Manip::TZ::_convert
0000s0sDate::Manip::TZ::::_convert_argsDate::Manip::TZ::_convert_args
0000s0sDate::Manip::TZ::::_lastruleDate::Manip::TZ::_lastrule
0000s0sDate::Manip::TZ::::_list_unionDate::Manip::TZ::_list_union
0000s0sDate::Manip::TZ::::_sortByLengthDate::Manip::TZ::_sortByLength
0000s0sDate::Manip::TZ::::_windows_registry_valDate::Manip::TZ::_windows_registry_val
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_gmtDate::Manip::TZ::convert_to_gmt
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
0000s0sDate::Manip::TZ::::zoneDate::Manip::TZ::zone
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-2015 Sullivan Beck. All rights reserved.
3# This program is free software; you can redistribute it and/or modify it
4# under the same terms as Perl itself.
5
6########################################################################
7# 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
14212µs15µs
# spent 5µs within Date::Manip::TZ::BEGIN@14 which was called: # once (5µs+0s) by Date::Manip::Date::BEGIN@27 at line 14
use Date::Manip::Obj;
# spent 5µs making 1 call to Date::Manip::TZ::BEGIN@14
15217µs12µs
# spent 2µs within Date::Manip::TZ::BEGIN@15 which was called: # once (2µs+0s) by Date::Manip::Date::BEGIN@27 at line 15
use Date::Manip::TZ_Base;
# spent 2µs making 1 call to Date::Manip::TZ::BEGIN@15
1615µs@ISA = qw(Date::Manip::Obj Date::Manip::TZ_Base);
17
1816µsrequire 5.010000;
1929µs210µs
# spent 7µs (4+3) within Date::Manip::TZ::BEGIN@19 which was called: # once (4µs+3µs) by Date::Manip::Date::BEGIN@27 at line 19
use warnings;
# spent 7µs making 1 call to Date::Manip::TZ::BEGIN@19 # spent 3µs making 1 call to warnings::import
20210µs217µs
# spent 10µs (3+7) within Date::Manip::TZ::BEGIN@20 which was called: # once (3µs+7µs) by Date::Manip::Date::BEGIN@27 at line 20
use strict;
# spent 10µs making 1 call to Date::Manip::TZ::BEGIN@20 # spent 7µs making 1 call to strict::import
21
22218µs2207µs
# spent 106µs (5+101) within Date::Manip::TZ::BEGIN@22 which was called: # once (5µs+101µs) by Date::Manip::Date::BEGIN@27 at line 22
use IO::File;
# spent 106µs making 1 call to Date::Manip::TZ::BEGIN@22 # spent 101µs making 1 call to Exporter::import
23146µsrequire Date::Manip::Zones;
242211µs13µs
# spent 3µs within Date::Manip::TZ::BEGIN@24 which was called: # once (3µs+0s) by Date::Manip::Date::BEGIN@27 at line 24
use Date::Manip::Base;
# spent 3µs making 1 call to Date::Manip::TZ::BEGIN@24
25
261100nsour $VERSION;
271300ns$VERSION='6.49';
2811µsEND { undef $VERSION; }
29
30# To get rid of a 'used only once' warnings.
31
# spent 8µs within Date::Manip::TZ::END which was called 2 times, avg 4µs/call: # 2 times (8µs+0s) by main::RUNTIME at line 0 of ../dm5dm6_ex3, avg 4µs/call
END {
3211µs my $tmp = \%Date::Manip::Zones::Module;
331700ns $tmp = \%Date::Manip::Zones::ZoneNames;
341400ns $tmp = \%Date::Manip::Zones::Alias;
351800ns $tmp = \%Date::Manip::Zones::Abbrev;
361300ns $tmp = \%Date::Manip::Zones::Offmod;
371600ns $tmp = $Date::Manip::Zones::FirstDate;
381200ns $tmp = $Date::Manip::Zones::LastDate;
391300ns $tmp = $Date::Manip::Zones::LastYear;
401200ns $tmp = $Date::Manip::Zones::TzcodeVersion;
4112µs $tmp = $Date::Manip::Zones::TzdataVersion;
42}
43
44########################################################################
45# BASE METHODS
46########################################################################
47
48
# spent 32µs (25+7) within Date::Manip::TZ::_init which was called: # once (25µs+7µs) by Date::Manip::Obj::new at line 162 of Date/Manip/Obj.pm
sub _init {
491300ns my($self) = @_;
50
51114µ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
951500ns my $dmb = $$self{'base'};
961900ns17µs my $os = $dmb->_os();
# spent 7µs making 1 call to Date::Manip::Base::_os
97
9812µs if ($os eq 'Unix') {
991400ns $$self{'data'}{'path'} = '/bin:/usr/bin';
10017µ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 518µs (3+515) within Date::Manip::TZ::_init_final which was called: # once (3µs+515µs) by Date::Manip::Obj::new at line 165 of Date/Manip/Obj.pm
sub _init_final {
1531300ns my($self) = @_;
154
15514µs1515µs $self->_set_curr_zone();
# spent 515µs making 1 call to Date::Manip::TZ::_set_curr_zone
156}
157
1582105µs218µs
# spent 11µs (4+7) within Date::Manip::TZ::BEGIN@158 which was called: # once (4µs+7µs) by Date::Manip::Date::BEGIN@27 at line 158
no strict 'refs';
# spent 11µs making 1 call to Date::Manip::TZ::BEGIN@158 # spent 7µs making 1 call to strict::unimport
159# This loads data from an offset module
160#
161
# spent 6.07ms (5.64+434µs) within Date::Manip::TZ::_offmod which was called 2424 times, avg 3µs/call: # 2424 times (5.64ms+434µs) by Date::Manip::TZ::__zone at line 893, avg 3µs/call
sub _offmod {
1622424449µs my($self,$offset) = @_;
16324243.18ms return if (exists $$self{'data'}{'Offsets'}{$offset});
164
1651511µs my $mod = $$self{'data'}{'Offmod'}{$offset};
16615409µs eval "require Date::Manip::Offset::${mod}";
# spent 134µs executing statements in 2 string evals (merged) # spent 114µs executing statements in string eval # spent 108µs executing statements in 2 string evals (merged) # spent 104µs executing statements in string eval # spent 99µs executing statements in 2 string evals (merged) # spent 89µs executing statements in string eval # spent 80µs executing statements in string eval # spent 79µs executing statements in string eval # spent 70µs executing statements in string eval # spent 48µs executing statements in string eval # spent 47µs executing statements in string eval # spent 46µs executing statements in string eval
1671552µs my %off = %{ "Date::Manip::Offset::${mod}::Offset" };
168
1691598µs $$self{'data'}{'Offsets'}{$offset} = { %off };
170}
171
172# This loads data from a zone module (takes a lowercase zone)
173#
174
# spent 472ms (464+7.85) within Date::Manip::TZ::_module which was called 336 times, avg 1.40ms/call: # 336 times (464ms+7.85ms) by Date::Manip::TZ::__zone at line 947, avg 1.40ms/call
sub _module {
17533674µs my($self,$zone) = @_;
176336125µs return if (exists $$self{'data'}{'Zones'}{$zone}{'Loaded'});
177
178336248µs my $mod = $$self{'data'}{'Module'}{$zone};
1793364.67ms eval "require Date::Manip::TZ::${mod}";
# spent 575µs executing statements in 13 string evals (merged) # spent 540µs executing statements in 12 string evals (merged) # spent 536µs executing statements in 11 string evals (merged) # spent 526µs executing statements in 12 string evals (merged) # spent 455µs executing statements in 10 string evals (merged) # spent 443µs executing statements in 9 string evals (merged) # spent 429µs executing statements in 8 string evals (merged) # spent 415µs executing statements in 9 string evals (merged) # spent 392µs executing statements in 9 string evals (merged) # spent 378µs executing statements in 8 string evals (merged) # spent 364µs executing statements in 8 string evals (merged) # spent 361µs executing statements in 7 string evals (merged) # spent 361µs executing statements in 7 string evals (merged) # spent 350µs executing statements in 8 string evals (merged) # spent 328µs executing statements in 7 string evals (merged) # spent 314µs executing statements in 7 string evals (merged) # spent 311µs executing statements in 7 string evals (merged) # spent 310µs executing statements in 7 string evals (merged) # spent 306µs executing statements in 6 string evals (merged) # spent 281µs executing statements in 6 string evals (merged) # spent 281µs executing statements in 6 string evals (merged) # spent 277µs executing statements in 6 string evals (merged) # spent 273µs executing statements in 5 string evals (merged) # spent 272µs executing statements in 6 string evals (merged) # spent 265µs executing statements in 6 string evals (merged) # spent 230µs executing statements in 5 string evals (merged) # spent 229µs executing statements in 5 string evals (merged) # spent 224µs executing statements in 5 string evals (merged) # spent 221µs executing statements in 5 string evals (merged) # spent 220µs executing statements in 5 string evals (merged) # spent 205µs executing statements in 4 string evals (merged) # spent 200µs executing statements in 4 string evals (merged) # spent 186µs executing statements in 4 string evals (merged) # spent 184µs executing statements in 4 string evals (merged) # spent 182µs executing statements in 4 string evals (merged) # spent 174µs executing statements in 4 string evals (merged) # spent 174µs executing statements in 4 string evals (merged) # spent 172µs executing statements in 4 string evals (merged) # spent 168µs executing statements in 4 string evals (merged) # spent 154µs executing statements in 3 string evals (merged) # spent 153µs executing statements in 3 string evals (merged) # spent 144µs executing statements in 3 string evals (merged) # spent 140µs executing statements in 3 string evals (merged) # spent 139µs executing statements in 3 string evals (merged) # spent 138µs executing statements in 3 string evals (merged) # spent 138µs executing statements in 3 string evals (merged) # spent 133µs executing statements in 3 string evals (merged) # spent 131µs executing statements in 3 string evals (merged) # spent 129µs executing statements in 3 string evals (merged) # spent 103µs executing statements in 2 string evals (merged) # spent 94µs executing statements in 2 string evals (merged) # spent 91µs executing statements in 2 string evals (merged) # spent 90µs executing statements in 2 string evals (merged) # spent 89µs executing statements in 2 string evals (merged) # spent 89µs executing statements in 2 string evals (merged) # spent 87µs executing statements in 2 string evals (merged) # spent 67µs executing statements in string eval # spent 53µs executing statements in string eval # spent 48µs executing statements in string eval # spent 47µs executing statements in string eval # spent 47µs executing statements in string eval # spent 46µs executing statements in string eval # spent 46µs executing statements in string eval # spent 45µs executing statements in string eval # spent 45µs executing statements in string eval # spent 44µs executing statements in string eval # spent 43µs executing statements in string eval # spent 43µs executing statements in string eval # spent 43µs executing statements in string eval # spent 43µs executing statements in string eval # spent 43µs executing statements in string eval # spent 42µs executing statements in string eval # spent 42µs executing statements in string eval # spent 42µs executing statements in string eval # spent 42µs executing statements in string eval # spent 42µs executing statements in string eval # spent 42µs executing statements in string eval # spent 41µs executing statements in string eval # spent 41µs executing statements in string eval # spent 41µs executing statements in string eval # spent 40µs executing statements in string eval # spent 40µs executing statements in string eval # spent 40µs executing statements in string eval # spent 40µs executing statements in string eval # spent 39µs executing statements in string eval # spent 38µs executing statements in string eval # spent 38µs executing statements in string eval
1803362.86ms my %dates = %{ "Date::Manip::TZ::${mod}::Dates" };
181336353µs my %last = %{ "Date::Manip::TZ::${mod}::LastRule" };
1823364.22ms $$self{'data'}{'Zones'}{$zone} =
183 {
184 'Dates' => { %dates },
185 'LastRule' => { %last },
186 'Loaded' => 1
187 };
188}
18921.24ms216µs
# spent 10µs (4+6) within Date::Manip::TZ::BEGIN@189 which was called: # once (4µs+6µs) by Date::Manip::Date::BEGIN@27 at line 189
use strict 'refs';
# spent 10µs making 1 call to Date::Manip::TZ::BEGIN@189 # spent 6µs making 1 call to strict::import
190
191########################################################################
192# CHECKING/MODIFYING ZONEINFO DATA
193########################################################################
194
195
# spent 10.6ms within Date::Manip::TZ::_zone which was called 7291 times, avg 1µs/call: # 4859 times (7.24ms+0s) by Date::Manip::TZ::date_period at line 1218, avg 1µs/call # 2430 times (3.30ms+0s) by Date::Manip::Date::set at line 2657 of Date/Manip/Date.pm, avg 1µs/call # once (11µs+0s) by Date::Manip::TZ::_set_curr_zone at line 388 # once (6µs+0s) by Date::Manip::TZ::_get_curr_zone at line 635
sub _zone {
19672911.20ms my($self,$zone) = @_;
19772911.62ms $zone = lc($zone);
198
199729112.5ms 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 515µs (7+509) within Date::Manip::TZ::_set_curr_zone which was called: # once (7µs+509µs) by Date::Manip::TZ::_init_final at line 155
sub _set_curr_zone {
3841300ns my($self) = @_;
3851300ns my $dmb = $$self{'base'};
38612µs1498µs my $currzone = $self->_get_curr_zone();
# spent 498µs making 1 call to Date::Manip::TZ::_get_curr_zone
387
388112µs111µs $$dmb{'data'}{'now'}{'systz'} = $self->_zone($currzone);
# spent 11µs making 1 call to Date::Manip::TZ::_zone
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 498µs (320+178) within Date::Manip::TZ::_get_curr_zone which was called: # once (320µs+178µs) by Date::Manip::TZ::_set_curr_zone at line 386
sub _get_curr_zone {
3951400ns my($self) = @_;
3961500ns my $dmb = $$self{'base'};
397
3981500ns my $t = time;
399115µs my($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime($t);
4001300ns my $currzone = '';
4011300ns my $dstflag = ($isdst ? 'dstonly' : 'stdonly');
402
40312µs my (@methods) = @{ $$self{'data'}{'methods'} };
4041700ns my $debug = ($ENV{DATE_MANIP_DEBUG} ? 1 : 0);
405
40615µs defined $$self{'data'}{'path'}
407 and local $ENV{PATH} = $$self{'data'}{'path'};
408
409 METHOD:
4101500ns while (@methods) {
4115900ns my $method = shift(@methods);
4125800ns my @zone = ();
413
41452µs if ($method eq 'main') {
415
4161300ns if (! @methods) {
417 warn "ERROR: [_set_curr_zone] main requires argument\n";
418 return;
419 }
4201100ns my $var = shift(@methods);
4211500ns push(@zone,$$::var) if (defined $$::var);
422
4231200ns if ($debug) {
424 print "*** DEBUG *** main $var = " .
425 (defined $$::var ? $$::var : 'undef') . "\n";
426 }
427
428 } elsif ($method eq 'env') {
4291400ns if (@methods < 2) {
430 warn "ERROR: [_set_curr_zone] env requires 2 argument\n";
431 return;
432 }
4331600ns my $type = lc( shift(@methods) );
4341300ns 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 }
4391600ns my $var = shift(@methods);
4401800ns 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
4511300ns 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') {
4633400ns if (! @methods) {
464 warn "ERROR: [_set_curr_zone] file requires argument\n";
465 return;
466 }
4673400ns my $file = shift(@methods);
46839µs33µs next if (! -f $file);
# spent 3µs making 3 calls to Date::Manip::TZ::CORE:ftfile, avg 1µs/call
469
47013µs127µs my $in = new IO::File;
# spent 27µs making 1 call to IO::File::new
47112µs116µs $in->open($file) || next;
# spent 16µs making 1 call to IO::File::open
4721300ns my $firstline = 1;
473
4741300ns my @z;
475139µs6876µs while (! $in->eof) {
# spent 76µs making 68 calls to IO::Handle::eof, avg 1µs/call
4767482µs749µs my $line = <$in>;
# spent 9µs making 74 calls to Date::Manip::TZ::CORE:readline, avg 126ns/call
4777493µs8319µs next if ($line =~ /^\s*\043/ ||
# spent 19µs making 83 calls to Date::Manip::TZ::CORE:match, avg 234ns/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
50378µs73µs if ($line =~ /^\s*(?:TZ|TIMEZONE|ZONE)\s*=\s*(.*)\s*$/) {
# spent 3µs making 7 calls to Date::Manip::TZ::CORE:match, avg 443ns/call
5041800ns my $val = $1;
5051400ns @z = ();
5061100ns last if (! $val);
507
50813µs11µs if ($val =~ /^(["'])(.*?)\1/) {
# spent 1µs making 1 call to Date::Manip::TZ::CORE:match
5091400ns my $z = $2;
5101200ns last if (! $z);
51112µs1300ns $z =~ s/\s+/_/g;
# spent 300ns making 1 call to Date::Manip::TZ::CORE:subst
5121400ns 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
5241600ns last;
525 }
52664µs611µs if ($firstline) {
# spent 11µs making 6 calls to IO::Handle::eof, avg 2µs/call
5271300ns $firstline = 0;
52813µs1900ns $line =~ s/^\s*//;
# spent 900ns making 1 call to Date::Manip::TZ::CORE:subst
52913µs11µs $line =~ s/\s*$//;
# spent 1µs making 1 call to Date::Manip::TZ::CORE:subst
53012µs1900ns $line =~ s/["']//g; # "
# spent 900ns making 1 call to Date::Manip::TZ::CORE:subst
53112µs1300ns $line =~ s/\s+/_/g;
# spent 300ns making 1 call to Date::Manip::TZ::CORE:subst
5321600ns push(@z,$line);
533 }
534 }
53512µs1500ns close(IN);
# spent 500ns making 1 call to Date::Manip::TZ::CORE:close
536
5371300ns push(@zone,@z) if (@z);
538
53917µ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
62932µs foreach my $zone (@zone) {
6301700ns $zone = lc($zone);
631 # OpenUNIX puts a colon at the start
632112µs1400ns $zone =~ s/^://;
# spent 400ns making 1 call to Date::Manip::TZ::CORE:subst
633
634 # If we got a zone name/alias
63512µs16µs $currzone = $self->_zone($zone);
# spent 6µs making 1 call to Date::Manip::TZ::_zone
63612µ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
6511200ns if (! $currzone) {
652 warn "ERROR: Date::Manip unable to determine Time Zone.\n";
653 die;
654 }
655
65614µ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#
721247µs225µs
# spent 16µs (7+9) within Date::Manip::TZ::BEGIN@721 which was called: # once (7µs+9µs) by Date::Manip::Date::BEGIN@27 at line 721
no warnings;
# spent 16µs making 1 call to Date::Manip::TZ::BEGIN@721 # spent 9µ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.10ms211µs
# spent 8µs (5+3) within Date::Manip::TZ::BEGIN@731 which was called: # once (5µs+3µs) by Date::Manip::Date::BEGIN@27 at line 731
use warnings;
# spent 8µs making 1 call to Date::Manip::TZ::BEGIN@731 # spent 3µs making 1 call to warnings::import
732
733########################################################################
734# DETERMINING A TIMEZONE
735########################################################################
736
737sub zone {
738 my($self,@args) = @_;
739 my $dmb = $$self{'base'};
740 if (! @args) {
741 my($tz) = $self->_now('tz',1);
742 return $$self{'data'}{'ZoneNames'}{$tz}
743 }
744
745 # Parse the arguments
746
747 my($zone,$abbrev,$offset,$dstflag) = ('','','','');
748 my $date = [];
749 my $tmp;
750 foreach my $arg (@args) {
751
752 if (ref($arg) eq 'ARRAY') {
753 if ($#$arg == 5) {
754 # [Y,M,D,H,Mn,S]
755 return undef if (@$date);
756 $date = $arg;
757
758 } elsif ($#$arg == 2) {
759 # [H,Mn,S]
760 return undef if ($offset);
761 $offset = $dmb->join('offset',$arg);
762 return undef if (! $offset);
763
764 } else {
765 return undef;
766 }
767
768 } elsif (ref($arg)) {
769 return undef;
770
771 } else {
772 $arg = lc($arg);
773
774 if ($arg =~ /^(std|dst|stdonly|dstonly)$/) {
775 return undef if ($dstflag);
776 $dstflag = $arg;
777
778 } elsif ($tmp = $self->_zone($arg)) {
779 return undef if ($zone);
780 $zone = $tmp;
781
782 } elsif (exists $$self{'data'}{'MyAbbrev'}{$arg} ||
783 exists $$self{'data'}{'Abbrev'}{$arg}) {
784 return undef if ($abbrev);
785 $abbrev = $arg;
786 } elsif (exists $$self{'data'}{'Abbrev'}{$arg}) {
787 return undef if ($abbrev);
788 $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 return $self->__zone($date,$offset,$zone,$abbrev,$dstflag);
805}
806
807# $date = [Y,M,D,H,Mn,S]
808# $offset = '-HH:Mn:SS'
809# $zone = 'us/eastern' (lowercase)
810# $abbrev = 'est' (lowercase)
811# $dstflag= 'stdonly' (lowercase)
812#
813
# spent 1.33s (487ms+842ms) within Date::Manip::TZ::__zone which was called 2430 times, avg 547µs/call: # 2430 times (487ms+842ms) by Date::Manip::Date::_parse_check at line 986 of Date/Manip/Date.pm, avg 547µs/call
sub __zone {
8142430963µs my($self,$date,$offset,$zone,$abbrev,$dstflag) = @_;
8152430466µs my $dmb = $$self{'base'};
816
817 #
818 # Determine the zones that match all data.
819 #
820
8212430165µs my @zone;
822
8232430237µs while (1) {
824
825 # No information
826
8272430432µs if (! $zone &&
828 ! $abbrev &&
829 ! $offset) {
830 my($z) = $self->_now('tz',1);
831 @zone = (lc($z));
832 }
833
834 # $dstflag
835 #
836 # $dstflag is "dst' if
837 # zone is passed in as an offset
838 # date is passed in
839
8402430822µs $dstflag = "dst" if ($offset && @$date && ! $dstflag);
841
8422430140µs my(@isdst);
84324301.28ms if ($dstflag eq 'stdonly') {
844 @isdst = (0);
845 } elsif ($dstflag eq 'dstonly') {
846 @isdst = (1);
847 } elsif ($dstflag eq 'dst') {
848 @isdst = (1,0);
849 } else {
85064µs @isdst = (0,1);
851 }
852
853 # $zone
854
8552430221µs if ($zone) {
856 @zone = ($zone);
857 }
858
859 # $abbrev
860
8612430155µs if ($abbrev) {
8626900ns my @abbrev_zones;
863626µs if (exists $$self{'data'}{'MyAbbrev'}{$abbrev}) {
864 @abbrev_zones = @{ $$self{'data'}{'MyAbbrev'}{$abbrev} };
865 } elsif (exists $$self{'data'}{'Abbrev'}{$abbrev}) {
866 @abbrev_zones = @{ $$self{'data'}{'Abbrev'}{$abbrev} };
867 }
868
86961µs my @z;
87064µs foreach my $isdst (@isdst) {
8711227µs1237.4ms my @tmp = $self->_check_abbrev_isdst($abbrev,$isdst,@abbrev_zones);
# spent 37.4ms making 12 calls to Date::Manip::TZ::_check_abbrev_isdst, avg 3.12ms/call
8721212µs if (@tmp) {
873 if (@z) {
874 @z = _list_add(\@z,\@tmp);
875 } else {
87667µs @z = @tmp;
877 }
878 }
879 }
880
88163µs if (@zone) {
882 @zone = _list_union(\@z,\@zone);
883 } else {
88469µs @zone = @z;
885 }
88668µs last if (! @zone);
887 }
888
889 # $offset
890
8912430450µs if ($offset) {
89224241.07ms return undef if (! exists $$self{'data'}{'Offmod'}{$offset});
89324241.39ms24246.07ms $self->_offmod($offset);
# spent 6.07ms making 2424 calls to Date::Manip::TZ::_offmod, avg 3µs/call
894
8952424166µs my @z;
8962424684µs foreach my $isdst (@isdst) {
89748483.73ms my $tmp = $$self{'data'}{'MyOffsets'}{$offset}{$isdst} ||
898 $$self{'data'}{'Offsets'}{$offset}{$isdst};
899 # my @tmp;
900 # if (exists $$self{'data'}{'MyOffsets'}{$offset}{$isdst}) {
901 # @tmp = @{ $$self{'data'}{'MyOffsets'}{$offset}{$isdst} };
902 # } elsif (exists $$self{'data'}{'Offsets'}{$offset}{$isdst}) {
903 # @tmp = @{ $$self{'data'}{'Offsets'}{$offset}{$isdst} };
904 # }
905
9064848278µs my @tmp;
9074848692µs if ($abbrev) {
908 @tmp = $self->_check_offset_abbrev_isdst($offset,$abbrev,$isdst,$tmp);
909 } else {
91048486.88ms @tmp = @$tmp if ($tmp);
911 }
912
913484814.7ms242358.9ms if (@tmp) {
# spent 58.9ms making 2423 calls to Date::Manip::TZ::_list_add, avg 24µs/call
914 if (@z) {
915 @z = _list_add(\@z,\@tmp);
916 } else {
91724241.84ms @z = @tmp;
918 }
919 }
920 }
921
9222424570µs if (@zone) {
923 @zone = _list_union(\@zone,\@z);
924 } else {
92524243.46ms @zone = @z;
926 }
92724241.73ms last if (! @zone);
928 }
929
930 # $date
931
9322430636µs if (@$date) {
933 # Get all periods for the year.
934 #
935 # Test all periods to make sure that $date is between the
936 # wallclock times AND matches other criteria. All periods
937 # must be tested since the same wallclock time can be in
938 # multiple periods.
939
9402430142µs my @tmp;
9412430303µs my $isdst = '';
9422430279µs $isdst = 0 if ($dstflag eq 'stdonly');
9432430190µs $isdst = 1 if ($dstflag eq 'dstonly');
944
945 ZONE:
94624304.86ms foreach my $z (@zone) {
94710742740.9ms336472ms $self->_module($z) if (! exists $$self{'data'}{'Zones'}{$z}{'Loaded'});
# spent 472ms making 336 calls to Date::Manip::TZ::_module, avg 1.40ms/call
94810742713.2ms my $y = $$date[0];
94910742756.3ms107427186ms my @periods = $self->_all_periods($z,$y);
# spent 186ms making 107427 calls to Date::Manip::TZ::_all_periods, avg 2µs/call
950
95110742747.7ms foreach my $period (@periods) {
952221967109ms16240582.2ms next if (($abbrev ne '' && lc($abbrev) ne lc($$period[4])) ||
# spent 82.2ms making 162405 calls to Date::Manip::Base::cmp, avg 506ns/call
953 ($offset ne '' && $offset ne $$period[2]) ||
954 ($isdst ne '' && $isdst ne $$period[5]) ||
955 $dmb->cmp($date,$$period[1]) == -1 ||
956 $dmb->cmp($date,$$period[7]) == 1
957 );
958475265.70ms push(@tmp,$z);
9594752611.4ms next ZONE;
960 }
961 }
96224303.82ms @zone = @tmp;
96324301.14ms last if (! @zone);
964 }
965
9662430754µs last;
967 }
968
969 # Return the value/list
970
9712430315µs if (wantarray) {
972 my @ret;
973 foreach my $z (@zone) {
974 push(@ret,$$self{'data'}{'ZoneNames'}{$z});
975 }
976 return @ret;
977 }
978
9792430298µs return '' if (! @zone);
98024304.89ms return $$self{'data'}{'ZoneNames'}{$zone[0]}
981}
982
983# This returns a list of all timezones which have the correct
984# abbrev/isdst combination.
985#
986
# spent 37.4ms (34.6+2.83) within Date::Manip::TZ::_check_abbrev_isdst which was called 12 times, avg 3.12ms/call: # 12 times (34.6ms+2.83ms) by Date::Manip::TZ::__zone at line 871, avg 3.12ms/call
sub _check_abbrev_isdst {
9871215µs my($self,$abbrev,$isdst,@zones) = @_;
988
989123µs my @ret;
990 ZONE:
9911219µs foreach my $zone (@zones) {
992302153µs $self->_module($zone) if (! exists $$self{'data'}{'Zones'}{$zone}{'Loaded'});
993
9943024.53ms3022.83ms foreach my $y (sort keys %{ $$self{'data'}{'Zones'}{$zone}{'Dates'} }) {
# spent 2.83ms making 302 calls to Date::Manip::TZ::CORE:sort, avg 9µs/call
995130988.67ms my @periods = @{ $$self{'data'}{'Zones'}{$zone}{'Dates'}{$y} };
996130986.82ms foreach my $period (@periods) {
9972517911.5ms my($dateUT,$dateLT,$off,$offref,$abb,$dst,$endUT,$endLT) = @$period;
998251795.44ms next if (lc($abbrev) ne lc($abb) ||
999 $isdst != $dst);
100015121µs push(@ret,$zone);
1001151219µs next ZONE;
1002 }
1003 }
1004 }
1005
10061237µs return @ret;
1007}
1008
1009# This returns a list of all timezones which have the correct
1010# abbrev/isdst combination.
1011#
1012sub _check_offset_abbrev_isdst {
1013 my($self,$offset,$abbrev,$isdst,$zones) = @_;
1014
1015 my @ret;
1016 ZONE: foreach my $zone (@$zones) {
1017 $self->_module($zone) if (! exists $$self{'data'}{'Zones'}{$zone}{'Loaded'});
1018
1019 foreach my $y (sort keys %{ $$self{'data'}{'Zones'}{$zone}{'Dates'} }) {
1020 my @periods = @{ $$self{'data'}{'Zones'}{$zone}{'Dates'}{$y} };
1021 foreach my $period (@periods) {
1022 my($dateUT,$dateLT,$off,$offref,$abb,$dst,$endUT,$endLT) = @$period;
1023 next if (lc($abbrev) ne lc($abb) ||
1024 $offset ne $off ||
1025 $isdst != $dst);
1026 push(@ret,$zone);
1027 next ZONE;
1028 }
1029 }
1030 }
1031
1032 return @ret;
1033}
1034
1035# This finds the elements common to two lists, and preserves the order
1036# from the first list.
1037#
1038sub _list_union {
1039 my($list1,$list2) = @_;
1040 my(%list2) = map { $_,1 } @$list2;
1041 my(@ret);
1042 foreach my $ele (@$list1) {
1043 push(@ret,$ele) if (exists $list2{$ele});
1044 }
1045 return @ret;
1046}
1047
1048# This adds elements from the second list to the first list, provided
1049# they are not already there.
1050#
1051
# spent 58.9ms within Date::Manip::TZ::_list_add which was called 2423 times, avg 24µs/call: # 2423 times (58.9ms+0s) by Date::Manip::TZ::__zone at line 913, avg 24µs/call
sub _list_add {
10522423363µs my($list1,$list2) = @_;
1053242312.0ms my(%list1) = map { $_,1 } @$list1;
105424231.69ms my(@ret) = @$list1;
105524232.52ms foreach my $ele (@$list2) {
10568798310.3ms next if (exists $list1{$ele});
1057661406.17ms push(@ret,$ele);
10586614017.6ms $list1{$ele} = 1;
1059 }
1060242310.1ms return @ret;
1061}
1062
1063########################################################################
1064# PERIODS METHODS
1065########################################################################
1066
1067sub all_periods {
1068 my($self,$zone,$year) = @_;
1069
1070 my $z = $self->_zone($zone);
1071 if (! $z) {
1072 warn "ERROR: [periods] Invalid zone: $zone\n";
1073 return;
1074 }
1075 $zone = $z;
1076 $self->_module($zone) if (! exists $$self{'data'}{'Zones'}{$zone}{'Loaded'});
1077
1078 # Run a faster 'dclone' so we don't return the actual data.
1079
1080 my @tmp = $self->_all_periods($zone,$year);
1081 my @ret;
1082 foreach my $ele (@tmp) {
1083 push(@ret,
1084 [ [ @{$$ele[0]} ],[ @{$$ele[1]} ],$$ele[2],[ @{$$ele[3]} ],$$ele[4],
1085 $$ele[5], [ @{$$ele[6]} ],[ @{$$ele[7]} ],$$ele[8],$$ele[9],
1086 $$ele[10],$$ele[11] ]);
1087 }
1088 return @ret;
1089}
1090
1091
# spent 193ms (159+34.0) within Date::Manip::TZ::_all_periods which was called 112286 times, avg 2µs/call: # 107427 times (152ms+34.0ms) by Date::Manip::TZ::__zone at line 949, avg 2µs/call # 4859 times (6.95ms+0s) by Date::Manip::TZ::date_period at line 1234, avg 1µs/call
sub _all_periods {
109211228616.1ms my($self,$zone,$year) = @_;
10931122868.45ms $year += 0;
1094
109511228641.2ms if (! exists $$self{'data'}{'Zones'}{$zone}{'AllDates'}{$year}) {
1096
1097 #
1098 # $ym1 is the year prior to $year which contains a rule (which will
1099 # end in $year or later). $y is $year IF the zone contains rules
1100 # for this year.
1101 #
1102
11031680127µs my($ym1,$ym0);
110416802.00ms if ($year > $$self{'data'}{'LastYear'} &&
1105 exists $$self{'data'}{'Zones'}{$zone}{'LastRule'}{'zone'}) {
1106 $ym1 = $year-1;
1107 $ym0 = $year;
1108
1109 } else {
1110168025.7ms168013.3ms foreach my $y (sort { $a <=> $b }
# spent 13.3ms making 1680 calls to Date::Manip::TZ::CORE:sort, avg 8µs/call
1111 keys %{ $$self{'data'}{'Zones'}{$zone}{'Dates'} }) {
1112525474.26ms if ($y < $year) {
1113515993.64ms $ym1 = $y;
1114515993.40ms next;
1115 }
1116948156µs $ym0 = $year if ($year == $y);
1117948189µs last;
1118 }
1119 }
11201680134µs $ym1 = 0 if (! $ym1);
1121
1122 #
1123 # Get the periods from the prior year. The last one is used (any others
1124 # are discarded).
1125 #
1126
11271680134µs my(@periods);
1128
1129 # $ym1 will be 0 in 0001
11301680335µs if ($ym1) {
113116801.24ms168013.6ms my @tmp = $self->_periods($zone,$ym1);
# spent 13.6ms making 1680 calls to Date::Manip::TZ::_periods, avg 8µs/call
113216801.00ms push(@periods,pop(@tmp)) if (@tmp);
1133 }
1134
1135 #
1136 # Add on any periods from the current year.
1137 #
1138
11391680585µs9207.05ms if ($ym0) {
# spent 7.05ms making 920 calls to Date::Manip::TZ::_periods, avg 8µs/call
1140 push(@periods,$self->_periods($zone,$year));
1141 }
1142
114316801.22ms $$self{'data'}{'Zones'}{$zone}{'AllDates'}{$year} = [ @periods ];
1144 }
1145
1146112286123ms return @{ $$self{'data'}{'Zones'}{$zone}{'AllDates'}{$year} };
1147}
1148
1149sub periods {
1150 my($self,$zone,$year,$year1) = @_;
1151
1152 my $z = $self->_zone($zone);
1153 if (! $z) {
1154 warn "ERROR: [periods] Invalid zone: $zone\n";
1155 return;
1156 }
1157 $zone = $z;
1158 $self->_module($zone) if (! exists $$self{'data'}{'Zones'}{$zone}{'Loaded'});
1159
1160 if (! defined($year1)) {
1161 return $self->_periods($zone,$year);
1162 }
1163
1164 $year = 1 if (! defined($year));
1165
1166 my @ret;
1167 my $lastyear = $$self{'data'}{'LastYear'};
1168
1169 if ($year <= $lastyear) {
1170 foreach my $y (sort { $a <=> $b }
1171 keys %{ $$self{'data'}{'Zones'}{$zone}{'Dates'} }) {
1172 last if ($y > $year1 || $y > $lastyear);
1173 next if ($y < $year);
1174 push(@ret,$self->_periods($zone,$y));
1175 }
1176 }
1177
1178 if ($year1 > $lastyear) {
1179 $year = $lastyear + 1 if ($year <= $lastyear);
1180 foreach my $y ($year..$year1) {
1181 push(@ret,$self->_periods($zone,$y));
1182 }
1183 }
1184
1185 return @ret;
1186}
1187
1188
# spent 20.7ms within Date::Manip::TZ::_periods which was called 2600 times, avg 8µs/call: # 1680 times (13.6ms+0s) by Date::Manip::TZ::_all_periods at line 1131, avg 8µs/call # 920 times (7.05ms+0s) by Date::Manip::TZ::_all_periods at line 1139, avg 8µs/call
sub _periods {
11892600487µs my($self,$zone,$year) = @_;
11902600263µs $year += 0;
1191
119226001.13ms if (! exists $$self{'data'}{'Zones'}{$zone}{'Dates'}{$year}) {
1193
1194 my @periods = ();
1195 if ($year > $$self{'data'}{'LastYear'}) {
1196 # Calculate periods using the LastRule method
1197 @periods = $self->_lastrule($zone,$year);
1198 }
1199
1200 $$self{'data'}{'Zones'}{$zone}{'Dates'}{$year} = [ @periods ];
1201 }
1202
1203 # A faster 'dclone' so we don't return the actual data
12042600155µs my @ret;
120526002.05ms foreach my $ele (@{ $$self{'data'}{'Zones'}{$zone}{'Dates'}{$year} }) {
1206 push(@ret,
1207 [ [ @{$$ele[0]} ],[ @{$$ele[1]} ],$$ele[2],[ @{$$ele[3]} ],$$ele[4],$$ele[5],
1208462015.4ms [ @{$$ele[6]} ],[ @{$$ele[7]} ],$$ele[8],$$ele[9],$$ele[10],$$ele[11] ]);
1209 }
121026002.85ms return @ret;
1211}
1212
1213
# spent 88.3ms (53.0+35.3) within Date::Manip::TZ::date_period which was called 4859 times, avg 18µs/call: # 2430 times (28.4ms+20.0ms) by Date::Manip::Date::__parse_check at line 1043 of Date/Manip/Date.pm, avg 20µs/call # 2428 times (24.6ms+15.2ms) by Date::Manip::Date::set at line 2705 of Date/Manip/Date.pm, avg 16µs/call # once (28µs+15µs) by Date::Manip::TZ_Base::_update_now at line 392 of Date/Manip/TZ_Base.pm
sub date_period {
121448591.19ms my($self,$date,$zone,$wallclock,$isdst) = @_;
12154859543µs $wallclock = 0 if (! $wallclock);
12164859628µs $isdst = 0 if (! $isdst);
1217
121848592.77ms48597.24ms my $z = $self->_zone($zone);
# spent 7.24ms making 4859 calls to Date::Manip::TZ::_zone, avg 1µs/call
12194859399µs if (! $z) {
1220 warn "ERROR: [date_period] Invalid zone: $zone\n";
1221 return;
1222 }
12234859542µs $zone = $z;
122448591.94ms $self->_module($zone) if (! exists $$self{'data'}{'Zones'}{$zone}{'Loaded'});
1225
12264859703µs my $dmb = $$self{'base'};
122748593.43ms my @date = @$date;
12284859689µs my $year = $date[0];
122948593.62ms485921.1ms my $dates= $dmb->_date_fields(@$date);
# spent 21.1ms making 4859 calls to Date::Manip::Base::_date_fields, avg 4µs/call
1230
12314859601µs if ($wallclock) {
1232 # A wallclock date
1233
123448593.47ms48596.95ms my @period = $self->_all_periods($zone,$year);
# spent 6.95ms making 4859 calls to Date::Manip::TZ::_all_periods, avg 1µs/call
123548591.27ms my $beg = $period[0]->[9];
12364859906µs my $end = $period[-1]->[11];
123748591.80ms if (($dates cmp $beg) == -1) {
1238 @period = $self->_all_periods($zone,$year-1);
1239 } elsif (($dates cmp $end) == 1) {
1240 @period = $self->_all_periods($zone,$year+1);
1241 }
1242
12434859374µs my(@per);
124448591.57ms foreach my $period (@period) {
1245106634.24ms my($begUT,$begLT,$offsetstr,$offset,$abbrev,$dst,$endUT,$endLT,
1246 $begUTs,$begLTs,$endUTs,$endLTs) = @$period;
1247106636.00ms if (($dates cmp $begLTs) != -1 && ($dates cmp $endLTs) != 1) {
1248 push(@per,$period);
1249 }
1250 }
1251
125248599.46ms if ($#per == -1) {
1253 return ();
1254 } elsif ($#per == 0) {
1255 return $per[0];
1256 } elsif ($#per == 1) {
1257 if ($per[0][5] == $isdst) {
1258 return $per[0];
1259 } else {
1260 return $per[1];
1261 }
1262 } else {
1263 warn "ERROR: [date_period] Impossible error\n";
1264 return;
1265 }
1266
1267 } else {
1268 # A GMT date
1269
1270 my @period = $self->_all_periods($zone,$year);
1271 foreach my $period (@period) {
1272 my($begUT,$begLT,$offsetstr,$offset,$abbrev,$isdst,$endUT,$endLT,
1273 $begUTs,$begLTs,$endUTs,$endLTs) = @$period;
1274 if (($dates cmp $begUTs) != -1 && ($dates cmp $endUTs) != 1) {
1275 return $period;
1276 }
1277 }
1278 warn "ERROR: [date_period] Impossible error\n";
1279 return;
1280 }
1281}
1282
1283# Calculate critical dates from the last rule. If $endonly is passed
1284# in, it only calculates the ending of the zone period before the
1285# start of the first one. This is necessary so that the last period in
1286# one year can find out when it ends (which is determined in the
1287# following year).
1288#
1289# Returns:
1290# [begUT, begLT, offsetstr, offset, abb, ISDST, endUT, endLT,
1291# begUTstr, begLTstr, endUTstr, endLTstr]
1292# for each.
1293#
1294sub _lastrule {
1295 my($self,$zone,$year,$endonly) = @_;
1296
1297 #
1298 # Get the list of rules (actually, the month in which the
1299 # rule triggers a time change). If there are none, then
1300 # this zone doesn't have a LAST RULE.
1301 #
1302
1303 my @mon = (sort keys
1304 %{ $$self{'data'}{'Zones'}{$zone}{'LastRule'}{'rules'} });
1305 return () if (! @mon);
1306
1307 #
1308 # Analyze each time change.
1309 #
1310
1311 my @dates = ();
1312 my $dmb = $$self{'base'};
1313
1314 my $stdoff = $$self{'data'}{'Zones'}{$zone}{'LastRule'}{'zone'}{'stdoff'};
1315 my $dstoff = $$self{'data'}{'Zones'}{$zone}{'LastRule'}{'zone'}{'dstoff'};
1316
1317 my (@period);
1318
1319 foreach my $mon (@mon) {
1320 my $flag =
1321 $$self{'data'}{'Zones'}{$zone}{'LastRule'}{'rules'}{$mon}{'flag'};
1322 my $dow =
1323 $$self{'data'}{'Zones'}{$zone}{'LastRule'}{'rules'}{$mon}{'dow'};
1324 my $num =
1325 $$self{'data'}{'Zones'}{$zone}{'LastRule'}{'rules'}{$mon}{'num'};
1326 my $isdst=
1327 $$self{'data'}{'Zones'}{$zone}{'LastRule'}{'rules'}{$mon}{'isdst'};
1328 my $time =
1329 $$self{'data'}{'Zones'}{$zone}{'LastRule'}{'rules'}{$mon}{'time'};
1330 my $type =
1331 $$self{'data'}{'Zones'}{$zone}{'LastRule'}{'rules'}{$mon}{'type'};
1332 my $abb =
1333 $$self{'data'}{'Zones'}{$zone}{'LastRule'}{'rules'}{$mon}{'abb'};
1334
1335 # The end of the current period and the beginning of the next
1336 my($endUT,$endLT,$begUT,$begLT) =
1337 $dmb->_critical_date($year,$mon,$flag,$num,$dow,
1338 $isdst,$time,$type,$stdoff,$dstoff);
1339 return ($endUT,$endLT) if ($endonly);
1340
1341 if (@period) {
1342 push(@period,$endUT,$endLT);
1343 push(@dates,[@period]);
1344 }
1345 my $offsetstr = ($isdst ? $dstoff : $stdoff);
1346 my $offset = $dmb->split('offset',$offsetstr);
1347
1348 @period = ($begUT,$begLT,$offsetstr,$offset,$abb,$isdst);
1349 }
1350
1351 push(@period,$self->_lastrule($zone,$year+1,1));
1352 push(@dates,[@period]);
1353
1354 foreach my $period (@dates) {
1355 my($begUT,$begLT,$offsetstr,$offset,$abbrev,$dst,$endUT,$endLT) = @$period;
1356 my $begUTstr = $dmb->join("date",$begUT);
1357 my $begLTstr = $dmb->join("date",$begLT);
1358 my $endUTstr = $dmb->join("date",$endUT);
1359 my $endLTstr = $dmb->join("date",$endLT);
1360 $period = [$begUT,$begLT,$offsetstr,$offset,$abbrev,$dst,$endUT,$endLT,
1361 $begUTstr,$begLTstr,$endUTstr,$endLTstr];
1362 }
1363
1364 return @dates;
1365}
1366
1367########################################################################
1368# CONVERSION
1369########################################################################
1370
1371sub convert {
1372 my($self,$date,$from,$to,$isdst) = @_;
1373 $self->_convert('convert',$date,$from,$to,$isdst);
1374}
1375
1376sub convert_to_gmt {
1377 my($self,$date,@arg) = @_;
1378 my($err,$from,$isdst) = _convert_args('convert_to_gmt',@arg);
1379 return (1) if ($err);
1380
1381 my $dmb = $$self{'base'};
1382
1383 if (! $from) {
1384 $from = $self->_now('tz',1);
1385 }
1386 $self->_convert('convert_to_gmt',$date,$from,'GMT',$isdst);
1387}
1388
1389sub convert_from_gmt {
1390 my($self,$date,@arg) = @_;
1391 my($err,$to,$isdst) = _convert_args('convert_from_gmt',@arg);
1392 return (1) if ($err);
1393
1394 my $dmb = $$self{'base'};
1395
1396 if (! $to) {
1397 $to = $self->_now('tz',1);
1398 }
1399 $self->_convert('convert_from_gmt',$date,'GMT',$to,$isdst);
1400}
1401
1402sub convert_to_local {
1403 my($self,$date,@arg) = @_;
1404 my($err,$from,$isdst) = _convert_args('convert_to_local',@arg);
1405 return (1) if ($err);
1406
1407 my $dmb = $$self{'base'};
1408
1409 if (! $from) {
1410 $from = 'GMT';
1411 }
1412 $self->_convert('convert_to_local',$date,$from,$self->_now('tz',1),$isdst);
1413}
1414
1415sub convert_from_local {
1416 my($self,$date,@arg) = @_;
1417 my($err,$to,$isdst) = _convert_args('convert_from_local',@arg);
1418 return (1) if ($err);
1419
1420 my $dmb = $$self{'base'};
1421
1422 if (! $to) {
1423 $to = 'GMT';
1424 }
1425 $self->_convert('convert_from_local',$date,$self->_now('tz',1),$to,$isdst);
1426}
1427
1428sub _convert_args {
1429 my($caller,@args) = @_;
1430
1431 if ($#args == -1) {
1432 return (0,'',0);
1433 } elsif ($#args == 0) {
1434 if ($args[0] eq '0' ||
1435 $args[0] eq '1') {
1436 return (0,'',$args[0]);
1437 } else {
1438 return (0,$args[0],0);
1439 }
1440 } elsif ($#args == 1) {
1441 return (0,@args);
1442 } else {
1443 return (1,'',0);
1444 }
1445}
1446
1447sub _convert {
1448 my($self,$caller,$date,$from,$to,$isdst) = @_;
1449 my $dmb = $$self{'base'};
1450
1451 # Handle $date as a reference and a string
1452 my (@date);
1453 if (ref($date)) {
1454 @date = @$date;
1455 } else {
1456 @date = @{ $dmb->split('date',$date) };
1457 $date = [@date];
1458 }
1459
1460 if ($from ne $to) {
1461 my $tmp = $self->_zone($from);
1462 if (! $tmp) {
1463 return (2);
1464 }
1465 $from = $tmp;
1466
1467 $tmp = $self->_zone($to);
1468 if (! $tmp) {
1469 return (3);
1470 }
1471 $to = $tmp;
1472 }
1473
1474 if ($from eq $to) {
1475 my $per = $self->date_period($date,$from,1,$isdst);
1476 my $offset = $$per[3];
1477 my $abb = $$per[4];
1478 return (0,$date,$offset,$isdst,$abb);
1479 }
1480
1481 # Convert $date from $from to GMT
1482
1483 if ($from ne "Etc/GMT") {
1484 my $per = $self->date_period($date,$from,1,$isdst);
1485 if (! $per) {
1486 return (4);
1487 }
1488 my $offset = $$per[3];
1489 @date = @{ $dmb->calc_date_time(\@date,$offset,1) };
1490 }
1491
1492 # Convert $date from GMT to $to
1493
1494 $isdst = 0;
1495 my $offset = [0,0,0];
1496 my $abb = 'GMT';
1497
1498 if ($to ne "Etc/GMT") {
1499 my $per = $self->date_period([@date],$to,0);
1500 $offset = $$per[3];
1501 $isdst = $$per[5];
1502 $abb = $$per[4];
1503 @date = @{ $dmb->calc_date_time(\@date,$offset) };
1504 }
1505
1506 return (0,[@date],$offset,$isdst,$abb);
1507}
1508
1509########################################################################
1510# REGULAR EXPRESSIONS FOR TIMEZONE INFORMATION
1511########################################################################
1512
1513# Returns regular expressions capable of matching timezones.
1514#
1515# The timezone regular expressions are:
1516# namerx : this will match a zone name or alias (America/New_York)
1517# abbrx : this will match a zone abbreviation (EDT)
1518# zonerx : this will match a zone name or an abbreviation
1519# offrx : this will match a pure offset (+0400)
1520# offabbrx : this will match an offset with an abbreviation (+0400 WET)
1521# offparrx : this will match an offset and abbreviation if parentheses
1522# ("+0400 (WET)")
1523# zrx : this will match all forms
1524#
1525# The regular expression will have the following named matches:
1526# tzstring : the full string matched
1527# zone : the name/alias
1528# abb : the zone abbrevation
1529# off : the offset
1530#
1531
# spent 15.7ms (4.79+11.0) within Date::Manip::TZ::_zrx which was called 4 times, avg 3.94ms/call: # once (4.78ms+11.0ms) by Date::Manip::Date::_iso8601_rx at line 1156 of Date/Manip/Date.pm # once (2µs+0s) by Date::Manip::Date::_other_rx at line 1523 of Date/Manip/Date.pm # once (1µs+0s) by Date::Manip::Date::_other_rx at line 1418 of Date/Manip/Date.pm # once (700ns+0s) by Date::Manip::Date::_other_rx at line 1524 of Date/Manip/Date.pm
sub _zrx {
153241µs my($self,$re) = @_;
153347µs return $$self{'data'}{$re} if (defined $$self{'data'}{$re});
1534
1535 # Zone name
1536
15371300ns my @zone;
1538112µs if (exists $ENV{'DATE_MANIP_DEBUG_ZONES'}) {
1539 @zone = split(/\s+/,$ENV{'DATE_MANIP_DEBUG_ZONES'});
1540 } else {
1541 @zone = (keys %{ $$self{'data'}{'Alias'} },
15421107µs keys %{ $$self{'data'}{'MyAlias'} });
1543 }
154414µs1926µs @zone = sort _sortByLength(@zone);
# spent 926µs making 1 call to Date::Manip::TZ::CORE:sort
154511µs foreach my $zone (@zone) {
1546825784µs825176µs $zone =~ s/\057/\\057/g; # /
# spent 176µs making 825 calls to Date::Manip::TZ::CORE:subst, avg 213ns/call
1547825618µs82549µs $zone =~ s/\055/\\055/g; # -
# spent 49µs making 825 calls to Date::Manip::TZ::CORE:subst, avg 60ns/call
1548825567µs82515µs $zone =~ s/\056/\\056/g; # .
# spent 15µs making 825 calls to Date::Manip::TZ::CORE:subst, avg 19ns/call
1549825578µs82513µs $zone =~ s/\050/\\050/g; # (
# spent 13µs making 825 calls to Date::Manip::TZ::CORE:subst, avg 16ns/call
1550825571µs82518µs $zone =~ s/\051/\\051/g; # )
# spent 18µs making 825 calls to Date::Manip::TZ::CORE:subst, avg 22ns/call
1551825719µs82511µs $zone =~ s/\053/\\053/g; # +
# spent 11µs making 825 calls to Date::Manip::TZ::CORE:subst, avg 13ns/call
1552 }
1553
1554127µs my $zone = join('|',@zone);
155511.54ms21.48ms $zone = qr/(?<zone>$zone)/i;
# spent 1.48ms making 1 call to Date::Manip::TZ::CORE:regcomp # spent 1µs making 1 call to Date::Manip::TZ::CORE:qr
1556
1557 # Abbreviation
1558
15591200ns my @abb;
156016µs if (exists $ENV{'DATE_MANIP_DEBUG_ABBREVS'}) {
1561 @abb = split(/\s+/,$ENV{'DATE_MANIP_DEBUG_ABBREVS'});
1562 } else {
1563 @abb = (keys %{ $$self{'data'}{'Abbrev'} },
1564171µs keys %{ $$self{'data'}{'MyAbbrev'} });
1565 }
156612µs1348µs @abb = sort _sortByLength(@abb);
# spent 348µs making 1 call to Date::Manip::TZ::CORE:sort
15671800ns foreach my $abb (@abb) {
1568403291µs4035µs $abb =~ s/\055/\\055/g; # -
# spent 5µs making 403 calls to Date::Manip::TZ::CORE:subst, avg 13ns/call
1569403348µs4035µs $abb =~ s/\053/\\053/g; # +
# spent 5µs making 403 calls to Date::Manip::TZ::CORE:subst, avg 12ns/call
1570 }
1571
1572110µs my $abb = join('|',@abb);
15731485µs2459µs $abb = qr/(?<abb>$abb)/i;
# spent 458µs making 1 call to Date::Manip::TZ::CORE:regcomp # spent 900ns making 1 call to Date::Manip::TZ::CORE:qr
1574
1575 # Offset (+HH, +HHMM, +HH:MM, +HH:MM:SS, +HHMMSS)
1576
157712µs1700ns my($hr) = qr/(?:[0-1][0-9]|2[0-3])/; # 00 - 23
# spent 700ns making 1 call to Date::Manip::TZ::CORE:qr
157812µs1400ns my($mn) = qr/(?:[0-5][0-9])/; # 00 - 59
# spent 400ns making 1 call to Date::Manip::TZ::CORE:qr
157912µs1500ns my($ss) = qr/(?:[0-5][0-9])/; # 00 - 59
# spent 500ns making 1 call to Date::Manip::TZ::CORE:qr
1580
1581139µs235µs my($off) = qr/ (?<off> [+-] (?: $hr:$mn:$ss |
# spent 35µs making 1 call to Date::Manip::TZ::CORE:regcomp # spent 400ns making 1 call to Date::Manip::TZ::CORE:qr
1582 $hr$mn$ss |
1583 $hr:?$mn |
1584 $hr
1585 )
1586 ) /ix;
1587
1588 # Assemble everything
1589 #
1590 # A timezone can be any of the following in this order:
1591 # Offset (ABB)
1592 # Offset ABB
1593 # ABB
1594 # Zone
1595 # Offset
1596 # We put ABB before Zone so CET gets parse as the more common abbreviation
1597 # than the less common zone name.
1598
159911.44ms21.39ms $$self{'data'}{'namerx'} = qr/(?<tzstring>$zone)/;
# spent 1.39ms making 1 call to Date::Manip::TZ::CORE:regcomp # spent 900ns making 1 call to Date::Manip::TZ::CORE:qr
16001503µs2476µs $$self{'data'}{'abbrx'} = qr/(?<tzstring>$abb)/;
# spent 474µs making 1 call to Date::Manip::TZ::CORE:regcomp # spent 2µs making 1 call to Date::Manip::TZ::CORE:qr
160111.98ms21.90ms $$self{'data'}{'zonerx'} = qr/(?<tzstring>(?:$abb|$zone))/;
# spent 1.90ms making 1 call to Date::Manip::TZ::CORE:regcomp # spent 900ns making 1 call to Date::Manip::TZ::CORE:qr
1602161µs256µs $$self{'data'}{'offrx'} = qr/(?<tzstring>$off)/;
# spent 56µs making 1 call to Date::Manip::TZ::CORE:regcomp # spent 600ns making 1 call to Date::Manip::TZ::CORE:qr
16031417µs2412µs $$self{'data'}{'offabbrx'} = qr/(?<tzstring>$off\s+$abb)/;
# spent 411µs making 1 call to Date::Manip::TZ::CORE:regcomp # spent 1µs making 1 call to Date::Manip::TZ::CORE:qr
16041394µs2389µs $$self{'data'}{'offparrx'} = qr/(?<tzstring>$off\s*\($abb\))/;
# spent 388µs making 1 call to Date::Manip::TZ::CORE:regcomp # spent 900ns making 1 call to Date::Manip::TZ::CORE:qr
160512.87ms22.79ms $$self{'data'}{'zrx'} = qr/(?<tzstring>(?:$off\s*\($abb\)|$off\s+$abb|$abb|$zone|$off))/;
# spent 2.79ms making 1 call to Date::Manip::TZ::CORE:regcomp # spent 900ns making 1 call to Date::Manip::TZ::CORE:qr
1606
1607129µs return $$self{'data'}{$re};
1608}
1609
1610# This sorts from longest to shortest element
1611#
1612232µs222µs
# spent 14µs (6+8) within Date::Manip::TZ::BEGIN@1612 which was called: # once (6µs+8µs) by Date::Manip::Date::BEGIN@27 at line 1612
no strict 'vars';
# spent 14µs making 1 call to Date::Manip::TZ::BEGIN@1612 # spent 8µs making 1 call to strict::unimport
1613sub _sortByLength {
161489921.27ms return (length $b <=> length $a);
1615}
16162498µs214µs
# spent 9µs (4+5) within Date::Manip::TZ::BEGIN@1616 which was called: # once (4µs+5µs) by Date::Manip::Date::BEGIN@27 at line 1616
use strict 'vars';
# spent 9µs making 1 call to Date::Manip::TZ::BEGIN@1616 # spent 5µs making 1 call to strict::import
1617
1618########################################################################
1619# CONFIG VARS
1620########################################################################
1621
1622# This sets a config variable. It also performs all side effects from
1623# setting that variable.
1624#
1625sub _config_var_tz {
1626 my($self,$var,$val) = @_;
1627
1628 if ($var eq 'tz') {
1629 my $err = $self->_config_var_setdate("now,$val",0);
1630 return if ($err);
1631 $$self{'data'}{'sections'}{'conf'}{'forcedate'} = 0;
1632 $val = 1;
1633
1634 } elsif ($var eq 'setdate') {
1635 my $err = $self->_config_var_setdate($val,0);
1636 return if ($err);
1637 $$self{'data'}{'sections'}{'conf'}{'forcedate'} = 0;
1638 $val = 1;
1639
1640 } elsif ($var eq 'forcedate') {
1641 my $err = $self->_config_var_setdate($val,1);
1642 return if ($err);
1643 $$self{'data'}{'sections'}{'conf'}{'setdate'} = 0;
1644 $val = 1;
1645
1646 } elsif ($var eq 'configfile') {
1647 $self->_config_file($val);
1648 return;
1649 }
1650
1651 my $base = $$self{'base'};
1652 $$base{'data'}{'sections'}{'conf'}{$var} = $val;
1653 return;
1654}
1655
1656sub _config_var_setdate {
1657 my($self,$val,$force) = @_;
1658 my $base = $$self{'base'};
1659
1660 my $dstrx = qr/(?:,\s*(stdonly|dstonly|std|dst))?/i;
1661 my $zonrx = qr/,\s*(.+)/;
1662 my $da1rx = qr/(\d\d\d\d)(\d\d)(\d\d)(\d\d):(\d\d):(\d\d)/;
1663 my $da2rx = qr/(\d\d\d\d)\-(\d\d)\-(\d\d)\-(\d\d):(\d\d):(\d\d)/;
1664 my $time = time;
1665
1666 my($op,$date,$dstflag,$zone,@date,$offset,$abb);
1667
1668 #
1669 # Parse the argument
1670 #
1671
1672 if ($val =~ /^now${dstrx}${zonrx}$/oi) {
1673 # now,ZONE
1674 # now,DSTFLAG,ZONE
1675 # Sets now to the system date/time but sets the timezone to be ZONE
1676
1677 $op = 'nowzone';
1678 ($dstflag,$zone) = ($1,$2);
1679
1680 } elsif ($val =~ /^zone${dstrx}${zonrx}$/oi) {
1681 # zone,ZONE
1682 # zone,DSTFLAG,ZONE
1683 # Converts 'now' to the alternate zone
1684
1685 $op = 'zone';
1686 ($dstflag,$zone) = ($1,$2);
1687
1688 } elsif ($val =~ /^${da1rx}${dstrx}${zonrx}$/o ||
1689 $val =~ /^${da2rx}${dstrx}${zonrx}$/o) {
1690 # DATE,ZONE
1691 # DATE,DSTFLAG,ZONE
1692 # Sets the date and zone
1693
1694 $op = 'datezone';
1695 my($y,$m,$d,$h,$mn,$s);
1696 ($y,$m,$d,$h,$mn,$s,$dstflag,$zone) = ($1,$2,$3,$4,$5,$6,$7,$8);
1697 $date = [$y,$m,$d,$h,$mn,$s];
1698
1699 } elsif ($val =~ /^${da1rx}$/o ||
1700 $val =~ /^${da2rx}$/o) {
1701 # DATE
1702 # Sets the date in the system timezone
1703
1704 $op = 'date';
1705 my($y,$m,$d,$h,$mn,$s) = ($1,$2,$3,$4,$5,$6);
1706 $date = [$y,$m,$d,$h,$mn,$s];
1707 $zone = $self->_now('systz',1);
1708
1709 } elsif (lc($val) eq 'now') {
1710 # now
1711 # Resets everything
1712
1713 my $systz = $$base{'data'}{'now'}{'systz'};
1714 $base->_init_now();
1715 $$base{'data'}{'now'}{'systz'} = $systz;
1716 return 0;
1717
1718 } else {
1719 warn "ERROR: [config_var] invalid SetDate/ForceDate value: $val\n";
1720 return 1;
1721 }
1722
1723 $dstflag = 'std' if (! $dstflag);
1724
1725 #
1726 # Get the date we're setting 'now' to
1727 #
1728
1729 if ($op eq 'nowzone') {
1730 # Use the system localtime
1731
1732 my($s,$mn,$h,$d,$m,$y) = localtime($time);
1733 $y += 1900;
1734 $m++;
1735 $date = [$y,$m,$d,$h,$mn,$s];
1736
1737 } elsif ($op eq 'zone') {
1738 # Use the system GMT time
1739
1740 my($s,$mn,$h,$d,$m,$y) = gmtime($time);
1741 $y += 1900;
1742 $m++;
1743 $date = [$y,$m,$d,$h,$mn,$s];
1744 }
1745
1746 #
1747 # Find out what zone was passed in. It can be an alias or an offset.
1748 #
1749
1750 if ($zone) {
1751 my ($err,@args);
1752 my $dmb = $$self{'base'};
1753 $date = [] if (! defined $date);
1754 $zone = $self->__zone($date,'',lc($zone),'',lc($dstflag));
1755 if (! $zone) {
1756 warn "ERROR: [config_var] invalid zone in SetDate: @args\n";
1757 return 1;
1758 }
1759
1760 } else {
1761 $zone = $$base{'data'}{'now'}{'systz'};
1762 }
1763
1764 #
1765 # Handle the zone
1766 #
1767
1768 my($isdst,@isdst);
1769 if ($dstflag eq 'std') {
1770 @isdst = (0,1);
1771 } elsif ($dstflag eq 'stdonly') {
1772 @isdst = (0);
1773 } elsif ($dstflag eq 'dst') {
1774 @isdst = (1,0);
1775 } else {
1776 @isdst = (1);
1777 }
1778
1779 if ($op eq 'nowzone' ||
1780 $op eq 'datezone' ||
1781 $op eq 'date') {
1782
1783 # Check to make sure that the date can exist in this zone.
1784 my $per;
1785 foreach my $dst (@isdst) {
1786 next if ($per);
1787 $per = $self->date_period($date,$zone,1,$dst);
1788 }
1789
1790 if (! $per) {
1791 warn "ERROR: [config_var] invalid date: SetDate: $date, $zone\n";
1792 return 1;
1793 }
1794 $isdst = $$per[5];
1795 $abb = $$per[4];
1796 $offset = $$per[3];
1797
1798 } elsif ($op eq 'zone') {
1799
1800 # Convert to that zone
1801 my($err);
1802 ($err,$date,$offset,$isdst,$abb) = $self->convert_from_gmt($date,$zone);
1803 if ($err) {
1804 warn "ERROR: [config_var] invalid SetDate date/offset values: $date, $zone\n";
1805 return 1;
1806 }
1807 }
1808
1809 #
1810 # Set NOW
1811 #
1812
1813 $$base{'data'}{'now'}{'date'} = $date;
1814 $$base{'data'}{'now'}{'tz'} = $self->_zone($zone);
1815 $$base{'data'}{'now'}{'isdst'} = $isdst;
1816 $$base{'data'}{'now'}{'abb'} = $abb;
1817 $$base{'data'}{'now'}{'offset'} = $offset;
1818
1819 #
1820 # Treate SetDate/ForceDate
1821 #
1822
1823 if ($force) {
1824 $$base{'data'}{'now'}{'force'} = 1;
1825 $$base{'data'}{'now'}{'set'} = 0;
1826 } else {
1827 $$base{'data'}{'now'}{'force'} = 0;
1828 $$base{'data'}{'now'}{'set'} = 1;
1829 $$base{'data'}{'now'}{'setsecs'} = $time;
1830 my($err,$setdate) = $self->convert_to_gmt($date,$zone);
1831 $$base{'data'}{'now'}{'setdate'} = $setdate;
1832 }
1833
1834 return 0;
1835}
1836
183712µs1;
1838# Local Variables:
1839# mode: cperl
1840# indent-tabs-mode: nil
1841# cperl-indent-level: 3
1842# cperl-continued-statement-offset: 2
1843# cperl-continued-brace-offset: 0
1844# cperl-brace-offset: 0
1845# cperl-brace-imaginary-offset: 0
1846# cperl-label-offset: 0
1847# End:
 
# spent 500ns within Date::Manip::TZ::CORE:close which was called: # once (500ns+0s) by Date::Manip::TZ::_get_curr_zone at line 535
sub Date::Manip::TZ::CORE:close; # opcode
# spent 3µs within Date::Manip::TZ::CORE:ftfile which was called 3 times, avg 1µs/call: # 3 times (3µs+0s) by Date::Manip::TZ::_get_curr_zone at line 468, avg 1µs/call
sub Date::Manip::TZ::CORE:ftfile; # opcode
# spent 24µs within Date::Manip::TZ::CORE:match which was called 91 times, avg 263ns/call: # 83 times (19µs+0s) by Date::Manip::TZ::_get_curr_zone at line 477, avg 234ns/call # 7 times (3µs+0s) by Date::Manip::TZ::_get_curr_zone at line 503, avg 443ns/call # once (1µs+0s) by Date::Manip::TZ::_get_curr_zone at line 508
sub Date::Manip::TZ::CORE:match; # opcode
# spent 11µs within Date::Manip::TZ::CORE:qr which was called 13 times, avg 831ns/call: # once (2µs+0s) by Date::Manip::TZ::_zrx at line 1600 # once (1µs+0s) by Date::Manip::TZ::_zrx at line 1555 # once (1µs+0s) by Date::Manip::TZ::_zrx at line 1603 # once (900ns+0s) by Date::Manip::TZ::_zrx at line 1604 # once (900ns+0s) by Date::Manip::TZ::_zrx at line 1601 # once (900ns+0s) by Date::Manip::TZ::_zrx at line 1573 # once (900ns+0s) by Date::Manip::TZ::_zrx at line 1605 # once (900ns+0s) by Date::Manip::TZ::_zrx at line 1599 # once (700ns+0s) by Date::Manip::TZ::_zrx at line 1577 # once (600ns+0s) by Date::Manip::TZ::_zrx at line 1602 # once (500ns+0s) by Date::Manip::TZ::_zrx at line 1579 # once (400ns+0s) by Date::Manip::TZ::_zrx at line 1581 # once (400ns+0s) by Date::Manip::TZ::_zrx at line 1578
sub Date::Manip::TZ::CORE:qr; # opcode
# spent 9µs within Date::Manip::TZ::CORE:readline which was called 74 times, avg 126ns/call: # 74 times (9µs+0s) by Date::Manip::TZ::_get_curr_zone at line 476, avg 126ns/call
sub Date::Manip::TZ::CORE:readline; # opcode
# spent 9.38ms within Date::Manip::TZ::CORE:regcomp which was called 10 times, avg 938µs/call: # once (2.79ms+0s) by Date::Manip::TZ::_zrx at line 1605 # once (1.90ms+0s) by Date::Manip::TZ::_zrx at line 1601 # once (1.48ms+0s) by Date::Manip::TZ::_zrx at line 1555 # once (1.39ms+0s) by Date::Manip::TZ::_zrx at line 1599 # once (474µs+0s) by Date::Manip::TZ::_zrx at line 1600 # once (458µs+0s) by Date::Manip::TZ::_zrx at line 1573 # once (411µs+0s) by Date::Manip::TZ::_zrx at line 1603 # once (388µs+0s) by Date::Manip::TZ::_zrx at line 1604 # once (56µs+0s) by Date::Manip::TZ::_zrx at line 1602 # once (35µs+0s) by Date::Manip::TZ::_zrx at line 1581
sub Date::Manip::TZ::CORE:regcomp; # opcode
# spent 17.4ms within Date::Manip::TZ::CORE:sort which was called 1984 times, avg 9µs/call: # 1680 times (13.3ms+0s) by Date::Manip::TZ::_all_periods at line 1110, avg 8µs/call # 302 times (2.83ms+0s) by Date::Manip::TZ::_check_abbrev_isdst at line 994, avg 9µs/call # once (926µs+0s) by Date::Manip::TZ::_zrx at line 1544 # once (348µs+0s) by Date::Manip::TZ::_zrx at line 1566
sub Date::Manip::TZ::CORE:sort; # opcode
# spent 297µs within Date::Manip::TZ::CORE:subst which was called 5762 times, avg 52ns/call: # 825 times (176µs+0s) by Date::Manip::TZ::_zrx at line 1546, avg 213ns/call # 825 times (49µs+0s) by Date::Manip::TZ::_zrx at line 1547, avg 60ns/call # 825 times (18µs+0s) by Date::Manip::TZ::_zrx at line 1550, avg 22ns/call # 825 times (15µs+0s) by Date::Manip::TZ::_zrx at line 1548, avg 19ns/call # 825 times (13µs+0s) by Date::Manip::TZ::_zrx at line 1549, avg 16ns/call # 825 times (11µs+0s) by Date::Manip::TZ::_zrx at line 1551, avg 13ns/call # 403 times (5µs+0s) by Date::Manip::TZ::_zrx at line 1568, avg 13ns/call # 403 times (5µs+0s) by Date::Manip::TZ::_zrx at line 1569, avg 12ns/call # once (1µs+0s) by Date::Manip::TZ::_get_curr_zone at line 529 # once (900ns+0s) by Date::Manip::TZ::_get_curr_zone at line 528 # once (900ns+0s) by Date::Manip::TZ::_get_curr_zone at line 530 # once (400ns+0s) by Date::Manip::TZ::_get_curr_zone at line 632 # once (300ns+0s) by Date::Manip::TZ::_get_curr_zone at line 531 # once (300ns+0s) by Date::Manip::TZ::_get_curr_zone at line 511
sub Date::Manip::TZ::CORE:subst; # opcode