Filename | /usr/local/share/perl/5.14.2/DateTime/TimeZone/OlsonDB.pm |
Statements | Executed 41 statements in 3.66ms |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
1 | 1 | 1 | 2.25ms | 8.45ms | BEGIN@15 | DateTime::TimeZone::OlsonDB::
1 | 1 | 1 | 1.35ms | 1.55ms | BEGIN@14 | DateTime::TimeZone::OlsonDB::
1 | 1 | 1 | 24µs | 37µs | BEGIN@10 | DateTime::TimeZone::OlsonDB::
1 | 1 | 1 | 19µs | 19µs | BEGIN@5 | DateTime::TimeZone::OlsonDB::
1 | 1 | 1 | 18µs | 87µs | BEGIN@16 | DateTime::TimeZone::OlsonDB::
1 | 1 | 1 | 17µs | 138µs | BEGIN@12 | DateTime::TimeZone::OlsonDB::
1 | 1 | 1 | 16µs | 23µs | BEGIN@9 | DateTime::TimeZone::OlsonDB::
0 | 0 | 0 | 0s | 0s | _parse_line | DateTime::TimeZone::OlsonDB::
0 | 0 | 0 | 0s | 0s | _parse_link | DateTime::TimeZone::OlsonDB::
0 | 0 | 0 | 0s | 0s | _parse_rule | DateTime::TimeZone::OlsonDB::
0 | 0 | 0 | 0s | 0s | _parse_zone | DateTime::TimeZone::OlsonDB::
0 | 0 | 0 | 0s | 0s | expanded_zone | DateTime::TimeZone::OlsonDB::
0 | 0 | 0 | 0s | 0s | links | DateTime::TimeZone::OlsonDB::
0 | 0 | 0 | 0s | 0s | new | DateTime::TimeZone::OlsonDB::
0 | 0 | 0 | 0s | 0s | parse_day_spec | DateTime::TimeZone::OlsonDB::
0 | 0 | 0 | 0s | 0s | parse_file | DateTime::TimeZone::OlsonDB::
0 | 0 | 0 | 0s | 0s | rules_by_name | DateTime::TimeZone::OlsonDB::
0 | 0 | 0 | 0s | 0s | utc_datetime_for_time_spec | DateTime::TimeZone::OlsonDB::
0 | 0 | 0 | 0s | 0s | zone | DateTime::TimeZone::OlsonDB::
0 | 0 | 0 | 0s | 0s | zone_names | DateTime::TimeZone::OlsonDB::
Line | State ments |
Time on line |
Calls | Time in subs |
Code |
---|---|---|---|---|---|
1 | package DateTime::TimeZone::OlsonDB; | ||||
2 | { | ||||
3 | 2 | 3µ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 | ||||
6 | 1 | 12µs | $DateTime::TimeZone::OlsonDB::AUTHORITY = 'cpan:DROLSKY'; | ||
7 | 1 | 53µs | 1 | 19µs | } # spent 19µs making 1 call to DateTime::TimeZone::OlsonDB::BEGIN@5 |
8 | |||||
9 | 2 | 58µs | 2 | 30µ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 # spent 23µs making 1 call to DateTime::TimeZone::OlsonDB::BEGIN@9
# spent 7µs making 1 call to strict::import |
10 | 2 | 69µs | 2 | 50µ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 # spent 37µs making 1 call to DateTime::TimeZone::OlsonDB::BEGIN@10
# spent 13µs making 1 call to warnings::import |
11 | |||||
12 | 2 | 68µs | 2 | 259µ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 # spent 138µs making 1 call to DateTime::TimeZone::OlsonDB::BEGIN@12
# spent 121µs making 1 call to vars::import |
13 | |||||
14 | 2 | 244µs | 1 | 1.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 # spent 1.55ms making 1 call to DateTime::TimeZone::OlsonDB::BEGIN@14 |
15 | 2 | 257µs | 1 | 8.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 # spent 8.45ms making 1 call to DateTime::TimeZone::OlsonDB::BEGIN@15 |
16 | 2 | 2.82ms | 2 | 156µ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 # spent 87µs making 1 call to DateTime::TimeZone::OlsonDB::BEGIN@16
# spent 69µs making 1 call to Exporter::import |
17 | |||||
18 | 1 | 500ns | my $x = 1; | ||
19 | 13 | 28µs | %MONTHS = map { $_ => $x++ } qw( Jan Feb Mar Apr May Jun | ||
20 | Jul Aug Sep Oct Nov Dec); | ||||
21 | |||||
22 | 1 | 400ns | $x = 1; | ||
23 | 8 | 12µs | %DAYS = map { $_ => $x++ } qw( Mon Tue Wed Thu Fri Sat Sun ); | ||
24 | |||||
25 | 1 | 7µs | 1 | 187µs | $PLUS_ONE_DAY_DUR = DateTime::Duration->new( days => 1 ); # spent 187µs making 1 call to DateTime::Duration::new |
26 | 1 | 4µs | 1 | 83µs | $MINUS_ONE_DAY_DUR = DateTime::Duration->new( days => -1 ); # spent 83µs making 1 call to DateTime::Duration::new |
27 | |||||
28 | sub new { | ||||
29 | my $class = shift; | ||||
30 | |||||
31 | return bless { | ||||
32 | rules => {}, | ||||
33 | zones => {}, | ||||
34 | links => {}, | ||||
35 | }, $class; | ||||
36 | } | ||||
37 | |||||
38 | sub 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 | |||||
51 | sub _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 | |||||
74 | sub _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 | |||||
96 | sub _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 | |||||
126 | sub _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 | |||||
137 | sub links { %{ $_[0]->{links} } } | ||||
138 | |||||
139 | sub zone_names { keys %{ $_[0]->{zones} } } | ||||
140 | |||||
141 | sub 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 | |||||
155 | sub 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 | |||||
174 | sub 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 | |||||
186 | sub 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 | |||||
236 | sub 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 | |||||
303 | 1 | 21µs | 1; | ||
304 | |||||
305 | # ABSTRACT: An object to represent an Olson time zone database | ||||
306 | |||||
307 | __END__ |