← Index
NYTProf Performance Profile   « block view • line view • sub view »
For mentat.storage.mongo.pl
  Run on Tue Jun 24 10:04:38 2014
Reported on Tue Jun 24 10:05:12 2014

Filename/usr/local/share/perl/5.14.2/DateTime/TimeZone/OlsonDB.pm
StatementsExecuted 41 statements in 1.66ms
Subroutines
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
1111000µs3.75msDateTime::TimeZone::OlsonDB::::BEGIN@15DateTime::TimeZone::OlsonDB::BEGIN@15
111606µs700µsDateTime::TimeZone::OlsonDB::::BEGIN@14DateTime::TimeZone::OlsonDB::BEGIN@14
11122µs93µsDateTime::TimeZone::OlsonDB::::BEGIN@12DateTime::TimeZone::OlsonDB::BEGIN@12
11113µs20µsDateTime::TimeZone::OlsonDB::::BEGIN@10DateTime::TimeZone::OlsonDB::BEGIN@10
1118µs8µsDateTime::TimeZone::OlsonDB::::BEGIN@5DateTime::TimeZone::OlsonDB::BEGIN@5
1118µs39µsDateTime::TimeZone::OlsonDB::::BEGIN@16DateTime::TimeZone::OlsonDB::BEGIN@16
1117µs10µ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{
321µs $DateTime::TimeZone::OlsonDB::VERSION = '1.63';
4}
5
# spent 8µs within DateTime::TimeZone::OlsonDB::BEGIN@5 which was called: # once (8µs+0s) by DateTime::TimeZone::Europe::Prague::BEGIN@22 at line 7
BEGIN {
615µs $DateTime::TimeZone::OlsonDB::AUTHORITY = 'cpan:DROLSKY';
7127µs18µs}
# spent 8µs making 1 call to DateTime::TimeZone::OlsonDB::BEGIN@5
8
9246µs212µs
# spent 10µs (7+3) within DateTime::TimeZone::OlsonDB::BEGIN@9 which was called: # once (7µs+3µs) by DateTime::TimeZone::Europe::Prague::BEGIN@22 at line 9
use strict;
# spent 10µs making 1 call to DateTime::TimeZone::OlsonDB::BEGIN@9 # spent 3µs making 1 call to strict::import
10247µs227µs
# spent 20µs (13+7) within DateTime::TimeZone::OlsonDB::BEGIN@10 which was called: # once (13µs+7µs) by DateTime::TimeZone::Europe::Prague::BEGIN@22 at line 10
use warnings;
# spent 20µs making 1 call to DateTime::TimeZone::OlsonDB::BEGIN@10 # spent 7µs making 1 call to warnings::import
11
12241µs2163µs
# spent 93µs (22+70) within DateTime::TimeZone::OlsonDB::BEGIN@12 which was called: # once (22µs+70µ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 93µs making 1 call to DateTime::TimeZone::OlsonDB::BEGIN@12 # spent 70µs making 1 call to vars::import
13
142117µs1700µs
# spent 700µs (606+95) within DateTime::TimeZone::OlsonDB::BEGIN@14 which was called: # once (606µs+95µs) by DateTime::TimeZone::Europe::Prague::BEGIN@22 at line 14
use DateTime::TimeZone::OlsonDB::Rule;
# spent 700µs making 1 call to DateTime::TimeZone::OlsonDB::BEGIN@14
152120µs13.75ms
# spent 3.75ms (1000µs+2.75) within DateTime::TimeZone::OlsonDB::BEGIN@15 which was called: # once (1000µs+2.75ms) by DateTime::TimeZone::Europe::Prague::BEGIN@22 at line 15
use DateTime::TimeZone::OlsonDB::Zone;
# spent 3.75ms making 1 call to DateTime::TimeZone::OlsonDB::BEGIN@15
1621.22ms270µs
# spent 39µs (8+31) within DateTime::TimeZone::OlsonDB::BEGIN@16 which was called: # once (8µs+31µs) by DateTime::TimeZone::Europe::Prague::BEGIN@22 at line 16
use Params::Validate qw( validate SCALAR );
# spent 39µs making 1 call to DateTime::TimeZone::OlsonDB::BEGIN@16 # spent 31µs making 1 call to Exporter::import
17
181300nsmy $x = 1;
191313µs%MONTHS = map { $_ => $x++ } qw( Jan Feb Mar Apr May Jun
20 Jul Aug Sep Oct Nov Dec);
21
221100ns$x = 1;
2387µs%DAYS = map { $_ => $x++ } qw( Mon Tue Wed Thu Fri Sat Sun );
24
2514µs199µs$PLUS_ONE_DAY_DUR = DateTime::Duration->new( days => 1 );
# spent 99µs making 1 call to DateTime::Duration::new
2612µs136µs$MINUS_ONE_DAY_DUR = DateTime::Duration->new( days => -1 );
# spent 36µ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
30319µs1;
304
305# ABSTRACT: An object to represent an Olson time zone database
306
307__END__