← Index
NYTProf Performance Profile   « block view • line view • sub view »
For mentat.storage.mongo.pl
  Run on Tue Jun 24 09:58:41 2014
Reported on Tue Jun 24 09:59:18 2014

Filename/usr/local/share/perl/5.14.2/DateTime/TimeZone/OlsonDB.pm
StatementsExecuted 41 statements in 3.66ms
Subroutines
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
1112.25ms8.45msDateTime::TimeZone::OlsonDB::::BEGIN@15DateTime::TimeZone::OlsonDB::BEGIN@15
1111.35ms1.55msDateTime::TimeZone::OlsonDB::::BEGIN@14DateTime::TimeZone::OlsonDB::BEGIN@14
11124µs37µsDateTime::TimeZone::OlsonDB::::BEGIN@10DateTime::TimeZone::OlsonDB::BEGIN@10
11119µs19µsDateTime::TimeZone::OlsonDB::::BEGIN@5DateTime::TimeZone::OlsonDB::BEGIN@5
11118µs87µsDateTime::TimeZone::OlsonDB::::BEGIN@16DateTime::TimeZone::OlsonDB::BEGIN@16
11117µs138µsDateTime::TimeZone::OlsonDB::::BEGIN@12DateTime::TimeZone::OlsonDB::BEGIN@12
11116µs23µsDateTime::TimeZone::OlsonDB::::BEGIN@9DateTime::TimeZone::OlsonDB::BEGIN@9
0000s0sDateTime::TimeZone::OlsonDB::::_parse_lineDateTime::TimeZone::OlsonDB::_parse_line
0000s0sDateTime::TimeZone::OlsonDB::::_parse_linkDateTime::TimeZone::OlsonDB::_parse_link
0000s0sDateTime::TimeZone::OlsonDB::::_parse_ruleDateTime::TimeZone::OlsonDB::_parse_rule
0000s0sDateTime::TimeZone::OlsonDB::::_parse_zoneDateTime::TimeZone::OlsonDB::_parse_zone
0000s0sDateTime::TimeZone::OlsonDB::::expanded_zoneDateTime::TimeZone::OlsonDB::expanded_zone
0000s0sDateTime::TimeZone::OlsonDB::::linksDateTime::TimeZone::OlsonDB::links
0000s0sDateTime::TimeZone::OlsonDB::::newDateTime::TimeZone::OlsonDB::new
0000s0sDateTime::TimeZone::OlsonDB::::parse_day_specDateTime::TimeZone::OlsonDB::parse_day_spec
0000s0sDateTime::TimeZone::OlsonDB::::parse_fileDateTime::TimeZone::OlsonDB::parse_file
0000s0sDateTime::TimeZone::OlsonDB::::rules_by_nameDateTime::TimeZone::OlsonDB::rules_by_name
0000s0sDateTime::TimeZone::OlsonDB::::utc_datetime_for_time_specDateTime::TimeZone::OlsonDB::utc_datetime_for_time_spec
0000s0sDateTime::TimeZone::OlsonDB::::zoneDateTime::TimeZone::OlsonDB::zone
0000s0sDateTime::TimeZone::OlsonDB::::zone_namesDateTime::TimeZone::OlsonDB::zone_names
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::OlsonDB;
2{
323µs $DateTime::TimeZone::OlsonDB::VERSION = '1.63';
4}
5
# spent 19µs within DateTime::TimeZone::OlsonDB::BEGIN@5 which was called: # once (19µs+0s) by DateTime::TimeZone::Europe::Prague::BEGIN@22 at line 7
BEGIN {
6112µs $DateTime::TimeZone::OlsonDB::AUTHORITY = 'cpan:DROLSKY';
7153µs119µs}
# spent 19µs making 1 call to DateTime::TimeZone::OlsonDB::BEGIN@5
8
9258µs230µs
# spent 23µs (16+7) within DateTime::TimeZone::OlsonDB::BEGIN@9 which was called: # once (16µs+7µs) by DateTime::TimeZone::Europe::Prague::BEGIN@22 at line 9
use strict;
# spent 23µs making 1 call to DateTime::TimeZone::OlsonDB::BEGIN@9 # spent 7µs making 1 call to strict::import
10269µs250µs
# spent 37µs (24+13) within DateTime::TimeZone::OlsonDB::BEGIN@10 which was called: # once (24µs+13µs) by DateTime::TimeZone::Europe::Prague::BEGIN@22 at line 10
use warnings;
# spent 37µs making 1 call to DateTime::TimeZone::OlsonDB::BEGIN@10 # spent 13µs making 1 call to warnings::import
11
12268µs2259µs
# spent 138µs (17+121) within DateTime::TimeZone::OlsonDB::BEGIN@12 which was called: # once (17µs+121µs) by DateTime::TimeZone::Europe::Prague::BEGIN@22 at line 12
use vars qw( %MONTHS %DAYS $PLUS_ONE_DAY_DUR $MINUS_ONE_DAY_DUR );
# spent 138µs making 1 call to DateTime::TimeZone::OlsonDB::BEGIN@12 # spent 121µs making 1 call to vars::import
13
142244µs11.55ms
# spent 1.55ms (1.35+203µs) within DateTime::TimeZone::OlsonDB::BEGIN@14 which was called: # once (1.35ms+203µs) by DateTime::TimeZone::Europe::Prague::BEGIN@22 at line 14
use DateTime::TimeZone::OlsonDB::Rule;
# spent 1.55ms making 1 call to DateTime::TimeZone::OlsonDB::BEGIN@14
152257µs18.45ms
# spent 8.45ms (2.25+6.20) within DateTime::TimeZone::OlsonDB::BEGIN@15 which was called: # once (2.25ms+6.20ms) by DateTime::TimeZone::Europe::Prague::BEGIN@22 at line 15
use DateTime::TimeZone::OlsonDB::Zone;
# spent 8.45ms making 1 call to DateTime::TimeZone::OlsonDB::BEGIN@15
1622.82ms2156µs
# spent 87µs (18+69) within DateTime::TimeZone::OlsonDB::BEGIN@16 which was called: # once (18µs+69µs) by DateTime::TimeZone::Europe::Prague::BEGIN@22 at line 16
use Params::Validate qw( validate SCALAR );
# spent 87µs making 1 call to DateTime::TimeZone::OlsonDB::BEGIN@16 # spent 69µs making 1 call to Exporter::import
17
181500nsmy $x = 1;
191328µs%MONTHS = map { $_ => $x++ } qw( Jan Feb Mar Apr May Jun
20 Jul Aug Sep Oct Nov Dec);
21
221400ns$x = 1;
23812µs%DAYS = map { $_ => $x++ } qw( Mon Tue Wed Thu Fri Sat Sun );
24
2517µs1187µs$PLUS_ONE_DAY_DUR = DateTime::Duration->new( days => 1 );
# spent 187µs making 1 call to DateTime::Duration::new
2614µs183µs$MINUS_ONE_DAY_DUR = DateTime::Duration->new( days => -1 );
# spent 83µs making 1 call to DateTime::Duration::new
27
28sub new {
29 my $class = shift;
30
31 return bless {
32 rules => {},
33 zones => {},
34 links => {},
35 }, $class;
36}
37
38sub parse_file {
39 my $self = shift;
40 my $file = shift;
41
42 open my $fh, "<$file"
43 or die "Cannot read $file: $!";
44
45 while (<$fh>) {
46 chomp;
47 $self->_parse_line($_);
48 }
49}
50
51sub _parse_line {
52 my $self = shift;
53 my $line = shift;
54
55 return if $line =~ /^\s+$/;
56 return if $line =~ /^#/;
57
58 # remove any comments at the end of the line
59 $line =~ s/\s*#.+$//;
60
61 if ( $self->{in_zone} && $line =~ /^\t/ ) {
62 $self->_parse_zone( $line, $self->{in_zone} );
63 return;
64 }
65
66 foreach (qw( Rule Zone Link )) {
67 if ( substr( $line, 0, 4 ) eq $_ ) {
68 my $m = '_parse_' . lc $_;
69 $self->$m($line);
70 }
71 }
72}
73
74sub _parse_rule {
75 my $self = shift;
76 my $rule = shift;
77
78 my @items = split /\s+/, $rule, 10;
79
80 shift @items;
81 my $name = shift @items;
82
83 my %rule;
84 @rule{qw( from to type in on at save letter )} = @items;
85 delete $rule{letter} if $rule{letter} eq '-';
86
87 # As of the 2003a data, there are no rules with a type set
88 delete $rule{type} if $rule{type} eq '-';
89
90 push @{ $self->{rules}{$name} },
91 DateTime::TimeZone::OlsonDB::Rule->new( name => $name, %rule );
92
93 undef $self->{in_zone};
94}
95
96sub _parse_zone {
97 my $self = shift;
98 my $zone = shift;
99 my $name = shift;
100
101 my $expect = $name ? 5 : 6;
102 my @items = grep { defined && length } split /\s+/, $zone, $expect;
103
104 my %obs;
105 unless ($name) {
106 shift @items; # remove "Zone"
107 $name = shift @items;
108 }
109
110 @obs{qw( gmtoff rules format until )} = @items;
111
112 if ( $obs{rules} =~ /\d\d?:\d\d/ ) {
113 $obs{offset_from_std} = delete $obs{rules};
114 }
115 else {
116 delete $obs{rules} if $obs{rules} eq '-';
117 }
118
119 delete $obs{until} unless defined $obs{until};
120
121 push @{ $self->{zones}{$name} }, \%obs;
122
123 $self->{in_zone} = $name;
124}
125
126sub _parse_link {
127 my $self = shift;
128 my $link = shift;
129
130 my @items = split /\s+/, $link, 3;
131
132 $self->{links}{ $items[2] } = $items[1];
133
134 undef $self->{in_zone};
135}
136
137sub links { %{ $_[0]->{links} } }
138
139sub zone_names { keys %{ $_[0]->{zones} } }
140
141sub zone {
142 my $self = shift;
143 my $name = shift;
144
145 die "Invalid zone name $name"
146 unless exists $self->{zones}{$name};
147
148 return DateTime::TimeZone::OlsonDB::Zone->new(
149 name => $name,
150 observances => $self->{zones}{$name},
151 olson_db => $self,
152 );
153}
154
155sub expanded_zone {
156 my $self = shift;
157 my %p = validate(
158 @_, {
159 name => { type => SCALAR },
160 expand_to_year => {
161 type => SCALAR,
162 default => (localtime)[5] + 1910
163 },
164 }
165 );
166
167 my $zone = $self->zone( $p{name} );
168
169 $zone->expand_observances( $self, $p{expand_to_year} );
170
171 return $zone;
172}
173
174sub rules_by_name {
175 my $self = shift;
176 my $name = shift;
177
178 return unless defined $name;
179
180 die "Invalid rule name $name"
181 unless exists $self->{rules}{$name};
182
183 return @{ $self->{rules}{$name} };
184}
185
186sub parse_day_spec {
187 my ( $day, $month, $year ) = @_;
188
189 return $day if $day =~ /^\d+$/;
190
191 if ( $day =~ /^last(\w\w\w)$/ ) {
192 my $dow = $DAYS{$1};
193
194 my $last_day = DateTime->last_day_of_month(
195 year => $year,
196 month => $month,
197 time_zone => 'floating',
198 );
199
200 my $dt = DateTime->new(
201 year => $year,
202 month => $month,
203 day => $last_day->day,
204 time_zone => 'floating',
205 );
206
207 while ( $dt->day_of_week != $dow ) {
208 $dt -= $PLUS_ONE_DAY_DUR;
209 }
210
211 return $dt->day;
212 }
213 elsif ( $day =~ /^(\w\w\w)([><])=(\d\d?)$/ ) {
214 my $dow = $DAYS{$1};
215
216 my $dt = DateTime->new(
217 year => $year,
218 month => $month,
219 day => $3,
220 time_zone => 'floating',
221 );
222
223 my $dur = $2 eq '<' ? $MINUS_ONE_DAY_DUR : $PLUS_ONE_DAY_DUR;
224
225 while ( $dt->day_of_week != $dow ) {
226 $dt += $dur;
227 }
228
229 return $dt->day;
230 }
231 else {
232 die "Invalid on spec for rule: $day\n";
233 }
234}
235
236sub utc_datetime_for_time_spec {
237 my %p = validate(
238 @_, {
239 spec => { type => SCALAR },
240 year => { type => SCALAR },
241 month => { type => SCALAR },
242 day => { type => SCALAR },
243 offset_from_utc => { type => SCALAR },
244 offset_from_std => { type => SCALAR },
245 },
246 );
247
248 # 'w'all - ignore it, because that's the default
249 $p{spec} =~ s/w$//;
250
251 # 'g'reenwich, 'u'tc, or 'z'ulu
252 my $is_utc = $p{spec} =~ s/[guz]$//;
253
254 # 's'tandard time - ignore DS offset
255 my $is_std = $p{spec} =~ s/s$//;
256
257 my ( $hour, $minute, $second ) = split /:/, $p{spec};
258 $minute = 0 unless defined $minute;
259 $second = 0 unless defined $second;
260
261 my $add_day = 0;
262 if ( $hour == 24 ) {
263 $hour = 0;
264 $add_day = 1;
265 }
266
267 my $utc;
268 if ($is_utc) {
269 $utc = DateTime->new(
270 year => $p{year},
271 month => $p{month},
272 day => $p{day},
273 hour => $hour,
274 minute => $minute,
275 second => $second,
276 time_zone => 'floating',
277 );
278 }
279 else {
280 my $local = DateTime->new(
281 year => $p{year},
282 month => $p{month},
283 day => $p{day},
284 hour => $hour,
285 minute => $minute,
286 second => $second,
287 time_zone => 'floating',
288 );
289
290 $p{offset_from_std} = 0 if $is_std;
291
292 my $dur = DateTime::Duration->new(
293 seconds => $p{offset_from_utc} + $p{offset_from_std} );
294
295 $utc = $local - $dur;
296 }
297
298 $utc->add( days => 1 ) if $add_day;
299
300 return $utc;
301}
302
303121µs1;
304
305# ABSTRACT: An object to represent an Olson time zone database
306
307__END__