1# $Id: DST.pm,v 1.10 2010/03/28 04:40:09 knowledgejunkie Exp $
2#
3# Timezone stuff, including routines to guess timezones in European
4# (and other) countries that have daylight saving time.
5#
6# Warning: this might break if Date::Manip is initialized to some
7# timezone other than UTC: best to call Date_Init('TZ=+0000') first.
8#
9
10package XMLTV::DST;
11use strict;
12use Carp qw(croak);
13use Date::Manip; # no Date_Init(), that can be done by the app
14use XMLTV::TZ qw(gettz tz_to_num offset_to_gmt);
15use XMLTV::Date;
16
17# Three modes:
18#   eur (default): Europe and elsewhere
19#   na:            US (most states) and Canada
20#   none:          places that don't observe DST
21#
22our $Mode = 'eur';
23
24# Use Log::TraceMessages if installed.
25BEGIN {
26    eval { require Log::TraceMessages };
27    if ($@) {
28	*t = sub {};
29	*d = sub { '' };
30    }
31    else {
32	*t = \&Log::TraceMessages::t;
33	*d = \&Log::TraceMessages::d;
34    }
35}
36
37# Memoize some subroutines if possible.  FIXME commonize to
38# XMLTV::Memoize.  We are memoizing our own routines plus gettz() from
39# XMLTV::TZ, that too needs sorting out.
40#
41eval { require Memoize };
42unless ($@) {
43    foreach (qw(parse_local_date date_to_local dst_dates
44		parse_date UnixDate DateCalc Date_Cmp
45		gettz)) {
46	Memoize::memoize($_) or die "cannot memoize $_: $!";
47    }
48}
49
50use base 'Exporter';
51our @EXPORT = qw(parse_local_date date_to_local utc_offset);
52
53# parse_local_date()
54#
55# Wrapper for parse_date() that tries to guess what timezone a date is
56# in.  You must pass in the 'base' timezone as the second argument:
57# this base timezone gives winter time, and summer time is one hour
58# ahead.  So the base will be UTC for Britain, Ireland and Portugal,
59# UTC+1 for many other countries.
60#
61# If the date already has a timezone it is left alone, but undef is
62# returned if the explicit timezone doesn't match winter or
63# summer time for the base passed in.
64#
65# The switchover from winter to summer time gives a one hour window of
66# 'impossible' times when the clock goes forward; those give undef.
67# Putting the clocks back in autumn gives one hour of ambiguous times;
68# we assume summer time for those.
69#
70# Parameters:
71#   unparsed date from some country following EU DST conventions
72#   base timezone giving winter time in that country
73#
74# Returns: parsed date.  Throws exception if error.
75#
76sub parse_local_date($$) {
77#    local $Log::TraceMessages::On = 1;
78    my ($date, $base) = @_;
79    croak 'usage: parse_local_date(unparsed date, base timeoffset)'
80      if @_ != 2 or not defined $date or not defined $base;
81    croak 'second parameter must be a time offset (+xxxx,-xxxx)'
82      if( $base !~ /^[-+]\d{4}$/ );
83
84    my $winter_tz = $base;
85    my $summer_tz = sprintf('%+05d', $winter_tz + 100); # 'one hour'
86
87    my $got_tz = gettz($date);
88#    t "got timezone $got_tz from date $date";
89    if (defined $got_tz) {
90	# Need to work out whether the timezone is one of the two
91	# allowable values (or UTC, that's always okay).
92	#
93	# I don't remember the reason for this check... perhaps it is
94	# just paranoia.
95	#
96	my $got_tz_num = tz_to_num($got_tz);
97	croak "got timezone $got_tz from $date, but it's not $winter_tz, $summer_tz or UTC\n"
98	    if $got_tz_num ne $winter_tz and $got_tz_num ne $summer_tz
99	      and $got_tz_num ne '+0000';
100
101	# One thing we don't check is that the explicit timezone makes
102	# sense for this time of year.  So you can specify summer
103	# time even in January if you want.
104	#
105
106	# OK, the timezone is there and it looks sane, continue.
107	return parse_date($date);
108    }
109
110    t 'no timezone present, we need to guess';
111    my $dp = parse_date($date);
112    t "parsed date string $date into: " . d $dp;
113
114    # Start and end of summer time in that year, in UTC
115    my $year = UnixDate($dp, '%Y');
116    t "year of date is $year";
117    die "cannot convert Date::Manip object $dp to year"
118      if not defined $year;
119
120    # Start and end dates of DST in local winter time.
121    my ($start_dst, $end_dst);
122    if ($Mode eq 'eur') {
123	($start_dst, $end_dst) = @{dst_dates($year)};
124    }
125    elsif ($Mode eq 'na') {
126	($start_dst, $end_dst) = @{dst_dates_na($year, $winter_tz)};
127    }
128    elsif ($Mode eq 'none') {
129	return Date_ConvTZ($dp, offset_to_gmt($winter_tz), 'UTC');
130    }
131    else { die }
132
133    foreach ($start_dst, $end_dst) {
134	$_ = Date_ConvTZ($_, 'UTC', offset_to_gmt($winter_tz));
135    }
136
137    # The clocks shift backwards and forwards by one hour.
138    my $clock_shift = "1 hour";
139
140    # The times that the clocks go forward to in spring (local time)
141    my $start_dst_skipto = DateCalc($start_dst, "+ $clock_shift");
142
143    # The local time when the clocks go back
144    my $end_dst_backfrom = DateCalc($end_dst, "+ $clock_shift");
145
146    my $summer;
147    if (Date_Cmp($dp, $start_dst) < 0) {
148	# Before the start of summer time.
149	$summer = 0;
150    }
151    elsif (Date_Cmp($dp, $start_dst) == 0) {
152	# Exactly _at_ the start of summer time.  Really such a date
153	# should not exist since the clocks skip forward an hour at
154	# that point.  But we tolerate this fencepost error.
155	#
156	$summer = 0;
157    }
158    elsif (Date_Cmp($dp, $start_dst_skipto) < 0) {
159	# This date is impossible, since the clocks skip forwards an
160	# hour from $start_dst to $start_dst_skipto.  But some
161	# listings sources seem to use it.  Assume it means winter
162	# time.
163	#
164	$summer = 0;
165    }
166    elsif (Date_Cmp($dp, $end_dst) < 0) {
167	# During summer time.
168	$summer = 1;
169    }
170    elsif (Date_Cmp($dp, $end_dst_backfrom) < 0) {
171#	warn("$date is ambiguous "
172#	     . "(clocks go back from $end_dst_backfrom $summer_tz to $end_dst $winter_tz), "
173#	     . "assuming $summer_tz" );
174
175	$summer = 1;
176    }
177    else {
178	# Definitely after the end of summer time.
179	$summer = 0;
180    }
181
182    if ($summer) {
183	t "summer time, converting $dp from $summer_tz to UTC";
184	return Date_ConvTZ($dp, offset_to_gmt($summer_tz), 'UTC');
185    }
186    else {
187	t "winter time, converting $dp from $winter_tz to UTC";
188	return Date_ConvTZ($dp, offset_to_gmt($winter_tz), 'UTC');
189    }
190}
191
192
193# date_to_local()
194#
195# Take a date in UTC and convert it to one of two timezones, depending
196# on when during the year it is.
197#
198# Parameters:
199#   date in UTC (from parse_date())
200#   base timezone (winter time)
201#
202# Returns ref to list of
203#   new date
204#   timezone of new date
205#
206# For example, date_to_local with a date of 13:00 on June 10th 2000 and
207# a base timezone of UTC would be be 14:00 +0100 on the same day.  The
208# input and output date are both in Date::Manip internal format.
209#
210sub date_to_local( $$ ) {
211    my ($d, $base_tz) = @_;
212    croak 'date_to_local() expects a Date::Manip object as first argument'
213      if (not defined $d) or ($d !~ /\S/);
214
215    my $year = UnixDate($d, '%Y');
216    if ((not defined $year) or ($year !~ tr/0-9//)) {
217	croak "cannot get year from '$d'";
218    }
219
220    # Find the start and end dates of summer time.
221    my ($start_dst, $end_dst);
222    if ($Mode eq 'eur') {
223	($start_dst, $end_dst) = @{dst_dates($year)};
224    }
225    elsif ($Mode eq 'na') {
226	($start_dst, $end_dst) = @{dst_dates_na($year, $base_tz)};
227    }
228    elsif ($Mode eq 'none') {
229	return [ Date_ConvTZ($d, 'UTC', offset_to_gmt($base_tz)), $base_tz ];
230    }
231    else { die }
232
233    my $use_tz;
234    if (Date_Cmp($d, $start_dst) < 0) {
235	# Before the start of summer time.
236	$use_tz = $base_tz;
237    }
238    elsif (Date_Cmp($d, $end_dst) < 0) {
239	# During summer time.
240	my $base_tz_num = tz_to_num($base_tz);
241	$use_tz = sprintf('%+05d', $base_tz_num + 100); # one hour
242    }
243    else {
244	# After summer time.
245	$use_tz = $base_tz;
246    }
247    die if not defined $use_tz;
248    return [ Date_ConvTZ($d, 'UTC', offset_to_gmt($use_tz)), $use_tz ];
249}
250
251# utc_offset()
252#
253# Given a date/time string in a parse_date() compatible format
254# (preferably YYYYMMDDhhmmss) and a 'base' timezone (eg '+0100'),
255# return this time string with UTC offset appended. The 'base'
256# timezone should be the non-DST timezone for the country ('winter
257# time'). This function figures out (through parse_local_date() and
258# date_to_local()) whether DST is in effect for the specified date, and
259# adjusts the UTC offset appropriately.
260#
261sub utc_offset( $$ ) {
262    my ($indate, $basetz) = @_;
263    croak "empty date" if not defined $indate;
264    croak "empty base TZ" if not defined $basetz;
265    $basetz = tz_to_num( $basetz )
266      if $basetz !~ /^[-+]\d{4}$/;
267
268    my $d = date_to_local(parse_local_date($indate, $basetz), $basetz);
269    return UnixDate($d->[0],"%Y%m%d%H%M%S") . " " . $d->[1];
270}
271
272# dst_dates()
273#
274# Return the dates (in UTC) when summer starts and ends in a given
275# year.  Private.
276#
277# According to <http://www.rog.nmm.ac.uk/leaflets/summer/summer.html>,
278# summer time starts at 01:00 on the last Sunday in March, and ends at
279# 01:00 on the last Sunday in October.  That's 01:00 UTC in both
280# cases, irrespective of what the winter and summer timezones are.
281# This has been the case throughout the European Union since 1998, and
282# some other countries such as Norway follow the same rules.
283#
284# Parameters: year (only 1998 or later works)
285#
286# Returns: ref to list of
287#   start time and date of summer time (in UTC)
288#   end time and date of summer time (in UTC)
289#
290sub dst_dates( $ ) {
291    die "usage: dst_dates(year), got args: @_" if @_ != 1;
292    my $year = shift;
293    die "don't know about DST before 1998" if $year < 1998;
294
295    my ($start_dst, $end_dst);
296    foreach (25 .. 31) {
297	my $mar = "$year-03-$_" . ' 01:00:00 +0000';
298	my $mar_d = parse_date($mar);
299	$start_dst = $mar_d if UnixDate($mar_d, "%A") =~ /Sunday/;
300
301	# A time between '00:00' and '01:00' just before the last
302	# Sunday in October is ambiguous.
303	#
304	my $oct = "$year-10-$_" . ' 01:00:00 +0000';
305	my $oct_d = parse_date($oct);
306	$end_dst = $oct_d if UnixDate($oct_d, "%A") =~ /Sunday/;
307    }
308    die if not defined $start_dst or not defined $end_dst;
309
310    return [ $start_dst, $end_dst ];
311}
312
313sub dst_dates_na( $$ ) {
314    die "usage: dst_dates(year, winter_tz), got args: @_" if @_ != 2;
315    my ($year, $winter_tz) = @_;
316    die "don't know about DST before 1988" if $year < 1988;
317    return dst_dates_na_old($year, $winter_tz) if $year < 2007;
318    return dst_dates_na_new($year, $winter_tz);
319}
320
321# Old North American daylight saving time, used before 2007.
322sub dst_dates_na_old( $$ ) {
323    my ($year, $winter_tz) = @_;
324    $winter_tz =~ /^\s*-\s*(\d\d)(?:00)?\s*$/
325      or die "bad North American winter time zone $winter_tz";
326    my $hours = $1;
327
328    my ($start_dst, $end_dst);
329    foreach (1 .. 31) {
330	if (not defined $start_dst and $_ < 31) {
331	    my $date = "$year-04-$_";
332	    my $day = UnixDate(parse_date($date), '%A');
333	    if ($day =~ /Sunday/) {
334		# First Sunday in April.  DST starts at 02:00 local
335		# standard time.
336		#
337		$start_dst = Date_ConvTZ(parse_date("$date 02:00"),
338					 offset("-$winter_tz"), 'UTC');
339	    }
340	}
341
342	my $date = "$year-10-$_";
343	my $day = UnixDate(parse_date($date), '%A');
344	next unless $day =~ /Sunday/;
345	# A Sunday in October (and the last one we see will be the
346	# last Sunday).  DST ends at 01:00 local standard time.
347	#
348	$end_dst = Date_ConvTZ(parse_date("$date 01:00"),
349			       offset_to_gmt("-$winter_tz"), 'UTC');
350    }
351    die if not defined $start_dst or not defined $end_dst;
352
353    return [ $start_dst, $end_dst ];
354}
355
356# New US daylight saving time from 2007, also followed by most
357# Canadian provinces.
358#
359sub dst_dates_na_new( $$ ) {
360    my ($year, $winter_tz) = @_;
361    $winter_tz =~ /^\s*-\s*(\d\d)(?:00)?\s*$/
362      or die "bad North American winter time zone $winter_tz";
363    my $hours = $1;
364
365    my ($start_dst, $end_dst);
366    my $seen_Sunday_in_March = 0;
367    foreach (1 .. 31) {
368	if (not defined $start_dst) {
369	    my $date = "$year-03-$_";
370	    my $day = UnixDate(parse_date($date), '%A');
371	    if ($day =~ /Sunday/) {
372		if ($seen_Sunday_in_March) {
373		    # Second Sunday in March.  DST starts at 02:00
374		    # local standard time.
375		    #
376		    $start_dst = Date_ConvTZ(parse_date("$date 02:00"),
377					     offset_to_gmt("-$winter_tz"), 'UTC');
378		}
379		else {
380		    $seen_Sunday_in_March = 1;
381		}
382	    }
383	}
384
385	next if defined $end_dst;
386	my $date = "$year-11-$_";
387	my $day = UnixDate(parse_date($date), '%A');
388	next unless $day =~ /Sunday/;
389	# A Sunday in November (and the first one we see).  DST ends
390	# at 01:00 local standard time.
391	#
392	$end_dst = Date_ConvTZ(parse_date("$date 01:00"),
393			       offset_to_gmt("-$winter_tz"), 'UTC');
394    }
395    die if not defined $start_dst or not defined $end_dst;
396
397    return [ $start_dst, $end_dst ];
398}
399
400
4011;
402