1# Miscellaneous timezone routines. The code in DST.pm builds on 2# these for handling summer time conventions. This should 3# probably be moved into Date::Manip somehow. 4# 5# $Id: TZ.pm,v 1.19 2015/07/12 00:59:01 knowledgejunkie Exp $ 6# 7 8package XMLTV::TZ; 9use Carp; 10use Date::Manip; # no Date_Init(), that can be done by the app 11use XMLTV::Date; 12# Won't Memoize, you can do that yourself. 13use base 'Exporter'; our @EXPORT_OK; 14@EXPORT_OK = qw(gettz ParseDate_PreservingTZ tz_to_num parse_local_date offset_to_gmt); 15 16# Use Log::TraceMessages if installed. 17BEGIN { 18 eval { require Log::TraceMessages }; 19 if ($@) { 20 *t = sub {}; 21 *d = sub { '' }; 22 } 23 else { 24 *t = \&Log::TraceMessages::t; 25 *d = \&Log::TraceMessages::d; 26 } 27} 28 29 30# gettz() 31# 32# Parameters: unparsed date string 33# Returns: timezone (a substring), or undef 34# 35# We just pick up anything that looks like a timezone. 36# 37sub gettz($) { 38 croak 'usage: gettz(unparsed date string)' if @_ != 1; 39 local $_ = shift; 40 croak 'undef argument to gettz()' if not defined; 41 42 /\s([A-Z]{1,4})$/ && return $1; 43 /\s([+-]\d\d:?(\d\d)?)$/ && return $1; 44 return undef; 45} 46 47 48# ParseDate_PreservingTZ() 49# 50# A wrapper for Date::Manip's ParseDate() that makes sure the date is 51# stored in the timezone it was given in. That's helpful when you 52# want to produce human-readable output and the user expects to see 53# the same timezone going out as went in. 54# 55sub ParseDate_PreservingTZ($) { 56 croak 'usage: ParseDate_PreservingTZ(unparsed date string)' 57 if @_ != 1; 58 my $u = shift; 59 my $p = ParseDate($u); 60 die "cannot parse $u" if not $p; 61 my $tz = gettz($u) || 'UTC'; 62 63 my $ltz=Date_TimeZone(); # avoid bug in Date::Manip 6.05 64 $ltz=$tz if $ltz eq "1"; # if Date_TimeZone returns a bad value, use something ok 65 66# print STDERR "date $u parsed to $p (timezone read as $tz)\n"; 67 $p = Date_ConvTZ($p, offset_to_gmt($ltz), offset_to_gmt($tz)); 68# print STDERR "...converted to $p\n"; 69 return $p; 70} 71 72# Date::Manip version 6 has problems with +nnnn offsets 73# It seems to treat +0000 as equivalent to "Europe/London", meaning that during DST +0000 actually refers to GMT + 1 hour. 74# However, a timezone of etc/gmt+1 will always work. 75# Using this function on arguments to Date_ConvTZ should work around this bug. 76sub offset_to_gmt($) { 77 my $tz = shift; 78 79 return $tz unless $tz =~ /^([+-])0(\d)00/; 80 81 if ($Date::Manip::VERSION >= 6) { 82 if ($2 == 0) { 83 $tz = "etc/gmt"; 84 } else { 85 $tz = "etc/gmt$1$2"; 86 } 87 } 88 return $tz; 89} 90 91 92# tz_to_num() 93# 94# Turn a timezone string into a numeric form. For example turns 'CET' 95# into '+0100'. If the timezone is already numeric it's unchanged. 96# 97# Throws an exception if the timezone is not recognized. 98# 99sub tz_to_num( $ ) { 100 my $tz = shift; 101 102 # It should be possible to use numeric timezones and have them 103 # come out unchanged. But due to a bug in Date::Manip, '+0100' is 104 # treated as equivalent to 'UTC' by (WTF?) and we have to 105 # special-case numeric timezones. 106 # 107 return $tz if $tz =~ /^[+-]?\d\d:?(?:\d\d)?$/; 108 109 # To convert to a number we parse a date with this timezone and 110 # then compare against the same date with UTC. 111 # 112 my $date_str = '2000-08-01 00:00:00'; # arbitrary 113 my $base = parse_date("$date_str UTC"); 114 t "parsed '$date_str UTC' as $base"; 115 my $d = parse_date("$date_str $tz"); 116 t "parsed '$date_str $tz' as $d"; 117 my $err; 118 my $delta = DateCalc($d, $base, \$err); 119 die "error code from DateCalc: $err" if defined $err; 120 121 # A timezone difference must be less than one day, and must be a 122 # whole number of minutes. 123 # 124 my @df = Delta_Format($delta, 0, "%hv", "%Mv"); 125 return sprintf('%s%02d%02d', ($df[0] < 0) ? '-' : '+', abs($df[0]), $df[1]); 126} 127 128 129# Date::Manip seems to have difficulty with changes of timezone: if 130# you parse some dates in a local timezone then do 131# Date_Init('TZ=UTC'), the existing dates are not changed, so 132# comparisons with later parsed dates (in UTC) will be wrong. Script 133# to reproduce the bug: 134# 135# #!/usr/local/bin/perl -w 136# use Date::Manip; 137# # First parse a date in the timezone +0100. 138# Date_Init('TZ=+0100'); 139# my $a = ParseDate('2000-01-01 00:00:00'); 140# # Now parse another one, in timezone +0000. 141# Date_Init('TZ=+0000'); 142# my $b = ParseDate('2000-01-01 00:00:00'); 143# # The two dates should differ by one hour. 144# print Date_Cmp($a, $b), "\n"; 145# 146# The script should print -1 but it prints 0. 147# 148# NB, use this function _before_ changing the default timezone to UTC, 149# if you want to parse some dates in the user's local timezone! 150# 151# Throws an exception on error. 152# 153sub parse_local_date( $ ) { 154 my $d = shift; 155# local $Log::TraceMessages::On = 1; 156 t 'parse_local_date() parsing: ' . d $d; 157 my $pd = ParseDate($d); 158 t 'ParseDate() returned: ' . d $pd; 159 die "cannot parse date $d" if not $pd; 160 my $r = Date_ConvTZ($pd, offset_to_gmt(Date_TimeZone()), 'UTC'); 161 t 'converted into UTC: ' . d $r; 162 return $r; 163} 164 1651; 166