239 lines
8.2 KiB
Perl
239 lines
8.2 KiB
Perl
######################################################################
|
|
# Copyright (C) 1999-2001, International Business Machines
|
|
# Corporation and others. All Rights Reserved.
|
|
######################################################################
|
|
# See: ftp://elsie.nci.nih.gov/pub/tzdata<year>
|
|
# where <year> is "1999b" or a similar string.
|
|
######################################################################
|
|
# This package contains utility functions for time zone data.
|
|
# Author: Alan Liu
|
|
|
|
######################################################################
|
|
# Zones - A time zone object is a hash with the following keys:
|
|
# {gmtoff} The offset from GMT, e.g. "-5:00"
|
|
# {rule} The name of the rule, e.g. "-", "Canada", "EU", "US"
|
|
# {format} The local abbreviation, e.g. "E%sT"
|
|
# {until} Data is good until this year, e.g., "2000". Often blank.
|
|
|
|
# These correspond to file entries:
|
|
#|# Zone NAME GMTOFF RULES FORMAT [UNTIL]
|
|
#|Zone America/Montreal -4:54:16 - LMT 1884
|
|
#| -5:00 Mont E%sT
|
|
|
|
# Links come from the file entries:
|
|
#|# Link LINK-FROM LINK-TO
|
|
#|Link America/New_York EST5EDT
|
|
#|Link America/Chicago CST6CDT
|
|
# Link data is _not_ stored in the zone hash. Instead, links are
|
|
# kept in a separate hash and resolved after all zones are defined.
|
|
# In general, we ignore links, but they provide critical data when
|
|
# generating country information.
|
|
|
|
# The name of the zone itself is not kept in the zone object.
|
|
# Instead, zones are kept in a big hash. The keys are the names; the
|
|
# values are references to the zone objects. The big hash of all
|
|
# zones is referred to in all caps: %ZONES ($ZONES if it's a
|
|
# reference).
|
|
|
|
# Example: $ZONES->{"America/Los_Angeles"} =
|
|
# 'format' => 'P%sT'
|
|
# 'gmtoff' => '-8:00'
|
|
# 'rule' => 'US'
|
|
# 'until' => ''
|
|
|
|
######################################################################
|
|
# Rules - A time zone rule is an array with the following elements:
|
|
# [0] Onset rule
|
|
# [1] Cease rule
|
|
# [2] Encoded string
|
|
|
|
# The onset rule and cease rule have the same format. They are each
|
|
# references to a hash with keys:
|
|
# {from} Start year
|
|
# {to} End year, or "only" or "max"
|
|
# {type} Unknown, usually "-"
|
|
# {in} Month, 3 letters
|
|
# {on} Day specifier, e.g. "lastSun", "Sun>=1", "23"
|
|
# {at} Time, e.g. "2:00", "1:00u"
|
|
# {save} Amount of savings, for the onset; 0 for the cease
|
|
# {letter} Guess: the letter that goes into %s in the zone {format}
|
|
|
|
# These correspond to the file entries thus:
|
|
#|# Rule NAME FROM TO TYPE IN ON AT SAVE LETTER/S
|
|
#|Rule US 1942 only - Feb 9 2:00 1:00 W # War
|
|
#|Rule US 1945 only - Sep 30 2:00 0 S
|
|
#|Rule US 1967 max - Oct lastSun 2:00 0 S
|
|
#|Rule US 1967 1973 - Apr lastSun 2:00 1:00 D
|
|
#|Rule US 1974 only - Jan 6 2:00 1:00 D
|
|
#|Rule US 1975 only - Feb 23 2:00 1:00 D
|
|
#|Rule US 1976 1986 - Apr lastSun 2:00 1:00 D
|
|
#|Rule US 1987 max - Apr Sun>=1 2:00 1:00 D
|
|
|
|
# Entry [2], the encoded string, is used to see if two rules are the
|
|
# same. It consists of "[0]->{in},[0]->{on},[0]->{at},[0]->{save};
|
|
# [1]->{in},[1]->{on},[1]->{at}". Note that the separator between
|
|
# values is a comma, between onset and cease is a semicolon. Also
|
|
# note that the cease {save} is not used as this is always 0. The
|
|
# whole string is forced to lowercase.
|
|
|
|
# Rules don't contain their own name. Like zones, rules are kept in a
|
|
# big hash; the keys are the names, the values the references to the
|
|
# arrays. This hash of all rules is referred to in all caps, %RULES
|
|
# or for a reference, $RULES.
|
|
|
|
# Example: $RULES->{"US"} =
|
|
# 0 HASH(0x8fa03c)
|
|
# 'at' => '2:00'
|
|
# 'from' => 1987
|
|
# 'in' => 'Apr'
|
|
# 'letter' => 'D'
|
|
# 'on' => 'Sun>=1'
|
|
# 'save' => '1:00'
|
|
# 'to' => 'max'
|
|
# 'type' => '-'
|
|
# 1 HASH(0x8f9fc4)
|
|
# 'at' => '2:00'
|
|
# 'from' => 1967
|
|
# 'in' => 'Oct'
|
|
# 'letter' => 'S'
|
|
# 'on' => 'lastSun'
|
|
# 'save' => 0
|
|
# 'to' => 'max'
|
|
# 'type' => '-'
|
|
# 2 'apr,sun>=1,2:00,1:00;oct,lastsun,2:00'
|
|
|
|
package TZ;
|
|
use strict;
|
|
use Carp;
|
|
use vars qw(@ISA @EXPORT $VERSION $STANDARD);
|
|
require 'dumpvar.pl';
|
|
|
|
@ISA = qw(Exporter);
|
|
@EXPORT = qw(ZoneEquals
|
|
RuleEquals
|
|
ZoneCompare
|
|
RuleCompare
|
|
FormZoneEquivalencyGroups
|
|
ParseOffset
|
|
);
|
|
$VERSION = '0.1';
|
|
|
|
$STANDARD = '-'; # Name of the Standard Time rule
|
|
|
|
######################################################################
|
|
# Param: zone object (hash ref)
|
|
# Param: zone object (hash ref)
|
|
# Param: ref to hash of all rules
|
|
# Return: 0, -1, or 1
|
|
sub ZoneCompare {
|
|
my $z1 = shift;
|
|
my $z2 = shift;
|
|
my $RULES = shift;
|
|
|
|
($z1, $z2) = ($z1->{rule}, $z2->{rule});
|
|
|
|
return RuleCompare($RULES->{$z1}, $RULES->{$z2});
|
|
}
|
|
|
|
######################################################################
|
|
# Param: rule object (hash ref)
|
|
# Param: rule object (hash ref)
|
|
# Return: 0, -1, or 1
|
|
sub RuleCompare {
|
|
my $r1 = shift;
|
|
my $r2 = shift;
|
|
|
|
# Just compare the precomputed encoding strings.
|
|
# defined() catches undefined rules. The only undefined
|
|
# rule is $STANDARD; any others would be caught by
|
|
# Postprocess().
|
|
|
|
defined($r1)
|
|
? (defined($r2) ? ($r1->[2] cmp $r2->[2]) : 1)
|
|
: (defined($r2) ? -1 : 0);
|
|
|
|
# In theory, there's actually one more level of equivalency
|
|
# analysis we could do. This is to recognize that Sun >=1 is the
|
|
# same as First Sun. We don't do this yet, but it doesn't matter;
|
|
# such a date is always referred to as Sun>=1, never as firstSun.
|
|
}
|
|
|
|
######################################################################
|
|
# Param: zone object (hash ref)
|
|
# Param: zone object (hash ref)
|
|
# Param: ref to hash of all rules
|
|
# Return: true if two zones are equivalent
|
|
sub ZoneEquals {
|
|
ZoneCompare(@_) == 0;
|
|
}
|
|
|
|
######################################################################
|
|
# Param: rule object (hash ref)
|
|
# Param: rule object (hash ref)
|
|
# Return: true if two rules are equivalent
|
|
sub RuleEquals {
|
|
RuleCompare(@_) == 0;
|
|
}
|
|
|
|
######################################################################
|
|
# Given a hash of all zones and a hash of all rules, create a list
|
|
# of equivalency groups. These are groups of zones with the same
|
|
# offset and equivalent rules. Equivalency is tested with
|
|
# ZoneEquals and RuleEquals. The resultant equivalency list is an
|
|
# array of refs to groups. Each group is an array of one or more
|
|
# zone names.
|
|
# Param: IN ref to hash of all zones
|
|
# Param: IN ref to hash of all rules
|
|
# Param: OUT ref to array to receive group refs
|
|
sub FormZoneEquivalencyGroups {
|
|
my ($zones, $rules, $equiv) = @_;
|
|
|
|
# Group the zones by offset. This improves efficiency greatly;
|
|
# instead of an n^2 computation, we just need to do n^2 within
|
|
# each offset; a much smaller total number.
|
|
my %zones_by_offset;
|
|
foreach (keys %$zones) {
|
|
push @{$zones_by_offset{ParseOffset($zones->{$_}->{gmtoff})}}, $_;
|
|
}
|
|
|
|
# Find equivalent rules
|
|
foreach my $gmtoff (keys %zones_by_offset) {
|
|
# Make an array of equivalency groups
|
|
# (array of refs to array of names)
|
|
my @equiv;
|
|
foreach my $name1 (@{$zones_by_offset{$gmtoff}}) {
|
|
my $found = 0;
|
|
foreach my $group (@equiv) {
|
|
my $name2 = $group->[0];
|
|
if (ZoneEquals($zones->{$name1}, $zones->{$name2}, $rules)) {
|
|
push @$group, $name1;
|
|
$found = 1;
|
|
last;
|
|
}
|
|
}
|
|
if (!$found) {
|
|
my @newGroup = ( $name1 );
|
|
push @equiv, \@newGroup;
|
|
}
|
|
}
|
|
push @$equiv, @equiv;
|
|
}
|
|
}
|
|
|
|
######################################################################
|
|
# Parse an offset of the form d, d:dd, or d:dd:dd, or any of the above
|
|
# preceded by a '-'. Return the total number of seconds represented.
|
|
# Param: String
|
|
# Return: Integer number of seconds
|
|
sub ParseOffset {
|
|
local $_ = shift;
|
|
if (/^(-)?(\d{1,2})(:(\d\d))?(:(\d\d))?$/) {
|
|
# 1 2 3 4 5 6
|
|
my $a = (($2 * 60) + (defined $4?$4:0)) * 60 + (defined $6?$6:0);
|
|
$a = -$a if (defined $1 && $1 eq '-');
|
|
return $a;
|
|
} else {
|
|
confess "Cannot parse offset \"$_\"";
|
|
}
|
|
}
|