1
# $Id: DST.pm,v 1.5 2006/02/15 19:54:02 mattiasholmlund Exp $
3
# Timezone stuff, including routines to guess timezones in European
4
# (and other) countries that have daylight saving time.
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.
13
use Date::Manip; # no Date_Init(), that can be done by the app
14
use XMLTV::TZ qw(gettz tz_to_num);
18
# eur (default): Europe and elsewhere
19
# na: US (most states) and Canada
20
# none: places that don't observe DST
24
# Use Log::TraceMessages if installed.
26
eval { require Log::TraceMessages };
32
*t = \&Log::TraceMessages::t;
33
*d = \&Log::TraceMessages::d;
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.
41
eval { require Memoize };
43
foreach (qw(parse_local_date date_to_local dst_dates
44
parse_date UnixDate DateCalc Date_Cmp
46
Memoize::memoize($_) or die "cannot memoize $_: $!";
51
our @EXPORT = qw(parse_local_date date_to_local utc_offset);
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.
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.
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.
71
# unparsed date from some country following EU DST conventions
72
# base timezone giving winter time in that country
74
# Returns: parsed date. Throws exception if error.
76
sub 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}$/ );
84
my $winter_tz = $base;
85
my $summer_tz = sprintf('%+05d', $winter_tz + 100); # 'one hour'
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).
93
# I don't remember the reason for this check... perhaps it is
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';
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.
106
# OK, the timezone is there and it looks sane, continue.
107
return parse_date($date);
110
t 'no timezone present, we need to guess';
111
my $dp = parse_date($date);
112
t "parsed date string $date into: " . d $dp;
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;
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)};
125
elsif ($Mode eq 'na') {
126
($start_dst, $end_dst) = @{dst_dates_na($year, $winter_tz)};
128
elsif ($Mode eq 'none') {
129
return Date_ConvTZ($dp, $winter_tz, 'UTC');
133
foreach ($start_dst, $end_dst) {
134
$_ = Date_ConvTZ($_, 'UTC', $winter_tz);
137
# The clocks shift backwards and forwards by one hour.
138
my $clock_shift = "1 hour";
140
# The times that the clocks go forward to in spring (local time)
141
my $start_dst_skipto = DateCalc($start_dst, "+ $clock_shift");
143
# The local time when the clocks go back
144
my $end_dst_backfrom = DateCalc($end_dst, "+ $clock_shift");
147
if (Date_Cmp($dp, $start_dst) < 0) {
148
# Before the start of summer time.
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.
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
166
elsif (Date_Cmp($dp, $end_dst) < 0) {
167
# During summer time.
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" );
178
# Definitely after the end of summer time.
183
t "summer time, converting $dp from $summer_tz to UTC";
184
return Date_ConvTZ($dp, $summer_tz, 'UTC');
187
t "winter time, converting $dp from $winter_tz to UTC";
188
return Date_ConvTZ($dp, $winter_tz, 'UTC');
195
# Take a date in UTC and convert it to one of two timezones, depending
196
# on when during the year it is.
199
# date in UTC (from parse_date())
200
# base timezone (winter time)
202
# Returns ref to list of
204
# timezone of new date
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.
210
sub 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/);
215
my $year = UnixDate($d, '%Y');
216
if ((not defined $year) or ($year !~ tr/0-9//)) {
217
croak "cannot get year from '$d'";
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)};
225
elsif ($Mode eq 'na') {
226
($start_dst, $end_dst) = @{dst_dates_na($year, $base_tz)};
228
elsif ($Mode eq 'none') {
229
return [ Date_ConvTZ($d, 'UTC', $base_tz), $base_tz ];
234
if (Date_Cmp($d, $start_dst) < 0) {
235
# Before the start of summer time.
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
247
die if not defined $use_tz;
248
return [ Date_ConvTZ($d, 'UTC', $use_tz), $use_tz ];
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.
261
sub 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}$/;
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];
274
# Return the dates (in UTC) when summer starts and ends in a given
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.
284
# Parameters: year (only 1998 or later works)
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)
291
die "usage: dst_dates(year), got args: @_" if @_ != 1;
293
die "don't know about DST before 1998" if $year < 1998;
295
my ($start_dst, $end_dst);
297
my $mar = "$year-03-$_" . ' 01:00';
298
my $mar_d = parse_date($mar);
299
$start_dst = $mar_d if UnixDate($mar_d, "%A") =~ /Sunday/;
301
# A time between '00:00' and '01:00' just before the last
302
# Sunday in October is ambiguous.
304
my $oct = "$year-10-$_" . ' 01:00';
305
my $oct_d = parse_date($oct);
306
$end_dst = $oct_d if UnixDate($oct_d, "%A") =~ /Sunday/;
308
die if not defined $start_dst or not defined $end_dst;
310
return [ $start_dst, $end_dst ];
313
sub 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
$winter_tz =~ /^\s*-\s*(\d\d)(?:00)?\s*$/
318
or die "bad North American winter time zone $winter_tz";
321
my ($start_dst, $end_dst);
323
if (not defined $start_dst and $_ < 31) {
324
my $date = "$year-04-$_";
325
my $day = UnixDate(parse_date($date), '%A');
326
if ($day =~ /Sunday/) {
327
# First Sunday in April. DST starts at 02:00 local
330
$start_dst = Date_ConvTZ(parse_date("$date 02:00"),
331
"-$winter_tz", 'UTC');
335
my $date = "$year-10-$_";
336
my $day = UnixDate(parse_date($date), '%A');
337
next unless $day =~ /Sunday/;
338
# A Sunday in October (and the last one we see will be the
339
# last Sunday). DST ends at 01:00 local standard time.
341
$end_dst = Date_ConvTZ(parse_date("$date 01:00"),
342
"-$winter_tz", 'UTC');
344
die if not defined $start_dst or not defined $end_dst;
346
return [ $start_dst, $end_dst ];
added
removed
xmltv/share/perl/5.8.8/XMLTV/DST.pm
