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