Filename | /usr/local/share/perl/5.14.2/DateTime/TimeZone/OlsonDB/Observance.pm |
Statements | Executed 18 statements in 1.54ms |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
1 | 1 | 1 | 12µs | 97µs | BEGIN@16 | DateTime::TimeZone::OlsonDB::Observance::
1 | 1 | 1 | 10µs | 16µs | BEGIN@9 | DateTime::TimeZone::OlsonDB::Observance::
1 | 1 | 1 | 10µs | 10µs | BEGIN@5 | DateTime::TimeZone::OlsonDB::Observance::
1 | 1 | 1 | 7µs | 12µs | BEGIN@10 | DateTime::TimeZone::OlsonDB::Observance::
1 | 1 | 1 | 7µs | 46µs | BEGIN@17 | DateTime::TimeZone::OlsonDB::Observance::
1 | 1 | 1 | 4µs | 4µs | BEGIN@12 | DateTime::TimeZone::OlsonDB::Observance::
1 | 1 | 1 | 4µs | 4µs | BEGIN@14 | DateTime::TimeZone::OlsonDB::Observance::
1 | 1 | 1 | 4µs | 4µs | BEGIN@13 | DateTime::TimeZone::OlsonDB::Observance::
0 | 0 | 0 | 0s | 0s | __ANON__[:348] | DateTime::TimeZone::OlsonDB::Observance::
0 | 0 | 0 | 0s | 0s | _first_no_dst_rule | DateTime::TimeZone::OlsonDB::Observance::
0 | 0 | 0 | 0s | 0s | _first_rule | DateTime::TimeZone::OlsonDB::Observance::
0 | 0 | 0 | 0s | 0s | _sorted_rules_for_year | DateTime::TimeZone::OlsonDB::Observance::
0 | 0 | 0 | 0s | 0s | expand_from_rules | DateTime::TimeZone::OlsonDB::Observance::
0 | 0 | 0 | 0s | 0s | first_rule | DateTime::TimeZone::OlsonDB::Observance::
0 | 0 | 0 | 0s | 0s | format | DateTime::TimeZone::OlsonDB::Observance::
0 | 0 | 0 | 0s | 0s | local_start_datetime | DateTime::TimeZone::OlsonDB::Observance::
0 | 0 | 0 | 0s | 0s | new | DateTime::TimeZone::OlsonDB::Observance::
0 | 0 | 0 | 0s | 0s | offset_from_std | DateTime::TimeZone::OlsonDB::Observance::
0 | 0 | 0 | 0s | 0s | offset_from_utc | DateTime::TimeZone::OlsonDB::Observance::
0 | 0 | 0 | 0s | 0s | rules | DateTime::TimeZone::OlsonDB::Observance::
0 | 0 | 0 | 0s | 0s | total_offset | DateTime::TimeZone::OlsonDB::Observance::
0 | 0 | 0 | 0s | 0s | until | DateTime::TimeZone::OlsonDB::Observance::
0 | 0 | 0 | 0s | 0s | until_day | DateTime::TimeZone::OlsonDB::Observance::
0 | 0 | 0 | 0s | 0s | until_month | DateTime::TimeZone::OlsonDB::Observance::
0 | 0 | 0 | 0s | 0s | until_time_spec | DateTime::TimeZone::OlsonDB::Observance::
0 | 0 | 0 | 0s | 0s | until_year | DateTime::TimeZone::OlsonDB::Observance::
0 | 0 | 0 | 0s | 0s | utc_start_datetime | DateTime::TimeZone::OlsonDB::Observance::
Line | State ments |
Time on line |
Calls | Time in subs |
Code |
---|---|---|---|---|---|
1 | package DateTime::TimeZone::OlsonDB::Observance; | ||||
2 | { | ||||
3 | 2 | 1µs | $DateTime::TimeZone::OlsonDB::Observance::VERSION = '1.63'; | ||
4 | } | ||||
5 | # spent 10µs within DateTime::TimeZone::OlsonDB::Observance::BEGIN@5 which was called:
# once (10µs+0s) by DateTime::TimeZone::OlsonDB::Zone::BEGIN@15 at line 7 | ||||
6 | 1 | 5µs | $DateTime::TimeZone::OlsonDB::Observance::AUTHORITY = 'cpan:DROLSKY'; | ||
7 | 1 | 20µs | 1 | 10µs | } # spent 10µs making 1 call to DateTime::TimeZone::OlsonDB::Observance::BEGIN@5 |
8 | |||||
9 | 2 | 23µs | 2 | 22µs | # spent 16µs (10+6) within DateTime::TimeZone::OlsonDB::Observance::BEGIN@9 which was called:
# once (10µs+6µs) by DateTime::TimeZone::OlsonDB::Zone::BEGIN@15 at line 9 # spent 16µs making 1 call to DateTime::TimeZone::OlsonDB::Observance::BEGIN@9
# spent 6µs making 1 call to strict::import |
10 | 2 | 21µs | 2 | 18µs | # spent 12µs (7+5) within DateTime::TimeZone::OlsonDB::Observance::BEGIN@10 which was called:
# once (7µs+5µs) by DateTime::TimeZone::OlsonDB::Zone::BEGIN@15 at line 10 # spent 12µs making 1 call to DateTime::TimeZone::OlsonDB::Observance::BEGIN@10
# spent 5µs making 1 call to warnings::import |
11 | |||||
12 | 2 | 20µs | 1 | 4µs | # spent 4µs within DateTime::TimeZone::OlsonDB::Observance::BEGIN@12 which was called:
# once (4µs+0s) by DateTime::TimeZone::OlsonDB::Zone::BEGIN@15 at line 12 # spent 4µs making 1 call to DateTime::TimeZone::OlsonDB::Observance::BEGIN@12 |
13 | 2 | 19µs | 1 | 4µs | # spent 4µs within DateTime::TimeZone::OlsonDB::Observance::BEGIN@13 which was called:
# once (4µs+0s) by DateTime::TimeZone::OlsonDB::Zone::BEGIN@15 at line 13 # spent 4µs making 1 call to DateTime::TimeZone::OlsonDB::Observance::BEGIN@13 |
14 | 2 | 21µs | 1 | 4µs | # spent 4µs within DateTime::TimeZone::OlsonDB::Observance::BEGIN@14 which was called:
# once (4µs+0s) by DateTime::TimeZone::OlsonDB::Zone::BEGIN@15 at line 14 # spent 4µs making 1 call to DateTime::TimeZone::OlsonDB::Observance::BEGIN@14 |
15 | |||||
16 | 2 | 32µs | 2 | 114µs | # spent 97µs (12+84) within DateTime::TimeZone::OlsonDB::Observance::BEGIN@16 which was called:
# once (12µs+84µs) by DateTime::TimeZone::OlsonDB::Zone::BEGIN@15 at line 16 # spent 97µs making 1 call to DateTime::TimeZone::OlsonDB::Observance::BEGIN@16
# spent 17µs making 1 call to List::Util::import |
17 | 2 | 1.37ms | 2 | 86µs | # spent 46µs (7+39) within DateTime::TimeZone::OlsonDB::Observance::BEGIN@17 which was called:
# once (7µs+39µs) by DateTime::TimeZone::OlsonDB::Zone::BEGIN@15 at line 17 # spent 46µs making 1 call to DateTime::TimeZone::OlsonDB::Observance::BEGIN@17
# spent 40µs making 1 call to Exporter::import |
18 | |||||
19 | sub new { | ||||
20 | my $class = shift; | ||||
21 | my %p = validate( | ||||
22 | @_, { | ||||
23 | gmtoff => { type => SCALAR }, | ||||
24 | rules => { type => ARRAYREF }, | ||||
25 | format => { type => SCALAR }, | ||||
26 | until => { type => SCALAR, default => '' }, | ||||
27 | utc_start_datetime => { type => OBJECT | UNDEF }, | ||||
28 | offset_from_std => { type => SCALAR, default => 0 }, | ||||
29 | last_offset_from_utc => { type => SCALAR, default => 0 }, | ||||
30 | last_offset_from_std => { type => SCALAR, default => 0 }, | ||||
31 | } | ||||
32 | ); | ||||
33 | |||||
34 | my $offset_from_utc = DateTime::TimeZone::offset_as_seconds( $p{gmtoff} ); | ||||
35 | my $offset_from_std | ||||
36 | = DateTime::TimeZone::offset_as_seconds( $p{offset_from_std} ); | ||||
37 | |||||
38 | my $last_offset_from_utc = delete $p{last_offset_from_utc}; | ||||
39 | my $last_offset_from_std = delete $p{last_offset_from_std}; | ||||
40 | |||||
41 | my $self = bless { | ||||
42 | %p, | ||||
43 | offset_from_utc => $offset_from_utc, | ||||
44 | offset_from_std => $offset_from_std, | ||||
45 | until => [ split /\s+/, $p{until} ], | ||||
46 | }, $class; | ||||
47 | |||||
48 | $self->{first_rule} | ||||
49 | = $self->_first_rule( $last_offset_from_utc, $last_offset_from_std ); | ||||
50 | |||||
51 | if ( $p{utc_start_datetime} ) { | ||||
52 | $offset_from_std += $self->{first_rule}->offset_from_std | ||||
53 | if $self->{first_rule}; | ||||
54 | |||||
55 | my $local_start_datetime = $p{utc_start_datetime}->clone; | ||||
56 | |||||
57 | $local_start_datetime += DateTime::Duration->new( | ||||
58 | seconds => $offset_from_utc + $offset_from_std ); | ||||
59 | |||||
60 | $self->{local_start_datetime} = $local_start_datetime; | ||||
61 | } | ||||
62 | |||||
63 | return $self; | ||||
64 | } | ||||
65 | |||||
66 | sub offset_from_utc { $_[0]->{offset_from_utc} } | ||||
67 | sub offset_from_std { $_[0]->{offset_from_std} } | ||||
68 | sub total_offset { $_[0]->offset_from_utc + $_[0]->offset_from_std } | ||||
69 | |||||
70 | sub rules { @{ $_[0]->{rules} } } | ||||
71 | sub first_rule { $_[0]->{first_rule} } | ||||
72 | |||||
73 | sub format { $_[0]->{format} } | ||||
74 | |||||
75 | sub utc_start_datetime { $_[0]->{utc_start_datetime} } | ||||
76 | sub local_start_datetime { $_[0]->{local_start_datetime} } | ||||
77 | |||||
78 | sub expand_from_rules { | ||||
79 | my $self = shift; | ||||
80 | my $zone = shift; | ||||
81 | |||||
82 | # real max is year + 1 so we include max year | ||||
83 | my $max_year = (shift) + 1; | ||||
84 | |||||
85 | my $min_year; | ||||
86 | |||||
87 | if ( $self->utc_start_datetime ) { | ||||
88 | $min_year = $self->utc_start_datetime->year; | ||||
89 | } | ||||
90 | else { | ||||
91 | |||||
92 | # There is at least one time zone that has an infinite | ||||
93 | # observance, but that observance has rules that only start at | ||||
94 | # a certain point - Pacific/Chatham | ||||
95 | |||||
96 | # In this case we just find the earliest rule and start there | ||||
97 | |||||
98 | $min_year | ||||
99 | = ( sort { $a <=> $b } map { $_->min_year } $self->rules )[0]; | ||||
100 | } | ||||
101 | |||||
102 | my $until = $self->until( $zone->last_change->offset_from_std ); | ||||
103 | if ($until) { | ||||
104 | $max_year = $until->year; | ||||
105 | } | ||||
106 | else { | ||||
107 | |||||
108 | # Some zones, like Asia/Tehran, have a predefined fixed set of | ||||
109 | # rules that go well into the future (2037 for Asia/Tehran) | ||||
110 | my $max_rule_year = 0; | ||||
111 | foreach my $rule ( $self->rules ) { | ||||
112 | $max_rule_year = $rule->max_year | ||||
113 | if $rule->max_year && $rule->max_year > $max_rule_year; | ||||
114 | } | ||||
115 | |||||
116 | $max_year = $max_rule_year if $max_rule_year > $max_year; | ||||
117 | } | ||||
118 | |||||
119 | foreach my $year ( $min_year .. $max_year ) { | ||||
120 | my @rules = $self->_sorted_rules_for_year($year); | ||||
121 | |||||
122 | foreach my $rule (@rules) { | ||||
123 | my $dt = $rule->utc_start_datetime_for_year( $year, | ||||
124 | $self->offset_from_utc, $zone->last_change->offset_from_std ); | ||||
125 | |||||
126 | next | ||||
127 | if $self->utc_start_datetime | ||||
128 | && $dt <= $self->utc_start_datetime; | ||||
129 | |||||
130 | my $until = $self->until( $zone->last_change->offset_from_std ); | ||||
131 | |||||
132 | next if $until && $dt >= $until; | ||||
133 | |||||
134 | my $change = DateTime::TimeZone::OlsonDB::Change->new( | ||||
135 | type => 'rule', | ||||
136 | utc_start_datetime => $dt, | ||||
137 | local_start_datetime => $dt + DateTime::Duration->new( | ||||
138 | seconds => $self->total_offset + $rule->offset_from_std | ||||
139 | ), | ||||
140 | short_name => sprintf( $self->{format}, $rule->letter ), | ||||
141 | observance => $self, | ||||
142 | rule => $rule, | ||||
143 | ); | ||||
144 | |||||
145 | if ($DateTime::TimeZone::OlsonDB::DEBUG) { | ||||
146 | print "Adding rule change ...\n"; | ||||
147 | |||||
148 | $change->_debug_output; | ||||
149 | } | ||||
150 | |||||
151 | $zone->add_change($change); | ||||
152 | } | ||||
153 | } | ||||
154 | } | ||||
155 | |||||
156 | sub _sorted_rules_for_year { | ||||
157 | my $self = shift; | ||||
158 | my $year = shift; | ||||
159 | |||||
160 | return ( | ||||
161 | map { $_->[0] } | ||||
162 | sort { $a->[1] <=> $b->[1] } | ||||
163 | map { | ||||
164 | my $dt = $_->utc_start_datetime_for_year( $year, | ||||
165 | $self->offset_from_utc, 0 ); | ||||
166 | [ $_, $dt ] | ||||
167 | } | ||||
168 | grep { | ||||
169 | $_->min_year <= $year | ||||
170 | && ( ( !$_->max_year ) || $_->max_year >= $year ) | ||||
171 | } $self->rules | ||||
172 | ); | ||||
173 | } | ||||
174 | |||||
175 | sub until { | ||||
176 | my $self = shift; | ||||
177 | my $offset_from_std = shift || $self->offset_from_std; | ||||
178 | |||||
179 | return unless defined $self->until_year; | ||||
180 | |||||
181 | my $utc = DateTime::TimeZone::OlsonDB::utc_datetime_for_time_spec( | ||||
182 | spec => $self->until_time_spec, | ||||
183 | year => $self->until_year, | ||||
184 | month => $self->until_month, | ||||
185 | day => $self->until_day, | ||||
186 | offset_from_utc => $self->offset_from_utc, | ||||
187 | offset_from_std => $offset_from_std, | ||||
188 | ); | ||||
189 | |||||
190 | return $utc; | ||||
191 | } | ||||
192 | |||||
193 | sub until_year { $_[0]->{until}[0] } | ||||
194 | |||||
195 | sub until_month { | ||||
196 | ( | ||||
197 | defined $_[0]->{until}[1] | ||||
198 | ? $DateTime::TimeZone::OlsonDB::MONTHS{ $_[0]->{until}[1] } | ||||
199 | : 1 | ||||
200 | ); | ||||
201 | } | ||||
202 | |||||
203 | sub until_day { | ||||
204 | ( | ||||
205 | defined $_[0]->{until}[2] | ||||
206 | ? DateTime::TimeZone::OlsonDB::parse_day_spec( | ||||
207 | $_[0]->{until}[2], $_[0]->until_month, $_[0]->until_year | ||||
208 | ) | ||||
209 | : 1 | ||||
210 | ); | ||||
211 | } | ||||
212 | |||||
213 | sub until_time_spec { | ||||
214 | defined $_[0]->{until}[3] ? $_[0]->{until}[3] : '00:00:00'; | ||||
215 | } | ||||
216 | |||||
217 | sub _first_rule { | ||||
218 | my $self = shift; | ||||
219 | my $last_offset_from_utc = shift; | ||||
220 | my $last_offset_from_std = shift; | ||||
221 | |||||
222 | return unless $self->rules; | ||||
223 | |||||
224 | my $date = $self->utc_start_datetime | ||||
225 | or return $self->_first_no_dst_rule; | ||||
226 | |||||
227 | my @rules = $self->rules; | ||||
228 | |||||
229 | my %possible_rules; | ||||
230 | |||||
231 | my $year = $date->year; | ||||
232 | foreach my $rule (@rules) { | ||||
233 | |||||
234 | # We need to look at what the year _would_ be if we added the | ||||
235 | # rule's offset to the UTC date. Otherwise we can end up with | ||||
236 | # a UTC date in year X, and a rule that starts in _local_ year | ||||
237 | # X + 1, where that rule really does apply to that UTC date. | ||||
238 | my $temp_year | ||||
239 | = $date->clone->add( | ||||
240 | seconds => $self->offset_from_utc + $rule->offset_from_std ) | ||||
241 | ->year; | ||||
242 | |||||
243 | # Save the highest value | ||||
244 | $year = $temp_year if $temp_year > $year; | ||||
245 | |||||
246 | next if $rule->min_year > $temp_year; | ||||
247 | |||||
248 | $possible_rules{$rule} = $rule; | ||||
249 | } | ||||
250 | |||||
251 | my $earliest_year = $year - 1; | ||||
252 | foreach my $rule (@rules) { | ||||
253 | $earliest_year = $rule->min_year | ||||
254 | if $rule->min_year < $earliest_year; | ||||
255 | } | ||||
256 | |||||
257 | # figure out what date each rule would start on _if_ that rule | ||||
258 | # were applied to this current observance. this could be a rule | ||||
259 | # that started much earlier, but is only now active because of an | ||||
260 | # observance switch. An obnoxious example of this is | ||||
261 | # America/Phoenix in 1944, which applies the US rule in April, | ||||
262 | # thus (re-)instating the "war time" rule from 1942. Can you say | ||||
263 | # ridiculous crack-smoking stupidity? | ||||
264 | my @rule_dates; | ||||
265 | foreach my $y ( $earliest_year .. $year ) { | ||||
266 | RULE: | ||||
267 | foreach my $rule ( values %possible_rules ) { | ||||
268 | |||||
269 | # skip rules that can't have applied the year before the | ||||
270 | # observance started. | ||||
271 | if ( $rule->min_year > $y ) { | ||||
272 | print "Skipping rule beginning in ", $rule->min_year, | ||||
273 | ". Year is $y.\n" | ||||
274 | if $DateTime::TimeZone::OlsonDB::DEBUG; | ||||
275 | |||||
276 | next RULE; | ||||
277 | } | ||||
278 | |||||
279 | if ( $rule->max_year && $rule->max_year < $y ) { | ||||
280 | print "Skipping rule ending in ", $rule->max_year, | ||||
281 | ". Year is $y.\n" | ||||
282 | if $DateTime::TimeZone::OlsonDB::DEBUG; | ||||
283 | |||||
284 | next RULE; | ||||
285 | } | ||||
286 | |||||
287 | my $rule_start = $rule->utc_start_datetime_for_year( $y, | ||||
288 | $last_offset_from_utc, $last_offset_from_std ); | ||||
289 | |||||
290 | push @rule_dates, [ $rule_start, $rule ]; | ||||
291 | } | ||||
292 | } | ||||
293 | |||||
294 | @rule_dates = sort { $a->[0] <=> $b->[0] } @rule_dates; | ||||
295 | |||||
296 | print "Looking for first rule ...\n" | ||||
297 | if $DateTime::TimeZone::OlsonDB::DEBUG; | ||||
298 | print " Observance starts: ", $date->datetime, "\n\n" | ||||
299 | if $DateTime::TimeZone::OlsonDB::DEBUG; | ||||
300 | |||||
301 | # ... look through the rules to see if any are still in | ||||
302 | # effect at the beginning of the observance | ||||
303 | for ( my $x = 0; $x < @rule_dates; $x++ ) { | ||||
304 | my ( $dt, $rule ) = @{ $rule_dates[$x] }; | ||||
305 | my ( $next_dt, $next_rule ) | ||||
306 | = $x < @rule_dates - 1 ? @{ $rule_dates[ $x + 1 ] } : undef; | ||||
307 | |||||
308 | next if $next_dt && $next_dt < $date; | ||||
309 | |||||
310 | print " This rule starts: ", $dt->datetime, "\n" | ||||
311 | if $DateTime::TimeZone::OlsonDB::DEBUG; | ||||
312 | |||||
313 | print " Next rule starts: ", $next_dt->datetime, "\n" | ||||
314 | if $next_dt && $DateTime::TimeZone::OlsonDB::DEBUG; | ||||
315 | |||||
316 | print " No next rule\n\n" | ||||
317 | if !$next_dt && $DateTime::TimeZone::OlsonDB::DEBUG; | ||||
318 | |||||
319 | if ( $dt <= $date ) { | ||||
320 | if ($next_dt) { | ||||
321 | return $rule if $date < $next_dt; | ||||
322 | return $next_rule if $date == $next_dt; | ||||
323 | } | ||||
324 | else { | ||||
325 | return $rule; | ||||
326 | } | ||||
327 | } | ||||
328 | } | ||||
329 | |||||
330 | # If this observance has rules, but the rules don't have any | ||||
331 | # defined changes until after the observance starts, we get the | ||||
332 | # earliest standard time rule and use it. If there is none, shit | ||||
333 | # blows up (but this is not the case for any time zones as of | ||||
334 | # 2009a). I really, really hate the Olson database a lot of the | ||||
335 | # time! Could this be more arbitrary? | ||||
336 | my $std_time_rule = $self->_first_no_dst_rule; | ||||
337 | |||||
338 | die | ||||
339 | "Cannot find a rule that applies to the observance's date range and cannot find a rule without DST to apply" | ||||
340 | unless $std_time_rule; | ||||
341 | |||||
342 | return $std_time_rule; | ||||
343 | } | ||||
344 | |||||
345 | sub _first_no_dst_rule { | ||||
346 | my $self = shift; | ||||
347 | |||||
348 | return first { !$_->offset_from_std } | ||||
349 | sort { $a->min_year <=> $b->min_year } $self->rules; | ||||
350 | } | ||||
351 | |||||
352 | 1 | 3µs | 1; |