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