← Index
NYTProf Performance Profile   « block view • line view • sub view »
For /usr/share/koha/opac/cgi-bin/opac/opac-search.pl
  Run on Tue Oct 15 11:58:52 2013
Reported on Tue Oct 15 12:01:02 2013

Filename/usr/share/perl5/DateTime/TimeZone.pm
StatementsExecuted 67 statements in 4.50ms
Subroutines
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
1116.02ms6.25msDateTime::TimeZone::::BEGIN@10DateTime::TimeZone::BEGIN@10
1111.67ms1.88msDateTime::TimeZone::::BEGIN@12DateTime::TimeZone::BEGIN@12
111690µs5.79msDateTime::TimeZone::::BEGIN@11DateTime::TimeZone::BEGIN@11
11186µs86µsDateTime::TimeZone::::BEGIN@3DateTime::TimeZone::BEGIN@3
22181µs239µsDateTime::TimeZone::::newDateTime::TimeZone::new
11121µs54µsDateTime::TimeZone::::BEGIN@6DateTime::TimeZone::BEGIN@6
11120µs20µsDateTime::TimeZone::::BEGIN@13DateTime::TimeZone::BEGIN@13
11118µs27µsDateTime::TimeZone::::BEGIN@5DateTime::TimeZone::BEGIN@5
11114µs140µsDateTime::TimeZone::::BEGIN@15DateTime::TimeZone::BEGIN@15
11112µs50µsDateTime::TimeZone::::BEGIN@26DateTime::TimeZone::BEGIN@26
11112µs78µsDateTime::TimeZone::::BEGIN@17DateTime::TimeZone::BEGIN@17
11112µs12µsDateTime::TimeZone::::BEGIN@14DateTime::TimeZone::BEGIN@14
11110µs50µsDateTime::TimeZone::::BEGIN@27DateTime::TimeZone::BEGIN@27
1119µs41µsDateTime::TimeZone::::BEGIN@25DateTime::TimeZone::BEGIN@25
1119µs40µsDateTime::TimeZone::::BEGIN@22DateTime::TimeZone::BEGIN@22
1118µs41µsDateTime::TimeZone::::BEGIN@18DateTime::TimeZone::BEGIN@18
1118µs39µsDateTime::TimeZone::::BEGIN@24DateTime::TimeZone::BEGIN@24
1118µs40µsDateTime::TimeZone::::BEGIN@21DateTime::TimeZone::BEGIN@21
1118µs39µsDateTime::TimeZone::::BEGIN@23DateTime::TimeZone::BEGIN@23
2116µs6µsDateTime::TimeZone::::CORE:matchDateTime::TimeZone::CORE:match (opcode)
0000s0sDateTime::TimeZone::::STORABLE_freezeDateTime::TimeZone::STORABLE_freeze
0000s0sDateTime::TimeZone::::STORABLE_thawDateTime::TimeZone::STORABLE_thaw
0000s0sDateTime::TimeZone::::_generate_next_spanDateTime::TimeZone::_generate_next_span
0000s0sDateTime::TimeZone::::_generate_spans_until_matchDateTime::TimeZone::_generate_spans_until_match
0000s0sDateTime::TimeZone::::_initDateTime::TimeZone::_init
0000s0sDateTime::TimeZone::::_keys_for_typeDateTime::TimeZone::_keys_for_type
0000s0sDateTime::TimeZone::::_span_as_arrayDateTime::TimeZone::_span_as_array
0000s0sDateTime::TimeZone::::_span_for_datetimeDateTime::TimeZone::_span_for_datetime
0000s0sDateTime::TimeZone::::_spans_binary_searchDateTime::TimeZone::_spans_binary_search
0000s0sDateTime::TimeZone::::all_namesDateTime::TimeZone::all_names
0000s0sDateTime::TimeZone::::categoriesDateTime::TimeZone::categories
0000s0sDateTime::TimeZone::::categoryDateTime::TimeZone::category
0000s0sDateTime::TimeZone::::countriesDateTime::TimeZone::countries
0000s0sDateTime::TimeZone::::has_dst_changesDateTime::TimeZone::has_dst_changes
0000s0sDateTime::TimeZone::::is_dst_for_datetimeDateTime::TimeZone::is_dst_for_datetime
0000s0sDateTime::TimeZone::::is_floatingDateTime::TimeZone::is_floating
0000s0sDateTime::TimeZone::::is_olsonDateTime::TimeZone::is_olson
0000s0sDateTime::TimeZone::::is_utcDateTime::TimeZone::is_utc
0000s0sDateTime::TimeZone::::is_valid_nameDateTime::TimeZone::is_valid_name
0000s0sDateTime::TimeZone::::linksDateTime::TimeZone::links
0000s0sDateTime::TimeZone::::max_spanDateTime::TimeZone::max_span
0000s0sDateTime::TimeZone::::nameDateTime::TimeZone::name
0000s0sDateTime::TimeZone::::names_in_categoryDateTime::TimeZone::names_in_category
0000s0sDateTime::TimeZone::::names_in_countryDateTime::TimeZone::names_in_country
0000s0sDateTime::TimeZone::::offset_as_secondsDateTime::TimeZone::offset_as_seconds
0000s0sDateTime::TimeZone::::offset_as_stringDateTime::TimeZone::offset_as_string
0000s0sDateTime::TimeZone::::offset_for_datetimeDateTime::TimeZone::offset_for_datetime
0000s0sDateTime::TimeZone::::offset_for_local_datetimeDateTime::TimeZone::offset_for_local_datetime
0000s0sDateTime::TimeZone::::short_name_for_datetimeDateTime::TimeZone::short_name_for_datetime
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments		 Time
on line		 Calls Time
in subs		 Code
1package DateTime::TimeZone;
2
33113µs186µs
# spent 86µs within DateTime::TimeZone::BEGIN@3 which was called: # once (86µs+0s) by C4::Context::BEGIN@107 at line 3
use 5.006;
# spent 86µs making 1 call to DateTime::TimeZone::BEGIN@3
4
5344µs236µs
# spent 27µs (18+9) within DateTime::TimeZone::BEGIN@5 which was called: # once (18µs+9µs) by C4::Context::BEGIN@107 at line 5
use strict;
# spent 27µs making 1 call to DateTime::TimeZone::BEGIN@5 # spent 9µs making 1 call to strict::import
6384µs287µs
# spent 54µs (21+33) within DateTime::TimeZone::BEGIN@6 which was called: # once (21µs+33µs) by C4::Context::BEGIN@107 at line 6
use warnings;
# spent 54µs making 1 call to DateTime::TimeZone::BEGIN@6 # spent 33µs making 1 call to warnings::import
7
811µsour $VERSION = '1.20';
9
103289µs16.25ms
# spent 6.25ms (6.02+230µs) within DateTime::TimeZone::BEGIN@10 which was called: # once (6.02ms+230µs) by C4::Context::BEGIN@107 at line 10
use DateTime::TimeZone::Catalog;
# spent 6.25ms making 1 call to DateTime::TimeZone::BEGIN@10
113352µs15.79ms
# spent 5.79ms (690µs+5.10) within DateTime::TimeZone::BEGIN@11 which was called: # once (690µs+5.10ms) by C4::Context::BEGIN@107 at line 11
use DateTime::TimeZone::Floating;
# spent 5.79ms making 1 call to DateTime::TimeZone::BEGIN@11
123299µs11.88ms
# spent 1.88ms (1.67+204µs) within DateTime::TimeZone::BEGIN@12 which was called: # once (1.67ms+204µs) by C4::Context::BEGIN@107 at line 12
use DateTime::TimeZone::Local;
# spent 1.88ms making 1 call to DateTime::TimeZone::BEGIN@12
13356µs120µs
# spent 20µs within DateTime::TimeZone::BEGIN@13 which was called: # once (20µs+0s) by C4::Context::BEGIN@107 at line 13
use DateTime::TimeZone::OffsetOnly;
# spent 20µs making 1 call to DateTime::TimeZone::BEGIN@13
14359µs112µs
# spent 12µs within DateTime::TimeZone::BEGIN@14 which was called: # once (12µs+0s) by C4::Context::BEGIN@107 at line 14
use DateTime::TimeZone::UTC;
# spent 12µs making 1 call to DateTime::TimeZone::BEGIN@14
15379µs2265µs
# spent 140µs (14+126) within DateTime::TimeZone::BEGIN@15 which was called: # once (14µs+126µs) by C4::Context::BEGIN@107 at line 15
use Params::Validate qw( validate validate_pos SCALAR ARRAYREF BOOLEAN );
# spent 140µs making 1 call to DateTime::TimeZone::BEGIN@15 # spent 126µs making 1 call to Exporter::import
16
17346µs2143µs
# spent 78µs (12+66) within DateTime::TimeZone::BEGIN@17 which was called: # once (12µs+66µs) by C4::Context::BEGIN@107 at line 17
use constant INFINITY => 100**1000;
# spent 78µs making 1 call to DateTime::TimeZone::BEGIN@17 # spent 66µs making 1 call to constant::import
18334µs274µs
# spent 41µs (8+33) within DateTime::TimeZone::BEGIN@18 which was called: # once (8µs+33µs) by C4::Context::BEGIN@107 at line 18
use constant NEG_INFINITY => -1 * ( 100**1000 );
# spent 41µs making 1 call to DateTime::TimeZone::BEGIN@18 # spent 33µs making 1 call to constant::import
19
20# the offsets for each span element
21332µs272µs
# spent 40µs (8+32) within DateTime::TimeZone::BEGIN@21 which was called: # once (8µs+32µs) by C4::Context::BEGIN@107 at line 21
use constant UTC_START => 0;
# spent 40µs making 1 call to DateTime::TimeZone::BEGIN@21 # spent 32µs making 1 call to constant::import
22331µs272µs
# spent 40µs (9+32) within DateTime::TimeZone::BEGIN@22 which was called: # once (9µs+32µs) by C4::Context::BEGIN@107 at line 22
use constant UTC_END => 1;
# spent 40µs making 1 call to DateTime::TimeZone::BEGIN@22 # spent 32µs making 1 call to constant::import
23331µs270µs
# spent 39µs (8+31) within DateTime::TimeZone::BEGIN@23 which was called: # once (8µs+31µs) by C4::Context::BEGIN@107 at line 23
use constant LOCAL_START => 2;
# spent 39µs making 1 call to DateTime::TimeZone::BEGIN@23 # spent 31µs making 1 call to constant::import
24331µs269µs
# spent 39µs (8+31) within DateTime::TimeZone::BEGIN@24 which was called: # once (8µs+31µs) by C4::Context::BEGIN@107 at line 24
use constant LOCAL_END => 3;
# spent 39µs making 1 call to DateTime::TimeZone::BEGIN@24 # spent 30µs making 1 call to constant::import
25331µs274µs
# spent 41µs (9+32) within DateTime::TimeZone::BEGIN@25 which was called: # once (9µs+32µs) by C4::Context::BEGIN@107 at line 25
use constant OFFSET => 4;
# spent 41µs making 1 call to DateTime::TimeZone::BEGIN@25 # spent 32µs making 1 call to constant::import
26355µs287µs
# spent 50µs (12+38) within DateTime::TimeZone::BEGIN@26 which was called: # once (12µs+38µs) by C4::Context::BEGIN@107 at line 26
use constant IS_DST => 5;
# spent 50µs making 1 call to DateTime::TimeZone::BEGIN@26 # spent 38µs making 1 call to constant::import
2732.61ms290µs
# spent 50µs (10+40) within DateTime::TimeZone::BEGIN@27 which was called: # once (10µs+40µs) by C4::Context::BEGIN@107 at line 27
use constant SHORT_NAME => 6;
# spent 50µs making 1 call to DateTime::TimeZone::BEGIN@27 # spent 40µs making 1 call to constant::import
28
29116µsmy %SpecialName = map { $_ => 1 }
30 qw( EST MST HST CET EET MET WET EST5EDT CST6CDT MST7MDT PST8PDT );
31
32
# spent 239µs (81+158) within DateTime::TimeZone::new which was called 2 times, avg 120µs/call: # once (61µs+108µs) by C4::Circulation::BEGIN@24 at line 49 of DateTime/Infinite.pm # once (20µs+50µs) by C4::Circulation::BEGIN@24 at line 73 of DateTime/Infinite.pm
sub new {
3310136µs my $class = shift;
34162µs2123µs my %p = validate(
# spent 123µs making 2 calls to Params::Validate::_validate, avg 62µs/call
# spent 13µs executing statements in 2 string evals (merged)
35 @_,
36 { name => { type => SCALAR } },
37 );
38
39 if ( exists $DateTime::TimeZone::Catalog::LINKS{ $p{name} } ) {
40 $p{name} = $DateTime::TimeZone::Catalog::LINKS{ $p{name} };
41 }
42 elsif ( exists $DateTime::TimeZone::Catalog::LINKS{ uc $p{name} } ) {
43 $p{name} = $DateTime::TimeZone::Catalog::LINKS{ uc $p{name} };
44 }
45
4626µs unless ( $p{name} =~ m,/,
# spent 6µs making 2 calls to DateTime::TimeZone::CORE:match, avg 3µs/call
47 || $SpecialName{ $p{name} } ) {
48229µs if ( $p{name} eq 'floating' ) {
# spent 29µs making 2 calls to DateTime::TimeZone::Floating::new, avg 14µs/call
49 return DateTime::TimeZone::Floating->new;
50 }
51
52 if ( $p{name} eq 'local' ) {
53 return DateTime::TimeZone::Local->TimeZone();
54 }
55
56 if ( $p{name} eq 'UTC' || $p{name} eq 'Z' ) {
57 return DateTime::TimeZone::UTC->new;
58 }
59
60 return DateTime::TimeZone::OffsetOnly->new( offset => $p{name} );
61 }
62
63 my $subclass = $p{name};
64 $subclass =~ s/-/_/g;
65 $subclass =~ s{/}{::}g;
66 my $real_class = "DateTime::TimeZone::$subclass";
67
68 die "The timezone '$p{name}' in an invalid name.\n"
69 unless $real_class =~ /^\w+(::\w+)*$/;
70
71 unless ( $real_class->can('instance') ) {
72 my $e = do {
73 local $@;
74 local $SIG{__DIE__};
75 eval "require $real_class";
76 $@;
77 };
78
79 if ($e) {
80 my $regex = join '.', split /::/, $real_class;
81 $regex .= '\\.pm';
82
83 if ( $e =~ /^Can't locate $regex/i ) {
84 die
85 "The timezone '$p{name}' could not be loaded, or is an invalid name.\n";
86 }
87 else {
88 die $e;
89 }
90 }
91 }
92
93 my $zone = $real_class->instance( name => $p{name}, is_olson => 1 );
94
95 if ( $zone->is_olson() ) {
96 my $object_version
97 = $zone->can('olson_version')
98 ? $zone->olson_version()
99 : 'unknown';
100 my $catalog_version = DateTime::TimeZone::Catalog->OlsonVersion();
101
102 if ( $object_version ne $catalog_version ) {
103 warn
104 "Loaded $real_class, which is from an older version ($object_version) of the Olson database than this installation of DateTime::TimeZone ($catalog_version).\n";
105 }
106 }
107
108 return $zone;
109}
110
111sub _init {
112 my $class = shift;
113 my %p = validate(
114 @_, {
115 name => { type => SCALAR },
116 spans => { type => ARRAYREF },
117 is_olson => { type => BOOLEAN, default => 0 },
118 },
119 );
120
121 my $self = bless {
122 name => $p{name},
123 spans => $p{spans},
124 is_olson => $p{is_olson},
125 }, $class;
126
127 foreach my $k (qw( last_offset last_observance rules max_year )) {
128 my $m = "_$k";
129 $self->{$k} = $self->$m() if $self->can($m);
130 }
131
132 return $self;
133}
134
135sub is_olson { $_[0]->{is_olson} }
136
137sub is_dst_for_datetime {
138 my $self = shift;
139
140 my $span = $self->_span_for_datetime( 'utc', $_[0] );
141
142 return $span->[IS_DST];
143}
144
145sub offset_for_datetime {
146 my $self = shift;
147
148 my $span = $self->_span_for_datetime( 'utc', $_[0] );
149
150 return $span->[OFFSET];
151}
152
153sub offset_for_local_datetime {
154 my $self = shift;
155
156 my $span = $self->_span_for_datetime( 'local', $_[0] );
157
158 return $span->[OFFSET];
159}
160
161sub short_name_for_datetime {
162 my $self = shift;
163
164 my $span = $self->_span_for_datetime( 'utc', $_[0] );
165
166 return $span->[SHORT_NAME];
167}
168
169sub _span_for_datetime {
170 my $self = shift;
171 my $type = shift;
172 my $dt = shift;
173
174 my $method = $type . '_rd_as_seconds';
175
176 my $end = $type eq 'utc' ? UTC_END : LOCAL_END;
177
178 my $span;
179 my $seconds = $dt->$method();
180 if ( $seconds < $self->max_span->[$end] ) {
181 $span = $self->_spans_binary_search( $type, $seconds );
182 }
183 else {
184 my $until_year = $dt->utc_year + 1;
185 $span = $self->_generate_spans_until_match( $until_year, $seconds,
186 $type );
187 }
188
189 # This means someone gave a local time that doesn't exist
190 # (like during a transition into savings time)
191 unless ( defined $span ) {
192 my $err = 'Invalid local time for date';
193 $err .= ' ' . $dt->iso8601 if $type eq 'utc';
194 $err .= " in time zone: " . $self->name;
195 $err .= "\n";
196
197 die $err;
198 }
199
200 return $span;
201}
202
203sub _spans_binary_search {
204 my $self = shift;
205 my ( $type, $seconds ) = @_;
206
207 my ( $start, $end ) = _keys_for_type($type);
208
209 my $min = 0;
210 my $max = scalar @{ $self->{spans} } + 1;
211 my $i = int( $max / 2 );
212
213 # special case for when there are only 2 spans
214 $i++ if $max % 2 && $max != 3;
215
216 $i = 0 if @{ $self->{spans} } == 1;
217
218 while (1) {
219 my $current = $self->{spans}[$i];
220
221 if ( $seconds < $current->[$start] ) {
222 $max = $i;
223 my $c = int( ( $i - $min ) / 2 );
224 $c ||= 1;
225
226 $i -= $c;
227
228 return if $i < $min;
229 }
230 elsif ( $seconds >= $current->[$end] ) {
231 $min = $i;
232 my $c = int( ( $max - $i ) / 2 );
233 $c ||= 1;
234
235 $i += $c;
236
237 return if $i >= $max;
238 }
239 else {
240
241 # Special case for overlapping ranges because of DST and
242 # other weirdness (like Alaska's change when bought from
243 # Russia by the US). Always prefer latest span.
244 if ( $current->[IS_DST] && $type eq 'local' ) {
245
246 # Asia/Dhaka in 2009j goes into DST without any known
247 # end-of-DST date (wtf, Bangladesh).
248 return $current if $current->[UTC_END] == INFINITY;
249
250 my $next = $self->{spans}[ $i + 1 ];
251
252 # Sometimes we will get here and the span we're
253 # looking at is the last that's been generated so far.
254 # We need to try to generate one more or else we run
255 # out.
256 $next ||= $self->_generate_next_span;
257
258 die "No next span in $self->{max_year}" unless defined $next;
259
260 if ( ( !$next->[IS_DST] )
261 && $next->[$start] <= $seconds
262 && $seconds <= $next->[$end] ) {
263 return $next;
264 }
265 }
266
267 return $current;
268 }
269 }
270}
271
272sub _generate_next_span {
273 my $self = shift;
274
275 my $last_idx = $#{ $self->{spans} };
276
277 my $max_span = $self->max_span;
278
279 # Kind of a hack, but AFAIK there are no zones where it takes
280 # _more_ than a year for a _future_ time zone change to occur, so
281 # by looking two years out we can ensure that we will find at
282 # least one more span. Of course, I will no doubt be proved wrong
283 # and this will cause errors.
284 $self->_generate_spans_until_match( $self->{max_year} + 2,
285 $max_span->[UTC_END] + ( 366 * 86400 ), 'utc' );
286
287 return $self->{spans}[ $last_idx + 1 ];
288}
289
290sub _generate_spans_until_match {
291 my $self = shift;
292 my $generate_until_year = shift;
293 my $seconds = shift;
294 my $type = shift;
295
296 my @changes;
297 my @rules = @{ $self->_rules };
298 foreach my $year ( $self->{max_year} .. $generate_until_year ) {
299 for ( my $x = 0; $x < @rules; $x++ ) {
300 my $last_offset_from_std;
301
302 if ( @rules == 2 ) {
303 $last_offset_from_std
304 = $x
305 ? $rules[0]->offset_from_std
306 : $rules[1]->offset_from_std;
307 }
308 elsif ( @rules == 1 ) {
309 $last_offset_from_std = $rules[0]->offset_from_std;
310 }
311 else {
312 my $count = scalar @rules;
313 die
314 "Cannot generate future changes for zone with $count infinite rules\n";
315 }
316
317 my $rule = $rules[$x];
318
319 my $next = $rule->utc_start_datetime_for_year( $year,
320 $self->{last_offset}, $last_offset_from_std );
321
322 # don't bother with changes we've seen already
323 next if $next->utc_rd_as_seconds < $self->max_span->[UTC_END];
324
325 push @changes,
326 DateTime::TimeZone::OlsonDB::Change->new(
327 type => 'rule',
328 utc_start_datetime => $next,
329 local_start_datetime => $next + DateTime::Duration->new(
330 seconds => $self->{last_observance}->total_offset
331 + $rule->offset_from_std
332 ),
333 short_name => sprintf(
334 $self->{last_observance}->format, $rule->letter
335 ),
336 observance => $self->{last_observance},
337 rule => $rule,
338 );
339 }
340 }
341
342 $self->{max_year} = $generate_until_year;
343
344 my @sorted
345 = sort { $a->utc_start_datetime <=> $b->utc_start_datetime } @changes;
346
347 my ( $start, $end ) = _keys_for_type($type);
348
349 my $match;
350 for ( my $x = 1; $x < @sorted; $x++ ) {
351 my $last_total_offset
352 = $x == 1
353 ? $self->max_span->[OFFSET]
354 : $sorted[ $x - 2 ]->total_offset;
355
356 my $span = DateTime::TimeZone::OlsonDB::Change::two_changes_as_span(
357 @sorted[ $x - 1, $x ], $last_total_offset );
358
359 $span = _span_as_array($span);
360
361 push @{ $self->{spans} }, $span;
362
363 $match = $span
364 if $seconds >= $span->[$start] && $seconds < $span->[$end];
365 }
366
367 return $match;
368}
369
370sub max_span { $_[0]->{spans}[-1] }
371
372sub _keys_for_type {
373 $_[0] eq 'utc' ? ( UTC_START, UTC_END ) : ( LOCAL_START, LOCAL_END );
374}
375
376sub _span_as_array {
377 [
378 @{ $_[0] }{
379 qw( utc_start utc_end local_start local_end offset is_dst short_name )
380 }
381 ];
382}
383
384sub is_floating {0}
385
386sub is_utc {0}
387
388sub has_dst_changes {0}
389
390sub name { $_[0]->{name} }
391sub category { ( split /\//, $_[0]->{name}, 2 )[0] }
392
393sub is_valid_name {
394 my $tz;
395 {
396 local $@;
397 local $SIG{__DIE__};
398 $tz = eval { $_[0]->new( name => $_[1] ) };
399 }
400
401 return $tz && $tz->isa('DateTime::TimeZone') ? 1 : 0;
402}
403
404sub STORABLE_freeze {
405 my $self = shift;
406
407 return $self->name;
408}
409
410sub STORABLE_thaw {
411 my $self = shift;
412 my $cloning = shift;
413 my $serialized = shift;
414
415 my $class = ref $self || $self;
416
417 my $obj;
418 if ( $class->isa(__PACKAGE__) ) {
419 $obj = __PACKAGE__->new( name => $serialized );
420 }
421 else {
422 $obj = $class->new( name => $serialized );
423 }
424
425 %$self = %$obj;
426
427 return $self;
428}
429
430#
431# Functions
432#
433sub offset_as_seconds {
434 {
435 local $@;
436 local $SIG{__DIE__};
437 shift if eval { $_[0]->isa('DateTime::TimeZone') };
438 }
439
440 my $offset = shift;
441
442 return undef unless defined $offset;
443
444 return 0 if $offset eq '0';
445
446 my ( $sign, $hours, $minutes, $seconds );
447 if ( $offset =~ /^([\+\-])?(\d\d?):(\d\d)(?::(\d\d))?$/ ) {
448 ( $sign, $hours, $minutes, $seconds ) = ( $1, $2, $3, $4 );
449 }
450 elsif ( $offset =~ /^([\+\-])?(\d\d)(\d\d)(\d\d)?$/ ) {
451 ( $sign, $hours, $minutes, $seconds ) = ( $1, $2, $3, $4 );
452 }
453 else {
454 return undef;
455 }
456
457 $sign = '+' unless defined $sign;
458 return undef unless $hours >= 0 && $hours <= 99;
459 return undef unless $minutes >= 0 && $minutes <= 59;
460 return undef
461 unless !defined($seconds) || ( $seconds >= 0 && $seconds <= 59 );
462
463 my $total = $hours * 3600 + $minutes * 60;
464 $total += $seconds if $seconds;
465 $total *= -1 if $sign eq '-';
466
467 return $total;
468}
469
470sub offset_as_string {
471 {
472 local $@;
473 local $SIG{__DIE__};
474 shift if eval { $_[0]->isa('DateTime::TimeZone') };
475 }
476
477 my $offset = shift;
478
479 return undef unless defined $offset;
480 return undef unless $offset >= -359999 && $offset <= 359999;
481
482 my $sign = $offset < 0 ? '-' : '+';
483
484 $offset = abs($offset);
485
486 my $hours = int( $offset / 3600 );
487 $offset %= 3600;
488 my $mins = int( $offset / 60 );
489 $offset %= 60;
490 my $secs = int($offset);
491
492 return (
493 $secs
494 ? sprintf( '%s%02d%02d%02d', $sign, $hours, $mins, $secs )
495 : sprintf( '%s%02d%02d', $sign, $hours, $mins )
496 );
497}
498
499# These methods all operate on data contained in the DateTime/TimeZone/Catalog.pm file.
500
501sub all_names {
502 return
503 wantarray
504 ? @DateTime::TimeZone::Catalog::ALL
505 : [@DateTime::TimeZone::Catalog::ALL];
506}
507
508sub categories {
509 return wantarray
510 ? @DateTime::TimeZone::Catalog::CATEGORY_NAMES
511 : [@DateTime::TimeZone::Catalog::CATEGORY_NAMES];
512}
513
514sub links {
515 return
516 wantarray
517 ? %DateTime::TimeZone::Catalog::LINKS
518 : {%DateTime::TimeZone::Catalog::LINKS};
519}
520
521sub names_in_category {
522 shift if $_[0]->isa('DateTime::TimeZone');
523 return unless exists $DateTime::TimeZone::Catalog::CATEGORIES{ $_[0] };
524
525 return wantarray
526 ? @{ $DateTime::TimeZone::Catalog::CATEGORIES{ $_[0] } }
527 : [ $DateTime::TimeZone::Catalog::CATEGORIES{ $_[0] } ];
528}
529
530sub countries {
531 wantarray
532 ? ( sort keys %DateTime::TimeZone::Catalog::ZONES_BY_COUNTRY )
533 : [ sort keys %DateTime::TimeZone::Catalog::ZONES_BY_COUNTRY ];
534}
535
536sub names_in_country {
537 shift if $_[0]->isa('DateTime::TimeZone');
538
539 return
540 unless
541 exists $DateTime::TimeZone::Catalog::ZONES_BY_COUNTRY{ lc $_[0] };
542
543 return
544 wantarray
545 ? @{ $DateTime::TimeZone::Catalog::ZONES_BY_COUNTRY{ lc $_[0] } }
546 : $DateTime::TimeZone::Catalog::ZONES_BY_COUNTRY{ lc $_[0] };
547}
548
54918µs1;
550
551__END__
 
# spent 6µs within DateTime::TimeZone::CORE:match which was called 2 times, avg 3µs/call: # 2 times (6µs+0s) by DateTime::TimeZone::new at line 46, avg 3µs/call
sub DateTime::TimeZone::CORE:match; # opcode
Report produced by the NYTProf 4.04 Perl profiler, developed by Tim Bunce and Adam Kaplan.