Filename | /2home/ss5/perl5/perlbrew/perls/perl-5.12.3/lib/site_perl/5.12.3/DateTime/TimeZone.pm |
Statements | Executed 5360 statements in 51.5ms |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
590 | 4 | 2 | 19.2ms | 53.7ms | new | DateTime::TimeZone::
1 | 1 | 1 | 2.63ms | 2.79ms | BEGIN@11 | DateTime::TimeZone::
1176 | 3 | 1 | 2.00ms | 2.00ms | is_floating | DateTime::TimeZone::
590 | 1 | 1 | 908µs | 908µs | CORE:match (opcode) | DateTime::TimeZone::
1 | 1 | 1 | 432µs | 523µs | BEGIN@13 | DateTime::TimeZone::
1 | 1 | 1 | 318µs | 1.55ms | BEGIN@12 | DateTime::TimeZone::
1 | 1 | 1 | 22µs | 22µs | BEGIN@6 | DateTime::TimeZone::
1 | 1 | 1 | 16µs | 83µs | BEGIN@16 | DateTime::TimeZone::
1 | 1 | 1 | 10µs | 33µs | BEGIN@27 | DateTime::TimeZone::
1 | 1 | 1 | 10µs | 15µs | BEGIN@8 | DateTime::TimeZone::
1 | 1 | 1 | 10µs | 68µs | BEGIN@18 | DateTime::TimeZone::
1 | 1 | 1 | 9µs | 28µs | BEGIN@9 | DateTime::TimeZone::
1 | 1 | 1 | 8µs | 8µs | BEGIN@14 | DateTime::TimeZone::
1 | 1 | 1 | 6µs | 32µs | BEGIN@19 | DateTime::TimeZone::
1 | 1 | 1 | 6µs | 31µs | BEGIN@22 | DateTime::TimeZone::
1 | 1 | 1 | 6µs | 30µs | BEGIN@28 | DateTime::TimeZone::
1 | 1 | 1 | 6µs | 36µs | BEGIN@24 | DateTime::TimeZone::
1 | 1 | 1 | 6µs | 30µs | BEGIN@23 | DateTime::TimeZone::
1 | 1 | 1 | 6µs | 30µs | BEGIN@25 | DateTime::TimeZone::
1 | 1 | 1 | 6µs | 6µs | BEGIN@15 | DateTime::TimeZone::
1 | 1 | 1 | 5µs | 30µs | BEGIN@26 | DateTime::TimeZone::
0 | 0 | 0 | 0s | 0s | STORABLE_freeze | DateTime::TimeZone::
0 | 0 | 0 | 0s | 0s | STORABLE_thaw | DateTime::TimeZone::
0 | 0 | 0 | 0s | 0s | _generate_next_span | DateTime::TimeZone::
0 | 0 | 0 | 0s | 0s | _generate_spans_until_match | DateTime::TimeZone::
0 | 0 | 0 | 0s | 0s | _init | DateTime::TimeZone::
0 | 0 | 0 | 0s | 0s | _keys_for_type | DateTime::TimeZone::
0 | 0 | 0 | 0s | 0s | _span_as_array | DateTime::TimeZone::
0 | 0 | 0 | 0s | 0s | _span_for_datetime | DateTime::TimeZone::
0 | 0 | 0 | 0s | 0s | _spans_binary_search | DateTime::TimeZone::
0 | 0 | 0 | 0s | 0s | all_names | DateTime::TimeZone::
0 | 0 | 0 | 0s | 0s | categories | DateTime::TimeZone::
0 | 0 | 0 | 0s | 0s | category | DateTime::TimeZone::
0 | 0 | 0 | 0s | 0s | countries | DateTime::TimeZone::
0 | 0 | 0 | 0s | 0s | has_dst_changes | DateTime::TimeZone::
0 | 0 | 0 | 0s | 0s | is_dst_for_datetime | DateTime::TimeZone::
0 | 0 | 0 | 0s | 0s | is_olson | DateTime::TimeZone::
0 | 0 | 0 | 0s | 0s | is_utc | DateTime::TimeZone::
0 | 0 | 0 | 0s | 0s | is_valid_name | DateTime::TimeZone::
0 | 0 | 0 | 0s | 0s | links | DateTime::TimeZone::
0 | 0 | 0 | 0s | 0s | max_span | DateTime::TimeZone::
0 | 0 | 0 | 0s | 0s | name | DateTime::TimeZone::
0 | 0 | 0 | 0s | 0s | names_in_category | DateTime::TimeZone::
0 | 0 | 0 | 0s | 0s | names_in_country | DateTime::TimeZone::
0 | 0 | 0 | 0s | 0s | offset_as_seconds | DateTime::TimeZone::
0 | 0 | 0 | 0s | 0s | offset_as_string | DateTime::TimeZone::
0 | 0 | 0 | 0s | 0s | offset_for_datetime | DateTime::TimeZone::
0 | 0 | 0 | 0s | 0s | offset_for_local_datetime | DateTime::TimeZone::
0 | 0 | 0 | 0s | 0s | short_name_for_datetime | DateTime::TimeZone::
Line | State ments |
Time on line |
Calls | Time in subs |
Code |
---|---|---|---|---|---|
1 | package DateTime::TimeZone; | ||||
2 | { | ||||
3 | 2 | 1µs | $DateTime::TimeZone::VERSION = '1.46'; | ||
4 | } | ||||
5 | |||||
6 | 3 | 32µs | 1 | 22µs | # spent 22µs within DateTime::TimeZone::BEGIN@6 which was called:
# once (22µs+0s) by DateTime::BEGIN@48 at line 6 # spent 22µs making 1 call to DateTime::TimeZone::BEGIN@6 |
7 | |||||
8 | 3 | 19µs | 2 | 21µs | # spent 15µs (10+5) within DateTime::TimeZone::BEGIN@8 which was called:
# once (10µs+5µs) by DateTime::BEGIN@48 at line 8 # spent 15µs making 1 call to DateTime::TimeZone::BEGIN@8
# spent 6µs making 1 call to strict::import |
9 | 3 | 20µs | 2 | 47µs | # spent 28µs (9+19) within DateTime::TimeZone::BEGIN@9 which was called:
# once (9µs+19µs) by DateTime::BEGIN@48 at line 9 # spent 28µs making 1 call to DateTime::TimeZone::BEGIN@9
# spent 19µs making 1 call to warnings::import |
10 | |||||
11 | 3 | 124µs | 1 | 2.79ms | # spent 2.79ms (2.63+166µs) within DateTime::TimeZone::BEGIN@11 which was called:
# once (2.63ms+166µs) by DateTime::BEGIN@48 at line 11 # spent 2.79ms making 1 call to DateTime::TimeZone::BEGIN@11 |
12 | 3 | 192µs | 1 | 1.55ms | # spent 1.55ms (318µs+1.24) within DateTime::TimeZone::BEGIN@12 which was called:
# once (318µs+1.24ms) by DateTime::BEGIN@48 at line 12 # spent 1.55ms making 1 call to DateTime::TimeZone::BEGIN@12 |
13 | 3 | 90µs | 1 | 523µs | # spent 523µs (432+91) within DateTime::TimeZone::BEGIN@13 which was called:
# once (432µs+91µs) by DateTime::BEGIN@48 at line 13 # spent 523µs making 1 call to DateTime::TimeZone::BEGIN@13 |
14 | 3 | 24µs | 1 | 8µs | # spent 8µs within DateTime::TimeZone::BEGIN@14 which was called:
# once (8µs+0s) by DateTime::BEGIN@48 at line 14 # spent 8µs making 1 call to DateTime::TimeZone::BEGIN@14 |
15 | 3 | 26µs | 1 | 6µs | # spent 6µs within DateTime::TimeZone::BEGIN@15 which was called:
# once (6µs+0s) by DateTime::BEGIN@48 at line 15 # spent 6µs making 1 call to DateTime::TimeZone::BEGIN@15 |
16 | 3 | 75µs | 3 | 150µs | # spent 83µs (16+67) within DateTime::TimeZone::BEGIN@16 which was called:
# once (16µs+67µs) by DateTime::BEGIN@48 at line 16 # spent 83µs making 1 call to DateTime::TimeZone::BEGIN@16
# spent 48µs making 1 call to Exporter::import
# spent 20µs making 1 call to UNIVERSAL::VERSION |
17 | |||||
18 | 3 | 31µs | 2 | 126µs | # spent 68µs (10+58) within DateTime::TimeZone::BEGIN@18 which was called:
# once (10µs+58µs) by DateTime::BEGIN@48 at line 18 # spent 68µs making 1 call to DateTime::TimeZone::BEGIN@18
# spent 58µs making 1 call to constant::import |
19 | 3 | 20µs | 2 | 57µs | # spent 32µs (6+25) within DateTime::TimeZone::BEGIN@19 which was called:
# once (6µs+25µs) by DateTime::BEGIN@48 at line 19 # spent 32µs making 1 call to DateTime::TimeZone::BEGIN@19
# spent 25µs making 1 call to constant::import |
20 | |||||
21 | # the offsets for each span element | ||||
22 | 3 | 20µs | 2 | 56µs | # spent 31µs (6+25) within DateTime::TimeZone::BEGIN@22 which was called:
# once (6µs+25µs) by DateTime::BEGIN@48 at line 22 # spent 31µs making 1 call to DateTime::TimeZone::BEGIN@22
# spent 25µs making 1 call to constant::import |
23 | 3 | 20µs | 2 | 53µs | # spent 30µs (6+24) within DateTime::TimeZone::BEGIN@23 which was called:
# once (6µs+24µs) by DateTime::BEGIN@48 at line 23 # spent 30µs making 1 call to DateTime::TimeZone::BEGIN@23
# spent 24µs making 1 call to constant::import |
24 | 3 | 20µs | 2 | 67µs | # spent 36µs (6+30) within DateTime::TimeZone::BEGIN@24 which was called:
# once (6µs+30µs) by DateTime::BEGIN@48 at line 24 # spent 36µs making 1 call to DateTime::TimeZone::BEGIN@24
# spent 30µs making 1 call to constant::import |
25 | 3 | 20µs | 2 | 54µs | # spent 30µs (6+24) within DateTime::TimeZone::BEGIN@25 which was called:
# once (6µs+24µs) by DateTime::BEGIN@48 at line 25 # spent 30µs making 1 call to DateTime::TimeZone::BEGIN@25
# spent 24µs making 1 call to constant::import |
26 | 3 | 19µs | 2 | 54µs | # spent 30µs (5+24) within DateTime::TimeZone::BEGIN@26 which was called:
# once (5µs+24µs) by DateTime::BEGIN@48 at line 26 # spent 30µs making 1 call to DateTime::TimeZone::BEGIN@26
# spent 24µs making 1 call to constant::import |
27 | 3 | 19µs | 2 | 57µs | # spent 33µs (10+23) within DateTime::TimeZone::BEGIN@27 which was called:
# once (10µs+23µs) by DateTime::BEGIN@48 at line 27 # spent 33µs making 1 call to DateTime::TimeZone::BEGIN@27
# spent 23µs making 1 call to constant::import |
28 | 3 | 2.19ms | 2 | 54µs | # spent 30µs (6+24) within DateTime::TimeZone::BEGIN@28 which was called:
# once (6µs+24µs) by DateTime::BEGIN@48 at line 28 # spent 30µs making 1 call to DateTime::TimeZone::BEGIN@28
# spent 24µs making 1 call to constant::import |
29 | |||||
30 | 1 | 14µs | my %SpecialName = map { $_ => 1 } | ||
31 | qw( EST MST HST CET EET MET WET EST5EDT CST6CDT MST7MDT PST8PDT ); | ||||
32 | |||||
33 | # spent 53.7ms (19.2+34.4) within DateTime::TimeZone::new which was called 590 times, avg 91µs/call:
# 294 times (8.49ms+20.2ms) by DateTime::set_time_zone at line 1961 of DateTime.pm, avg 98µs/call
# 294 times (10.7ms+14.1ms) by DateTime::_new at line 238 of DateTime.pm, avg 84µs/call
# once (37µs+74µs) by Tapper::Schema::TestrunDB::ResultSet::Testrun::BEGIN@12 at line 47 of DateTime/Infinite.pm
# once (13µs+27µs) by Tapper::Schema::TestrunDB::ResultSet::Testrun::BEGIN@12 at line 71 of DateTime/Infinite.pm | ||||
34 | 590 | 625µs | my $class = shift; | ||
35 | 590 | 31.9ms | 590 | 26.8ms | my %p = validate( # spent 26.8ms making 590 calls to Params::Validate::XS::validate, avg 45µs/call # spent 2.33ms executing statements in 590 string evals (merged) |
36 | @_, | ||||
37 | { name => { type => SCALAR } }, | ||||
38 | ); | ||||
39 | |||||
40 | 590 | 1.62ms | if ( exists $DateTime::TimeZone::Catalog::LINKS{ $p{name} } ) { | ||
41 | $p{name} = $DateTime::TimeZone::Catalog::LINKS{ $p{name} }; | ||||
42 | } | ||||
43 | elsif ( exists $DateTime::TimeZone::Catalog::LINKS{ uc $p{name} } ) { | ||||
44 | $p{name} = $DateTime::TimeZone::Catalog::LINKS{ uc $p{name} }; | ||||
45 | } | ||||
46 | |||||
47 | 590 | 3.87ms | 590 | 908µs | unless ( $p{name} =~ m,/, # spent 908µs making 590 calls to DateTime::TimeZone::CORE:match, avg 2µs/call |
48 | || $SpecialName{ $p{name} } ) { | ||||
49 | 590 | 539µs | 2 | 36µs | if ( $p{name} eq 'floating' ) { # spent 36µs making 2 calls to Class::Singleton::instance, avg 18µs/call |
50 | return DateTime::TimeZone::Floating->instance; | ||||
51 | } | ||||
52 | |||||
53 | 588 | 451µs | if ( $p{name} eq 'local' ) { | ||
54 | return DateTime::TimeZone::Local->TimeZone(); | ||||
55 | } | ||||
56 | |||||
57 | 588 | 5.91ms | 588 | 6.68ms | if ( $p{name} eq 'UTC' || $p{name} eq 'Z' ) { # spent 6.68ms making 588 calls to Class::Singleton::instance, avg 11µs/call |
58 | return DateTime::TimeZone::UTC->instance; | ||||
59 | } | ||||
60 | |||||
61 | return DateTime::TimeZone::OffsetOnly->new( offset => $p{name} ); | ||||
62 | } | ||||
63 | |||||
64 | my $subclass = $p{name}; | ||||
65 | $subclass =~ s/-/_/g; | ||||
66 | $subclass =~ s{/}{::}g; | ||||
67 | my $real_class = "DateTime::TimeZone::$subclass"; | ||||
68 | |||||
69 | die "The timezone '$p{name}' in an invalid name.\n" | ||||
70 | unless $real_class =~ /^\w+(::\w+)*$/; | ||||
71 | |||||
72 | unless ( $real_class->can('instance') ) { | ||||
73 | my $e = do { | ||||
74 | local $@; | ||||
75 | local $SIG{__DIE__}; | ||||
76 | eval "require $real_class"; | ||||
77 | $@; | ||||
78 | }; | ||||
79 | |||||
80 | if ($e) { | ||||
81 | my $regex = join '.', split /::/, $real_class; | ||||
82 | $regex .= '\\.pm'; | ||||
83 | |||||
84 | if ( $e =~ /^Can't locate $regex/i ) { | ||||
85 | die | ||||
86 | "The timezone '$p{name}' could not be loaded, or is an invalid name.\n"; | ||||
87 | } | ||||
88 | else { | ||||
89 | die $e; | ||||
90 | } | ||||
91 | } | ||||
92 | } | ||||
93 | |||||
94 | my $zone = $real_class->instance( name => $p{name}, is_olson => 1 ); | ||||
95 | |||||
96 | if ( $zone->is_olson() ) { | ||||
97 | my $object_version | ||||
98 | = $zone->can('olson_version') | ||||
99 | ? $zone->olson_version() | ||||
100 | : 'unknown'; | ||||
101 | my $catalog_version = DateTime::TimeZone::Catalog->OlsonVersion(); | ||||
102 | |||||
103 | if ( $object_version ne $catalog_version ) { | ||||
104 | warn | ||||
105 | "Loaded $real_class, which is from an older version ($object_version) of the Olson database than this installation of DateTime::TimeZone ($catalog_version).\n"; | ||||
106 | } | ||||
107 | } | ||||
108 | |||||
109 | return $zone; | ||||
110 | } | ||||
111 | |||||
112 | sub _init { | ||||
113 | my $class = shift; | ||||
114 | my %p = validate( | ||||
115 | @_, { | ||||
116 | name => { type => SCALAR }, | ||||
117 | spans => { type => ARRAYREF }, | ||||
118 | is_olson => { type => BOOLEAN, default => 0 }, | ||||
119 | }, | ||||
120 | ); | ||||
121 | |||||
122 | my $self = bless { | ||||
123 | name => $p{name}, | ||||
124 | spans => $p{spans}, | ||||
125 | is_olson => $p{is_olson}, | ||||
126 | }, $class; | ||||
127 | |||||
128 | foreach my $k (qw( last_offset last_observance rules max_year )) { | ||||
129 | my $m = "_$k"; | ||||
130 | $self->{$k} = $self->$m() if $self->can($m); | ||||
131 | } | ||||
132 | |||||
133 | return $self; | ||||
134 | } | ||||
135 | |||||
136 | sub is_olson { $_[0]->{is_olson} } | ||||
137 | |||||
138 | sub is_dst_for_datetime { | ||||
139 | my $self = shift; | ||||
140 | |||||
141 | my $span = $self->_span_for_datetime( 'utc', $_[0] ); | ||||
142 | |||||
143 | return $span->[IS_DST]; | ||||
144 | } | ||||
145 | |||||
146 | sub offset_for_datetime { | ||||
147 | my $self = shift; | ||||
148 | |||||
149 | my $span = $self->_span_for_datetime( 'utc', $_[0] ); | ||||
150 | |||||
151 | return $span->[OFFSET]; | ||||
152 | } | ||||
153 | |||||
154 | sub offset_for_local_datetime { | ||||
155 | my $self = shift; | ||||
156 | |||||
157 | my $span = $self->_span_for_datetime( 'local', $_[0] ); | ||||
158 | |||||
159 | return $span->[OFFSET]; | ||||
160 | } | ||||
161 | |||||
162 | sub short_name_for_datetime { | ||||
163 | my $self = shift; | ||||
164 | |||||
165 | my $span = $self->_span_for_datetime( 'utc', $_[0] ); | ||||
166 | |||||
167 | return $span->[SHORT_NAME]; | ||||
168 | } | ||||
169 | |||||
170 | sub _span_for_datetime { | ||||
171 | my $self = shift; | ||||
172 | my $type = shift; | ||||
173 | my $dt = shift; | ||||
174 | |||||
175 | my $method = $type . '_rd_as_seconds'; | ||||
176 | |||||
177 | my $end = $type eq 'utc' ? UTC_END : LOCAL_END; | ||||
178 | |||||
179 | my $span; | ||||
180 | my $seconds = $dt->$method(); | ||||
181 | if ( $seconds < $self->max_span->[$end] ) { | ||||
182 | $span = $self->_spans_binary_search( $type, $seconds ); | ||||
183 | } | ||||
184 | else { | ||||
185 | my $until_year = $dt->utc_year + 1; | ||||
186 | $span = $self->_generate_spans_until_match( $until_year, $seconds, | ||||
187 | $type ); | ||||
188 | } | ||||
189 | |||||
190 | # This means someone gave a local time that doesn't exist | ||||
191 | # (like during a transition into savings time) | ||||
192 | unless ( defined $span ) { | ||||
193 | my $err = 'Invalid local time for date'; | ||||
194 | $err .= ' ' . $dt->iso8601 if $type eq 'utc'; | ||||
195 | $err .= " in time zone: " . $self->name; | ||||
196 | $err .= "\n"; | ||||
197 | |||||
198 | die $err; | ||||
199 | } | ||||
200 | |||||
201 | return $span; | ||||
202 | } | ||||
203 | |||||
204 | sub _spans_binary_search { | ||||
205 | my $self = shift; | ||||
206 | my ( $type, $seconds ) = @_; | ||||
207 | |||||
208 | my ( $start, $end ) = _keys_for_type($type); | ||||
209 | |||||
210 | my $min = 0; | ||||
211 | my $max = scalar @{ $self->{spans} } + 1; | ||||
212 | my $i = int( $max / 2 ); | ||||
213 | |||||
214 | # special case for when there are only 2 spans | ||||
215 | $i++ if $max % 2 && $max != 3; | ||||
216 | |||||
217 | $i = 0 if @{ $self->{spans} } == 1; | ||||
218 | |||||
219 | while (1) { | ||||
220 | my $current = $self->{spans}[$i]; | ||||
221 | |||||
222 | if ( $seconds < $current->[$start] ) { | ||||
223 | $max = $i; | ||||
224 | my $c = int( ( $i - $min ) / 2 ); | ||||
225 | $c ||= 1; | ||||
226 | |||||
227 | $i -= $c; | ||||
228 | |||||
229 | return if $i < $min; | ||||
230 | } | ||||
231 | elsif ( $seconds >= $current->[$end] ) { | ||||
232 | $min = $i; | ||||
233 | my $c = int( ( $max - $i ) / 2 ); | ||||
234 | $c ||= 1; | ||||
235 | |||||
236 | $i += $c; | ||||
237 | |||||
238 | return if $i >= $max; | ||||
239 | } | ||||
240 | else { | ||||
241 | |||||
242 | # Special case for overlapping ranges because of DST and | ||||
243 | # other weirdness (like Alaska's change when bought from | ||||
244 | # Russia by the US). Always prefer latest span. | ||||
245 | if ( $current->[IS_DST] && $type eq 'local' ) { | ||||
246 | |||||
247 | # Asia/Dhaka in 2009j goes into DST without any known | ||||
248 | # end-of-DST date (wtf, Bangladesh). | ||||
249 | return $current if $current->[UTC_END] == INFINITY; | ||||
250 | |||||
251 | my $next = $self->{spans}[ $i + 1 ]; | ||||
252 | |||||
253 | # Sometimes we will get here and the span we're | ||||
254 | # looking at is the last that's been generated so far. | ||||
255 | # We need to try to generate one more or else we run | ||||
256 | # out. | ||||
257 | $next ||= $self->_generate_next_span; | ||||
258 | |||||
259 | die "No next span in $self->{max_year}" unless defined $next; | ||||
260 | |||||
261 | if ( ( !$next->[IS_DST] ) | ||||
262 | && $next->[$start] <= $seconds | ||||
263 | && $seconds <= $next->[$end] ) { | ||||
264 | return $next; | ||||
265 | } | ||||
266 | } | ||||
267 | |||||
268 | return $current; | ||||
269 | } | ||||
270 | } | ||||
271 | } | ||||
272 | |||||
273 | sub _generate_next_span { | ||||
274 | my $self = shift; | ||||
275 | |||||
276 | my $last_idx = $#{ $self->{spans} }; | ||||
277 | |||||
278 | my $max_span = $self->max_span; | ||||
279 | |||||
280 | # Kind of a hack, but AFAIK there are no zones where it takes | ||||
281 | # _more_ than a year for a _future_ time zone change to occur, so | ||||
282 | # by looking two years out we can ensure that we will find at | ||||
283 | # least one more span. Of course, I will no doubt be proved wrong | ||||
284 | # and this will cause errors. | ||||
285 | $self->_generate_spans_until_match( $self->{max_year} + 2, | ||||
286 | $max_span->[UTC_END] + ( 366 * 86400 ), 'utc' ); | ||||
287 | |||||
288 | return $self->{spans}[ $last_idx + 1 ]; | ||||
289 | } | ||||
290 | |||||
291 | sub _generate_spans_until_match { | ||||
292 | my $self = shift; | ||||
293 | my $generate_until_year = shift; | ||||
294 | my $seconds = shift; | ||||
295 | my $type = shift; | ||||
296 | |||||
297 | my @changes; | ||||
298 | my @rules = @{ $self->_rules }; | ||||
299 | foreach my $year ( $self->{max_year} .. $generate_until_year ) { | ||||
300 | for ( my $x = 0; $x < @rules; $x++ ) { | ||||
301 | my $last_offset_from_std; | ||||
302 | |||||
303 | if ( @rules == 2 ) { | ||||
304 | $last_offset_from_std | ||||
305 | = $x | ||||
306 | ? $rules[0]->offset_from_std | ||||
307 | : $rules[1]->offset_from_std; | ||||
308 | } | ||||
309 | elsif ( @rules == 1 ) { | ||||
310 | $last_offset_from_std = $rules[0]->offset_from_std; | ||||
311 | } | ||||
312 | else { | ||||
313 | my $count = scalar @rules; | ||||
314 | die | ||||
315 | "Cannot generate future changes for zone with $count infinite rules\n"; | ||||
316 | } | ||||
317 | |||||
318 | my $rule = $rules[$x]; | ||||
319 | |||||
320 | my $next = $rule->utc_start_datetime_for_year( $year, | ||||
321 | $self->{last_offset}, $last_offset_from_std ); | ||||
322 | |||||
323 | # don't bother with changes we've seen already | ||||
324 | next if $next->utc_rd_as_seconds < $self->max_span->[UTC_END]; | ||||
325 | |||||
326 | push @changes, | ||||
327 | DateTime::TimeZone::OlsonDB::Change->new( | ||||
328 | type => 'rule', | ||||
329 | utc_start_datetime => $next, | ||||
330 | local_start_datetime => $next + DateTime::Duration->new( | ||||
331 | seconds => $self->{last_observance}->total_offset | ||||
332 | + $rule->offset_from_std | ||||
333 | ), | ||||
334 | short_name => sprintf( | ||||
335 | $self->{last_observance}->format, $rule->letter | ||||
336 | ), | ||||
337 | observance => $self->{last_observance}, | ||||
338 | rule => $rule, | ||||
339 | ); | ||||
340 | } | ||||
341 | } | ||||
342 | |||||
343 | $self->{max_year} = $generate_until_year; | ||||
344 | |||||
345 | my @sorted | ||||
346 | = sort { $a->utc_start_datetime <=> $b->utc_start_datetime } @changes; | ||||
347 | |||||
348 | my ( $start, $end ) = _keys_for_type($type); | ||||
349 | |||||
350 | my $match; | ||||
351 | for ( my $x = 1; $x < @sorted; $x++ ) { | ||||
352 | my $last_total_offset | ||||
353 | = $x == 1 | ||||
354 | ? $self->max_span->[OFFSET] | ||||
355 | : $sorted[ $x - 2 ]->total_offset; | ||||
356 | |||||
357 | my $span = DateTime::TimeZone::OlsonDB::Change::two_changes_as_span( | ||||
358 | @sorted[ $x - 1, $x ], $last_total_offset ); | ||||
359 | |||||
360 | $span = _span_as_array($span); | ||||
361 | |||||
362 | push @{ $self->{spans} }, $span; | ||||
363 | |||||
364 | $match = $span | ||||
365 | if $seconds >= $span->[$start] && $seconds < $span->[$end]; | ||||
366 | } | ||||
367 | |||||
368 | return $match; | ||||
369 | } | ||||
370 | |||||
371 | sub max_span { $_[0]->{spans}[-1] } | ||||
372 | |||||
373 | sub _keys_for_type { | ||||
374 | $_[0] eq 'utc' ? ( UTC_START, UTC_END ) : ( LOCAL_START, LOCAL_END ); | ||||
375 | } | ||||
376 | |||||
377 | sub _span_as_array { | ||||
378 | [ | ||||
379 | @{ $_[0] }{ | ||||
380 | qw( utc_start utc_end local_start local_end offset is_dst short_name ) | ||||
381 | } | ||||
382 | ]; | ||||
383 | } | ||||
384 | |||||
385 | 1176 | 3.65ms | # spent 2.00ms within DateTime::TimeZone::is_floating which was called 1176 times, avg 2µs/call:
# 588 times (1.07ms+0s) by DateTime::_handle_offset_modifier at line 309 of DateTime.pm, avg 2µs/call
# 294 times (588µs+0s) by DateTime::set_time_zone at line 1959 of DateTime.pm, avg 2µs/call
# 294 times (343µs+0s) by DateTime::set_time_zone at line 1966 of DateTime.pm, avg 1µs/call | ||
386 | |||||
387 | sub is_utc {0} | ||||
388 | |||||
389 | sub has_dst_changes {0} | ||||
390 | |||||
391 | sub name { $_[0]->{name} } | ||||
392 | sub category { ( split /\//, $_[0]->{name}, 2 )[0] } | ||||
393 | |||||
394 | sub is_valid_name { | ||||
395 | my $tz; | ||||
396 | { | ||||
397 | local $@; | ||||
398 | local $SIG{__DIE__}; | ||||
399 | $tz = eval { $_[0]->new( name => $_[1] ) }; | ||||
400 | } | ||||
401 | |||||
402 | return $tz && $tz->isa('DateTime::TimeZone') ? 1 : 0; | ||||
403 | } | ||||
404 | |||||
405 | sub STORABLE_freeze { | ||||
406 | my $self = shift; | ||||
407 | |||||
408 | return $self->name; | ||||
409 | } | ||||
410 | |||||
411 | sub STORABLE_thaw { | ||||
412 | my $self = shift; | ||||
413 | my $cloning = shift; | ||||
414 | my $serialized = shift; | ||||
415 | |||||
416 | my $class = ref $self || $self; | ||||
417 | |||||
418 | my $obj; | ||||
419 | if ( $class->isa(__PACKAGE__) ) { | ||||
420 | $obj = __PACKAGE__->new( name => $serialized ); | ||||
421 | } | ||||
422 | else { | ||||
423 | $obj = $class->new( name => $serialized ); | ||||
424 | } | ||||
425 | |||||
426 | %$self = %$obj; | ||||
427 | |||||
428 | return $self; | ||||
429 | } | ||||
430 | |||||
431 | # | ||||
432 | # Functions | ||||
433 | # | ||||
434 | sub offset_as_seconds { | ||||
435 | { | ||||
436 | local $@; | ||||
437 | local $SIG{__DIE__}; | ||||
438 | shift if eval { $_[0]->isa('DateTime::TimeZone') }; | ||||
439 | } | ||||
440 | |||||
441 | my $offset = shift; | ||||
442 | |||||
443 | return undef unless defined $offset; | ||||
444 | |||||
445 | return 0 if $offset eq '0'; | ||||
446 | |||||
447 | my ( $sign, $hours, $minutes, $seconds ); | ||||
448 | if ( $offset =~ /^([\+\-])?(\d\d?):(\d\d)(?::(\d\d))?$/ ) { | ||||
449 | ( $sign, $hours, $minutes, $seconds ) = ( $1, $2, $3, $4 ); | ||||
450 | } | ||||
451 | elsif ( $offset =~ /^([\+\-])?(\d\d)(\d\d)(\d\d)?$/ ) { | ||||
452 | ( $sign, $hours, $minutes, $seconds ) = ( $1, $2, $3, $4 ); | ||||
453 | } | ||||
454 | else { | ||||
455 | return undef; | ||||
456 | } | ||||
457 | |||||
458 | $sign = '+' unless defined $sign; | ||||
459 | return undef unless $hours >= 0 && $hours <= 99; | ||||
460 | return undef unless $minutes >= 0 && $minutes <= 59; | ||||
461 | return undef | ||||
462 | unless !defined($seconds) || ( $seconds >= 0 && $seconds <= 59 ); | ||||
463 | |||||
464 | my $total = $hours * 3600 + $minutes * 60; | ||||
465 | $total += $seconds if $seconds; | ||||
466 | $total *= -1 if $sign eq '-'; | ||||
467 | |||||
468 | return $total; | ||||
469 | } | ||||
470 | |||||
471 | sub offset_as_string { | ||||
472 | { | ||||
473 | local $@; | ||||
474 | local $SIG{__DIE__}; | ||||
475 | shift if eval { $_[0]->isa('DateTime::TimeZone') }; | ||||
476 | } | ||||
477 | |||||
478 | my $offset = shift; | ||||
479 | |||||
480 | return undef unless defined $offset; | ||||
481 | return undef unless $offset >= -359999 && $offset <= 359999; | ||||
482 | |||||
483 | my $sign = $offset < 0 ? '-' : '+'; | ||||
484 | |||||
485 | $offset = abs($offset); | ||||
486 | |||||
487 | my $hours = int( $offset / 3600 ); | ||||
488 | $offset %= 3600; | ||||
489 | my $mins = int( $offset / 60 ); | ||||
490 | $offset %= 60; | ||||
491 | my $secs = int($offset); | ||||
492 | |||||
493 | return ( | ||||
494 | $secs | ||||
495 | ? sprintf( '%s%02d%02d%02d', $sign, $hours, $mins, $secs ) | ||||
496 | : sprintf( '%s%02d%02d', $sign, $hours, $mins ) | ||||
497 | ); | ||||
498 | } | ||||
499 | |||||
500 | # These methods all operate on data contained in the DateTime/TimeZone/Catalog.pm file. | ||||
501 | |||||
502 | sub all_names { | ||||
503 | return | ||||
504 | wantarray | ||||
505 | ? @DateTime::TimeZone::Catalog::ALL | ||||
506 | : [@DateTime::TimeZone::Catalog::ALL]; | ||||
507 | } | ||||
508 | |||||
509 | sub categories { | ||||
510 | return wantarray | ||||
511 | ? @DateTime::TimeZone::Catalog::CATEGORY_NAMES | ||||
512 | : [@DateTime::TimeZone::Catalog::CATEGORY_NAMES]; | ||||
513 | } | ||||
514 | |||||
515 | sub links { | ||||
516 | return | ||||
517 | wantarray | ||||
518 | ? %DateTime::TimeZone::Catalog::LINKS | ||||
519 | : {%DateTime::TimeZone::Catalog::LINKS}; | ||||
520 | } | ||||
521 | |||||
522 | sub names_in_category { | ||||
523 | shift if $_[0]->isa('DateTime::TimeZone'); | ||||
524 | return unless exists $DateTime::TimeZone::Catalog::CATEGORIES{ $_[0] }; | ||||
525 | |||||
526 | return wantarray | ||||
527 | ? @{ $DateTime::TimeZone::Catalog::CATEGORIES{ $_[0] } } | ||||
528 | : [ $DateTime::TimeZone::Catalog::CATEGORIES{ $_[0] } ]; | ||||
529 | } | ||||
530 | |||||
531 | sub countries { | ||||
532 | wantarray | ||||
533 | ? ( sort keys %DateTime::TimeZone::Catalog::ZONES_BY_COUNTRY ) | ||||
534 | : [ sort keys %DateTime::TimeZone::Catalog::ZONES_BY_COUNTRY ]; | ||||
535 | } | ||||
536 | |||||
537 | sub names_in_country { | ||||
538 | shift if $_[0]->isa('DateTime::TimeZone'); | ||||
539 | |||||
540 | return | ||||
541 | unless | ||||
542 | exists $DateTime::TimeZone::Catalog::ZONES_BY_COUNTRY{ lc $_[0] }; | ||||
543 | |||||
544 | return | ||||
545 | wantarray | ||||
546 | ? @{ $DateTime::TimeZone::Catalog::ZONES_BY_COUNTRY{ lc $_[0] } } | ||||
547 | : $DateTime::TimeZone::Catalog::ZONES_BY_COUNTRY{ lc $_[0] }; | ||||
548 | } | ||||
549 | |||||
550 | 1 | 6µs | 1; | ||
551 | |||||
552 | # ABSTRACT: Time zone object base class and factory | ||||
553 | |||||
- - | |||||
556 | =pod | ||||
557 | |||||
558 | =head1 NAME | ||||
559 | |||||
560 | DateTime::TimeZone - Time zone object base class and factory | ||||
561 | |||||
562 | =head1 VERSION | ||||
563 | |||||
564 | version 1.46 | ||||
565 | |||||
566 | =head1 SYNOPSIS | ||||
567 | |||||
568 | use DateTime; | ||||
569 | use DateTime::TimeZone; | ||||
570 | |||||
571 | my $tz = DateTime::TimeZone->new( name => 'America/Chicago' ); | ||||
572 | |||||
573 | my $dt = DateTime->now(); | ||||
574 | my $offset = $tz->offset_for_datetime($dt); | ||||
575 | |||||
576 | =head1 DESCRIPTION | ||||
577 | |||||
578 | This class is the base class for all time zone objects. A time zone | ||||
579 | is represented internally as a set of observances, each of which | ||||
580 | describes the offset from GMT for a given time period. | ||||
581 | |||||
582 | Note that without the C<DateTime.pm> module, this module does not do | ||||
583 | much. It's primary interface is through a C<DateTime> object, and | ||||
584 | most users will not need to directly use C<DateTime::TimeZone> | ||||
585 | methods. | ||||
586 | |||||
587 | =head1 USAGE | ||||
588 | |||||
589 | This class has the following methods: | ||||
590 | |||||
591 | =head2 DateTime::TimeZone->new( name => $tz_name ) | ||||
592 | |||||
593 | Given a valid time zone name, this method returns a new time zone | ||||
594 | blessed into the appropriate subclass. Subclasses are named for the | ||||
595 | given time zone, so that the time zone "America/Chicago" is the | ||||
596 | DateTime::TimeZone::America::Chicago class. | ||||
597 | |||||
598 | If the name given is a "link" name in the Olson database, the object | ||||
599 | created may have a different name. For example, there is a link from | ||||
600 | the old "EST5EDT" name to "America/New_York". | ||||
601 | |||||
602 | When loading a time zone from the Olson database, the constructor | ||||
603 | checks the version of the loaded class to make sure it matches the | ||||
604 | version of the current DateTime::TimeZone installation. If they do not | ||||
605 | match it will issue a warning. This is useful because time zone names | ||||
606 | may fall out of use, but you may have an old module file installed for | ||||
607 | that time zone. | ||||
608 | |||||
609 | There are also several special values that can be given as names. | ||||
610 | |||||
611 | If the "name" parameter is "floating", then a | ||||
612 | C<DateTime::TimeZone::Floating> object is returned. A floating time | ||||
613 | zone does have I<any> offset, and is always the same time. This is | ||||
614 | useful for calendaring applications, which may need to specify that a | ||||
615 | given event happens at the same I<local> time, regardless of where it | ||||
616 | occurs. See RFC 2445 for more details. | ||||
617 | |||||
618 | If the "name" parameter is "UTC", then a C<DateTime::TimeZone::UTC> | ||||
619 | object is returned. | ||||
620 | |||||
621 | If the "name" is an offset string, it is converted to a number, and a | ||||
622 | C<DateTime::TimeZone::OffsetOnly> object is returned. | ||||
623 | |||||
624 | =head3 The "local" time zone | ||||
625 | |||||
626 | If the "name" parameter is "local", then the module attempts to | ||||
627 | determine the local time zone for the system. | ||||
628 | |||||
629 | The method for finding the local zone varies by operating system. See | ||||
630 | the appropriate module for details of how we check for the local time | ||||
631 | zone. | ||||
632 | |||||
633 | =over 4 | ||||
634 | |||||
635 | =item * L<DateTime::TimeZone::Local::Unix> | ||||
636 | |||||
637 | =item * L<DateTime::TimeZone::Local::Win32> | ||||
638 | |||||
639 | =item * L<DateTime::TimeZone::Local::VMS> | ||||
640 | |||||
641 | =back | ||||
642 | |||||
643 | If a local time zone is not found, then an exception will be thrown. | ||||
644 | |||||
645 | =head2 $tz->offset_for_datetime( $dt ) | ||||
646 | |||||
647 | Given a C<DateTime> object, this method returns the offset in seconds | ||||
648 | for the given datetime. This takes into account historical time zone | ||||
649 | information, as well as Daylight Saving Time. The offset is | ||||
650 | determined by looking at the object's UTC Rata Die days and seconds. | ||||
651 | |||||
652 | =head2 $tz->offset_for_local_datetime( $dt ) | ||||
653 | |||||
654 | Given a C<DateTime> object, this method returns the offset in seconds | ||||
655 | for the given datetime. Unlike the previous method, this method uses | ||||
656 | the local time's Rata Die days and seconds. This should only be done | ||||
657 | when the corresponding UTC time is not yet known, because local times | ||||
658 | can be ambiguous due to Daylight Saving Time rules. | ||||
659 | |||||
660 | =head2 $tz->is_dst_for_datetime( $dt ) | ||||
661 | |||||
662 | Given a C<DateTime> object, this method returns true if the DateTime is | ||||
663 | currently in Daylight Saving Time. | ||||
664 | |||||
665 | =head2 $tz->name | ||||
666 | |||||
667 | Returns the name of the time zone. | ||||
668 | |||||
669 | =head2 $tz->short_name_for_datetime( $dt ) | ||||
670 | |||||
671 | Given a C<DateTime> object, this method returns the "short name" for | ||||
672 | the current observance and rule this datetime is in. These are names | ||||
673 | like "EST", "GMT", etc. | ||||
674 | |||||
675 | It is B<strongly> recommended that you do not rely on these names for | ||||
676 | anything other than display. These names are not official, and many | ||||
677 | of them are simply the invention of the Olson database maintainers. | ||||
678 | Moreover, these names are not unique. For example, there is an "EST" | ||||
679 | at both -0500 and +1000/+1100. | ||||
680 | |||||
681 | =head2 $tz->is_floating | ||||
682 | |||||
683 | Returns a boolean indicating whether or not this object represents a | ||||
684 | floating time zone, as defined by RFC 2445. | ||||
685 | |||||
686 | =head2 $tz->is_utc | ||||
687 | |||||
688 | Indicates whether or not this object represents the UTC (GMT) time | ||||
689 | zone. | ||||
690 | |||||
691 | =head2 $tz->has_dst_changes | ||||
692 | |||||
693 | Indicates whether or not this zone has I<ever> had a change to and | ||||
694 | from DST, either in the past or future. | ||||
695 | |||||
696 | =head2 $tz->is_olson | ||||
697 | |||||
698 | Returns true if the time zone is a named time zone from the Olson | ||||
699 | database. | ||||
700 | |||||
701 | =head2 $tz->category | ||||
702 | |||||
703 | Returns the part of the time zone name before the first slash. For | ||||
704 | example, the "America/Chicago" time zone would return "America". | ||||
705 | |||||
706 | =head2 DateTime::TimeZone->is_valid_name($name) | ||||
707 | |||||
708 | Given a string, this method returns a boolean value indicating whether | ||||
709 | or not the string is a valid time zone name. If you are using | ||||
710 | C<DateTime::TimeZone::Alias>, any aliases you've created will be valid. | ||||
711 | |||||
712 | =head2 DateTime::TimeZone->all_names | ||||
713 | |||||
714 | This returns a pre-sorted list of all the time zone names. This list | ||||
715 | does not include link names. In scalar context, it returns an array | ||||
716 | reference, while in list context it returns an array. | ||||
717 | |||||
718 | =head2 DateTime::TimeZone->categories | ||||
719 | |||||
720 | This returns a list of all time zone categories. In scalar context, | ||||
721 | it returns an array reference, while in list context it returns an | ||||
722 | array. | ||||
723 | |||||
724 | =head2 DateTime::TimeZone->links | ||||
725 | |||||
726 | This returns a hash of all time zone links, where the keys are the | ||||
727 | old, deprecated names, and the values are the new names. In scalar | ||||
728 | context, it returns a hash reference, while in list context it returns | ||||
729 | a hash. | ||||
730 | |||||
731 | =head2 DateTime::TimeZone->names_in_category( $category ) | ||||
732 | |||||
733 | Given a valid category, this method returns a list of the names in | ||||
734 | that category, without the category portion. So the list for the | ||||
735 | "America" category would include the strings "Chicago", | ||||
736 | "Kentucky/Monticello", and "New_York". In scalar context, it returns | ||||
737 | an array reference, while in list context it returns an array. | ||||
738 | |||||
739 | The list is returned in order of population by zone, which should mean | ||||
740 | that this order will be the best to use for most UIs. | ||||
741 | |||||
742 | =head2 DateTime::TimeZone->countries() | ||||
743 | |||||
744 | Returns a sorted list of all the valid country codes (in lower-case) | ||||
745 | which can be passed to C<names_in_country()>. In scalar context, it | ||||
746 | returns an array reference, while in list context it returns an array. | ||||
747 | |||||
748 | If you need to convert country codes to names or vice versa you can | ||||
749 | use C<Locale::Country> to do so. | ||||
750 | |||||
751 | =head2 DateTime::TimeZone->names_in_country( $country_code ) | ||||
752 | |||||
753 | Given a two-letter ISO3166 country code, this method returns a list of | ||||
754 | time zones used in that country. The country code may be of any | ||||
755 | case. In scalar context, it returns an array reference, while in list | ||||
756 | context it returns an array. | ||||
757 | |||||
758 | =head2 DateTime::TimeZone->offset_as_seconds( $offset ) | ||||
759 | |||||
760 | Given an offset as a string, this returns the number of seconds | ||||
761 | represented by the offset as a positive or negative number. Returns | ||||
762 | C<undef> if $offset is not in the range C<-99:59:59> to C<+99:59:59>. | ||||
763 | |||||
764 | The offset is expected to match either | ||||
765 | C</^([\+\-])?(\d\d?):(\d\d)(?::(\d\d))?$/> or | ||||
766 | C</^([\+\-])?(\d\d)(\d\d)(\d\d)?$/>. If it doesn't match either of | ||||
767 | these, C<undef> will be returned. | ||||
768 | |||||
769 | This means that if you want to specify hours as a single digit, then | ||||
770 | each element of the offset must be separated by a colon (:). | ||||
771 | |||||
772 | =head2 DateTime::TimeZone->offset_as_string( $offset ) | ||||
773 | |||||
774 | Given an offset as a number, this returns the offset as a string. | ||||
775 | Returns C<undef> if $offset is not in the range C<-359999> to C<359999>. | ||||
776 | |||||
777 | =head2 Storable Hooks | ||||
778 | |||||
779 | This module provides freeze and thaw hooks for C<Storable> so that the | ||||
780 | huge data structures for Olson time zones are not actually stored in | ||||
781 | the serialized structure. | ||||
782 | |||||
783 | If you subclass C<DateTime::TimeZone>, you will inherit its hooks, | ||||
784 | which may not work for your module, so please test the interaction of | ||||
785 | your module with Storable. | ||||
786 | |||||
787 | =head1 SUPPORT | ||||
788 | |||||
789 | Support for this module is provided via the datetime@perl.org email list. See | ||||
790 | http://datetime.perl.org/wiki/datetime/page/Mailing_List for details. | ||||
791 | |||||
792 | Please submit bugs to the CPAN RT system at | ||||
793 | http://rt.cpan.org/NoAuth/ReportBug.html?Queue=datetime%3A%3Atimezone | ||||
794 | or via email at bug-datetime-timezone@rt.cpan.org. | ||||
795 | |||||
796 | =head1 DONATIONS | ||||
797 | |||||
798 | If you'd like to thank me for the work I've done on this module, | ||||
799 | please consider making a "donation" to me via PayPal. I spend a lot of | ||||
800 | free time creating free software, and would appreciate any support | ||||
801 | you'd care to offer. | ||||
802 | |||||
803 | Please note that B<I am not suggesting that you must do this> in order | ||||
804 | for me to continue working on this particular software. I will | ||||
805 | continue to do so, inasmuch as I have in the past, for as long as it | ||||
806 | interests me. | ||||
807 | |||||
808 | Similarly, a donation made in this way will probably not make me work | ||||
809 | on this software much more, unless I get so many donations that I can | ||||
810 | consider working on free software full time, which seems unlikely at | ||||
811 | best. | ||||
812 | |||||
813 | To donate, log into PayPal and send money to autarch@urth.org or use | ||||
814 | the button on this page: | ||||
815 | L<http://www.urth.org/~autarch/fs-donation.html> | ||||
816 | |||||
817 | =head1 CREDITS | ||||
818 | |||||
819 | This module was inspired by Jesse Vincent's work on | ||||
820 | Date::ICal::Timezone, and written with much help from the | ||||
821 | datetime@perl.org list. | ||||
822 | |||||
823 | =head1 SEE ALSO | ||||
824 | |||||
825 | datetime@perl.org mailing list | ||||
826 | |||||
827 | http://datetime.perl.org/ | ||||
828 | |||||
829 | The tools directory of the DateTime::TimeZone distribution includes | ||||
830 | two scripts that may be of interest to some people. They are | ||||
831 | parse_olson and tests_from_zdump. Please run them with the --help | ||||
832 | flag to see what they can be used for. | ||||
833 | |||||
834 | =head1 AUTHOR | ||||
835 | |||||
836 | Dave Rolsky <autarch@urth.org> | ||||
837 | |||||
838 | =head1 COPYRIGHT AND LICENSE | ||||
839 | |||||
840 | This software is copyright (c) 2012 by Dave Rolsky. | ||||
841 | |||||
842 | This is free software; you can redistribute it and/or modify it under | ||||
843 | the same terms as the Perl 5 programming language system itself. | ||||
844 | |||||
845 | =cut | ||||
846 | |||||
847 | |||||
848 | __END__ | ||||
# spent 908µs within DateTime::TimeZone::CORE:match which was called 590 times, avg 2µs/call:
# 590 times (908µs+0s) by DateTime::TimeZone::new at line 47, avg 2µs/call |