KRL!V.9]N3WP$M>`*0:V'X<[)\(:L?4]L]6"4YD tzdata93c.tar.Z
F!]4&XCG:R-_O+ZK$MR?28(NFZ0Q.J6[1*A8>,}D\#\
G}?XMB,""B8"7.$MC3Q_D1X8&OXI]DNMTI@(`C5$':$ tzdata93d.tar.Z
L4AXY>[::W7`N%_X8'>@?6}L13GJ/NB50G"0FS}%G@-XUJ?.]F8>}!IG[V)<
-V/('@H\4`DWY;UM"&}$J,SDDHS@DD_-Y\!!,$WP";< tzdata93f.tar.Z
V/,C#A;3+F%HL-$&KF0W$K^`B+LK6/"XWQ8YJR]!>AD
_[WT"BS['40P#PD>P3ZM"'$\+WF-?6[*U'\N;9B1H2$ tzdata93g.tar.gz
TWT\F"YH+HL1\6L%(.\)2XAPG#J0W5EPD1W>TTQ@&64
Q#I"WP\@Z48F5`:#C9ZBTT tzdata94a.tar.gz
V3X"B/MQ>V+Z^P]\LRGIZ0@AZSG&8HBIR@$K6"RT7F8
H?:Y(+Z!6_-MZ!_MY@%0O6W,A-R>$/PYP}\*'2WQ>U0 tzdata94b.tar.gz
4Q5*'`0U7[8T'PB!ZK0TLQF"A8D>(2@U+0\\
HJI9PL[@OZ(PACO-DE%D9+P>IP27ZT[ADI^A*&.`[;$ tzdata94d.tar.gz
!&26XQE}R73F;Z+N^EZ6[WF'Z99']C}/[,+<9-46(2(O]QPH}2\7O1_B0CZH8 tzdata94e.tar.gz
N@[B'6*E*#`_S?V\9H'@KCL/-"X2@-_T4BB_$ZF92LD
&E_U6&'R'G;/96WT<%@}>B>}9P)E-$WF2Q$U*^NV^W0 tzdata94f.tar.gz
\S"*"*"]S*(4J*?0`!?JK*J3VB$K>:H'*3I+B2,/,/<
\HFZD[/9S\^0"^>;YX:}VM'@6V'<+G'?3T7B@8"GI>, tzdata94h.tar.gz
Q%}QNT@"/22*!A*Q_N8:89!B2}RN_$OG\/G)DD.[J#[^0[C*%&LV5,(`R^-[?M;@JCS\( tzdata95d.tar.gz
/6U6ZXX(+>?\U03Z9}:-7"!L^>MEIK7)'9C5HH(WSW`
UK10ZN/RN8-;Y,;"E1"1#PGX&0HM]PDHJ/U#, tzdata95f.tar.gz
G/2,5}W49@O:M}9(A#N3FT6-<**<")+G.<9@Y!;V!B\
-ENM9%.#MB3?+1&68?/K//E7ZH^CUN<4B45(LNG5;?\ tzdata95g.tar.gz
L9}F1W`&)"$P@T&SBE2T*DFK.;&8>,M/"-BS:YD:#`0
E@B_'/TXJ);[-4/'>CZG&EM;@$M_E2>'CHQC:?/QMWX tzdata95h.tar.gz
/U5IZ<;%-%/U0<3P^3(5M2BVT7\I#C45MES$S#KX^%\
:Y/7DH,A]95[+ZA9O#]&Y&BMV]"37)%(N/Y9G%0EV}L tzdata95k.tar.gz
G8T8F^UF`0M!R6LW3KR;}+^&G^KKZI4P,.]#D$5]6X@
2%^`'Y'VSV0/<<&?3W9074X%$*9:<^(#2*]S8UI>&7X tzdata95l.tar.gz
'F$H':/>%]H>`OD"!3N.:6\\,V}IO.@&`3:I!2N:H`D
'7_L@ tzdata95m.tar.gz
&.W1T1O<\(IUQ$;3%]#N5OR4%2CBS((Q+%2W9WBA)RT
H2",;_G2S,IK6S/:9Z@5SQOC>35#};%\H0\(QZX3E7X tzdata96a.tar.gz
;[5--'"@UVZ<6_7R2'69K9]LI^_NKK$Z7'?[?D)J"0\
IYG-A$2V]JTJ4^.199<0M86/'#2_%F.1!&%}4A"?2Z$ tzdata96b.tar.gz
OH08*[]G6C7"1+()`Y$>W6}4}_>*A^}:;F]>^R!9^I(
$A'.>.)S}"N^:S}Z:/00BM8'90_MHJ*D^QIAYVV_;3\ tzdata96c.tar.gz
QB,?UNF6I/Y3#3+;P6.>6-@H_"Y*]/#4`;>CW_I<:SH
%M}$M):,^\^?Z[4,;_JH>SN+#H_<5,}^*!"H+XEEA`D tzdata96d.tar.gz
#O,UW,"*#<15#()N,GQC_/Y9O/L`J*:@8K,)V>@ tzdata96e.tar.gz
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ tzdata96f.tar.gz
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ tzdata96g.tar.gz
._'Q1`S6W[R?9_ZX1*JPC\TW,O5CW^DE"%YZ`6,:]/T
"+M_K7?DY5;W//<.`D}"/V;Z7_.??E\559ME4;1+(WH tzdata96h.tar.gz
^5CS5<:'C?A'@"FA&EC'UJUN.,MD?Z5WP;A@ZA(/RG4
FW'}]S6G:+FDJ"QZJ<}/0FC[RY^?ZQGKXY8OWE&P3%T tzdata96i.tar.gz
FD'\3M:VB7HFI+JI;(LKG^FYW6@W)IW'1+S-I-E)944
'99V)&RW@>Z!4WB6N[`2!I64*`#DIN.?VO9P!2JAG>$ tzdata96k.tar.gz
?&*!2]H`X6N>54;SG#YC#IF&4**`'5NIX4EV*%E>(2`
6:CTF"UF/}I<`(QMUXUB{$canonname};
defined $rh or die "attempt to check SHA-512 of unknown file\n";
if($rh ne "") {
my $ch = filter("", "sha512sum",
$self->{top_dir}."/".$localname);
$ch =~ /\A([0-9a-f]{128})\ +[!-~]+\n\z/
or die "bizarre output from sha512sum\n";
pack("H*", $1) eq $rh or die "SHA-512 hash mismatch\n";
}
}
sub _init_ftp($$) {
my($self, $hostname) = @_;
$self->{ftp_hostname} = $hostname;
$self->{ftp} = Net::FTP->new($hostname)
or die "FTP error on $hostname: $@\n";
}
sub _ftp_op($$@) {
my($self, $method, @args) = @_;
$self->{ftp}->$method(@args)
or die "FTP error on @{[$self->{ftp_hostname}]}: ".
$self->{ftp}->message;
}
sub _ftp_login($$$) {
my($self, $hostname, $dirarray) = @_;
_init_ftp($self, $hostname);
_ftp_op($self, "login", "anonymous","-anonymous\@");
_ftp_op($self, "binary");
_ftp_op($self, "cwd", $_) foreach @$dirarray;
}
sub _ensure_ftp($) {
my($self) = @_;
unless($self->{ftp}) {
# Always use IANA master. Could possibly look at mirrors,
# but the IANA site is probably reliable enough.
_ftp_login($self, "ftp.iana.org", ["tz", "releases"]);
}
}
sub _cmp_version($$) {
my($a, $b) = @_;
$a = "19".$a if $a =~ /\A[0-9]{2}(?:[a-z][23]?)?\z/;
$b = "19".$b if $b =~ /\A[0-9]{2}(?:[a-z][23]?)?\z/;
return $a cmp $b;
}
sub _ge_version($$) { _cmp_version($_[0], $_[1]) >= 0 }
my $split_rels = q(
93 AA -b cc dd ee ff gg
94 -a bb c- dd e- f- g- -e -f hh
95 bb c- -c -d -e -f -g d- -h -i e- fj gk hl im
96 aa b- c- -b dc e- -d -e -f fg -h g- h- -i i- j- kk l-
1996 ml -m n- on
1997 aa bb -c cd de ef fg gh -i hj ik
1998 aa bb cc dd ee f- -f -g gh hi
1999 aa bb cc dd ee ff gg -h hi ij
2000 aa bb cc -d d- ee ff gg hh
2001 aa bb cc dd
2002 aa bb cc dd
2003 aa bb cc dd ee
2004 aa bb c- -d d- ee f- gg h- i-
2005 aa bb cc d- ee ff gg hh -i jj kk ll mm nn oo pp qq rr
2006 aa bb cc dd ee ff gg h- i- jj kk -l mm nn oo pp
2007 aa bb cc dd ee ff gg hh -i jj kk
2008 aa -b -c -d ee -f gg hh -i
2009 aa bb -c dd ee -f -g hh ii -j kk -l -m -n -o -p qq rr -s tt -u
2010 -a -b a- cc -d -e ff -g -h -i jj kk ll mm nn -o
2011 aa bb cc dd ee -f gg -h ii -j -k -l -m -n
2012 aa bb -c cd ee ff gg hh ii jj
2013 aa bb cc dd ee ff gg hh ii
2014 aa bb cc dd ee ff gg hh ii jj
2015 aa bb cc dd ee ff gg
2016 aa bb cc dd ee ff
);
sub _split_rel_versions($) {
my($version) = @_;
unless(ref $split_rels) {
my(%sr, $year, $cver, $dver, $lastver, $lastnum);
$lastver = "";
foreach(split(" ", $split_rels)) {
if(/\A[0-9]/) {
$year = $_;
} else {
my($cl, $dl) = (/\A(.)(.)\z/s);
$cver = $year.($cl eq "A" ? "" : $cl)
unless $cl eq "-";
$dver = $year.($dl eq "A" ? "" : $dl)
unless $dl eq "-";
my $ver = _ge_version($cver, $dver) ?
$cver : $dver;
if($ver eq $lastver) {
$lastnum++;
$ver .= $lastnum;
} else {
$lastver = $ver;
$lastnum = 1;
}
$sr{$ver} = [ $cver, $dver ];
}
}
$split_rels = \%sr;
}
my $cdv = $split_rels->{$version};
defined $cdv or die "no such Olson DB version `$version'\n";
return $cdv;
}
sub _latest_version($) {
my($self) = @_;
my $latest;
_ensure_ftp($self);
foreach(@{
_ftp_op($self, "ls", "tzdb-[0-9][0-9][0-9][0-9][a-z].tar.lz")
}) {
if(m#(?:\A|/)tzdb-([0-9]{4}[a-z])\.tar\.lz\z#) {
next unless _ge_version($1, "2016g");
$latest = $1
if !defined($latest) ||
_ge_version($1, $latest);
}
}
unless(defined $latest) {
die "no current timezone database found on ".
"@{[$self->{ftp_hostname}]}\n";
}
return $latest;
}
=head1 CLASS METHODS
=over
=item Time::OlsonTZ::Download->latest_version
Returns the version number of the latest available version of the Olson
timezone database. This requires consulting the repository, but is much
cheaper than actually downloading the database.
=cut
sub latest_version {
my($class) = @_;
croak "@{[__PACKAGE__]}->latest_version not called as a class method"
unless is_string($class);
return _latest_version({});
}
=back
=cut
sub DESTROY {
my($self) = @_;
local($., $@, $!, $^E, $?);
rmtree($self->{top_dir}, 0, 0) if exists $self->{top_dir};
}
=head1 CONSTRUCTORS
=over
=item Time::OlsonTZ::Download->new([VERSION])
Downloads a copy of the source of the Olson database, and returns an
object representing that copy.
I, if supplied, is a version number specifying which version of
the database is to be downloaded. If not supplied, the latest available
version will be downloaded. Version numbers for the Olson database
currently consist of a year number and a lowercase letter, such as
"C<2010k>". The letter advances with each release in a year.
Historical vesrions make the version numbers a bit more complicated.
Prior to late 1996 the century portion of the year number was omitted,
giving version numbers such as "C<96g>". Prior to 1994 the first release
of each year omitted the letter "C", giving version numbers such as
"C<93>" (with the second release of the year being "C<93b>").
From 1993 to to late 2012 the database was split into `code' and `data'
parts that could each be released without releasing a new version of the
other part. Each part had its own version number, sometimes advancing
independently of each other, and sometimes skipping sequence letters
in order to catch up with the other part. Where the two parts of some
version of the database have different version numbers, the version
number of the database as a whole is whichever part's version number
is higher. If this would give two database versions the same number,
due to multiple releases of one part happening while the other part has
a higher version number, a digit "C<2>" or "C<3>" is appended after the
letter to distinguish the second and third such versions.
This module does not currently support downloading database versions
earlier than version 93. One can expect to successfully download most
versions from then on, but a handful are missing from the public archive.
The public archive is complete from version 2006f onwards. Details of
historical version availability may change in future.
=cut
sub _download_file($$$$$) {
my($self, $remote_name, $local_name, $with_sig, $enoent) = @_;
my $tdir = $self->{top_dir};
_ensure_ftp($self);
@{$self->_ftp_op("ls", $remote_name)} or $enoent->();
$self->_ftp_op("get", $remote_name, "$tdir/$local_name");
if($with_sig) {
$self->_ftp_op("get", "$remote_name.asc",
"$tdir/$local_name.asc");
}
}
sub new {
my($class, $version) = @_;
die "malformed Olson version number `$version'\n"
unless is_undef($version) ||
(is_string($version) &&
$version =~ /\A[0-9]{2}(?:[0-9]{2})?
(?:[a-z][23]?)?\z/x);
my $self = bless({}, $class);
$version ||= $self->_latest_version;
$self->{version} = $version;
my $tdir = tempdir();
$self->{top_dir} = $tdir;
$self->{olson_dir} = "$tdir/c";
filter("", "mkdir", $self->{olson_dir});
if(_ge_version($version, "2016g")) {
$self->{code_version} = $version;
$self->{data_version} = $version;
_download_file($self, "tzdb-$version.tar.lz", "tzdb.tar.lz", 1,
sub () { die "no such Olson DB version `$version'\n" });
_verify_signature($self, "tzdb.tar.lz");
filter("", "tar", "-xO", "--lzip",
"-f", $self->{top_dir}."/tzdb.tar.lz",
"tzdb-$version/version") eq "$version\n"
or die "tzdb.tar.lz is not the expected version\n";
} elsif(_ge_version($version, "93")) {
my($cver, $dver) = @{_split_rel_versions($version)};
foreach(["code", $cver], ["data", $dver]) {
my($part, $pver) = @$_;
$self->{"${part}_version"} = $pver;
my $zext = _ge_version($pver, "93g") ? "gz" : "Z";
my $rname = "tz$part$pver.tar.$zext";
$rname =~ s/\Atz(?=code2006b.tar.gz\z)/tz64/;
_download_file($self, $rname, "tz$part.tar.gz", 0,
sub () {
die "file $rname is not available on ".
"@{[$self->{ftp_hostname}]}\n";
});
_verify_sha512($self, "tz$part.tar.gz", $rname);
}
} else {
die "Olson DB version $version is too early for this module\n";
}
delete $self->{ftp};
delete $self->{ftp_hostname};
$self->{downloaded} = 1;
return $self;
}
=item Time::OlsonTZ::Download->new_from_local_source(ATTR => VALUE, ...)
Acquires Olson database source locally, without downloading, and returns
an object representing a copy of it ready to use like a download.
This can be used to work with locally-modified versions of the database.
The following attributes may be given:
=over
=item B
Local directory containing Olson source files. Must be supplied.
The entire directory will be copied into a temporary location to be
worked on.
=item B
Olson version number to attribute to the source files. Must be supplied.
=item B
=item B
Olson version number to attribute to the code and data parts of the
source files. Both default to the main version number.
=back
=cut
sub new_from_local_source {
my $class = shift;
my $self = bless({}, $class);
my $srcdir;
while(@_) {
my $attr = shift;
my $value = shift;
if($attr eq "source_dir") {
croak "source directory specified redundantly"
if defined $srcdir;
croak "source directory must be a string"
unless is_string($value);
$srcdir = $value;
} elsif($attr eq "version") {
croak "version specified redundantly"
if exists $self->{version};
die "malformed Olson version number `$value'\n"
unless is_string($value) &&
$value =~ /\A[0-9]{2}(?:[0-9]{2})?
(?:[a-z][23]?)?\z/x;
$self->{version} = $value;
} elsif($attr =~ /\A(?:code|data)_version\z/) {
croak "$attr specified redundantly"
if exists $self->{$attr};
die "malformed Olson part version number `$value'\n"
unless is_string($value) &&
$value =~ /\A[0-9]{2}(?:[0-9]{2})?
[a-z]?\z/x;
$self->{$attr} = $value;
} else {
croak "unrecognised attribute `$attr'";
}
}
croak "source directory not specified" unless defined $srcdir;
croak "version number not specified" unless exists $self->{version};
foreach(qw(code_version data_version)) {
$self->{$_} = $self->{version} unless exists $self->{$_};
}
my $tdir = tempdir();
$self->{top_dir} = $tdir;
$self->{olson_dir} = "$tdir/c";
$srcdir = "./$srcdir" unless $srcdir =~ m#\A\.?/#;
filter("", "cp", "-pr", $srcdir, $self->{olson_dir});
$self->{downloaded} = 1;
$self->{unpacked} = 1;
return $self;
}
=back
=head1 METHODS
=head2 Basic information
=over
=item $download->version
Returns the version number of the database of which a copy is represented
by this object.
The database consists of code and data parts which are updated
semi-independently. The latest version of the database as a whole
consists of the latest version of the code and the latest version of
the data. If both parts are updated at once then they will both get the
same version number, and that will be the version number of the database
as a whole. However, in general they may be updated at different times,
and a single version of the database may be made up of code and data
parts that have different version numbers. The version number of the
database as a whole will then be the version number of the most recently
updated part.
=cut
sub version {
my($self) = @_;
die "Olson database version not determined\n"
unless exists $self->{version};
return $self->{version};
}
=item $download->code_version
Returns the version number of the code part of the database of which a
copy is represented by this object.
=cut
sub code_version {
my($self) = @_;
die "Olson database code version not determined\n"
unless exists $self->{code_version};
return $self->{code_version};
}
=item $download->data_version
Returns the version number of the data part of the database of which a
copy is represented by this object.
=cut
sub data_version {
my($self) = @_;
die "Olson database data version not determined\n"
unless exists $self->{data_version};
return $self->{data_version};
}
=item $download->dir
Returns the pathname of the directory in which the files of this download
are located. With this method, there is no guarantee of particular
files being available in the directory; see other directory-related
methods below that establish particular directory contents.
The directory does not move during the lifetime of the download object:
this method will always return the same pathname. The directory and
all of its contents, including subdirectories, will be automatically
deleted when this object is destroyed. This will be when the main
program terminates, if it is not otherwise destroyed. Any files that
it is desired to keep must be copied to a permanent location.
=cut
sub dir {
my($self) = @_;
die "download directory not created\n"
unless exists $self->{olson_dir};
return $self->{olson_dir};
}
sub _ensure_downloaded {
my($self) = @_;
die "can't use download because downloading failed\n"
unless $self->{downloaded};
}
sub _ensure_unpacked {
my($self) = @_;
unless($self->{unpacked}) {
$self->_ensure_downloaded;
if(_ge_version($self->{version}, "2016g")) {
filter("", "tar", "-C", $self->dir,
"-x", "--strip-components=1", "--lzip",
"-f", $self->{top_dir}."/tzdb.tar.lz");
} else {
foreach my $part (qw(tzcode tzdata)) {
filter("", "tar", "-C", $self->dir,
"-x", "--gzip",
"-f", $self->{top_dir}."/$part.tar.gz");
}
}
$self->{unpacked} = 1;
}
}
=item $download->unpacked_dir
Returns the pathname of the directory in which the downloaded source
files have been unpacked. This is the local temporary directory used
by this download. This method will unpack the files there if they have
not already been unpacked.
=cut
sub unpacked_dir {
my($self) = @_;
$self->_ensure_unpacked;
return $self->dir;
}
=back
=head2 Zone metadata
=over
=cut
sub _ensure_canonnames_and_rawlinks {
my($self) = @_;
unless(exists $self->{canonical_names}) {
my %seen;
my %canonnames;
my %rawlinks;
foreach(@{$self->zic_input_files}) {
my $fh = IO::File->new($_, "r")
or die "data file $_ unreadable: $!\n";
local $/ = "\n";
while(defined(my $line = $fh->getline)) {
if($line =~ /\A[Zz](?:[Oo](?:[Nn][Ee]?)?)?
[ \t]+([!-~]+)[ \t\n]/x) {
my $name = $1;
die "zone $name multiply defined\n"
if exists $seen{$name};
$seen{$name} = undef;
$canonnames{$name} = undef;
} elsif($line =~ /\A[Ll](?:[Ii](?:[Nn][Kk]?)?)?
[\ \t]+([!-~]+)[\ \t]+
([!-~]+)[\ \t\n]/x) {
my($target, $name) = ($1, $2);
die "zone $name multiply defined\n"
if exists $seen{$name};
$seen{$name} = undef;
$rawlinks{$name} = $target;
}
}
}
$self->{raw_links} = \%rawlinks;
$self->{canonical_names} = \%canonnames;
}
}
=item $download->canonical_names
Returns the set of timezone names that this version of the database
defines as canonical. These are the timezone names that are directly
associated with a set of observance data. The return value is a reference
to a hash, in which the keys are the canonical timezone names and the
values are all C.
=cut
sub canonical_names {
my($self) = @_;
$self->_ensure_canonnames_and_rawlinks;
return $self->{canonical_names};
}
=item $download->link_names
Returns the set of timezone names that this version of the database
defines as links. These are the timezone names that are aliases for
other names. The return value is a reference to a hash, in which the
keys are the link timezone names and the values are all C.
=cut
sub link_names {
my($self) = @_;
unless(exists $self->{link_names}) {
$self->{link_names} =
{ map { ($_ => undef) } keys %{$self->raw_links} };
}
return $self->{link_names};
}
=item $download->all_names
Returns the set of timezone names that this version of the database
defines. These are the L and the L.
The return value is a reference to a hash, in which the keys are the
timezone names and the values are all C.
=cut
sub all_names {
my($self) = @_;
unless(exists $self->{all_names}) {
$self->{all_names} = {
%{$self->canonical_names},
%{$self->link_names},
};
}
return $self->{all_names};
}
=item $download->raw_links
Returns details of the timezone name links in this version of the
database. Each link defines one timezone name as an alias for some
other timezone name. The return value is a reference to a hash, in
which the keys are the aliases and each value is the preferred timezone
name to which that alias directly refers. It is possible for an alias
to point to another alias, or to point to a non-existent name. For a
more processed view of links, see L.
=cut
sub raw_links {
my($self) = @_;
$self->_ensure_canonnames_and_rawlinks;
return $self->{raw_links};
}
=item $download->threaded_links
Returns details of the timezone name links in this version of the
database. Each link defines one timezone name as an alias for some
other timezone name. The return value is a reference to a hash, in
which the keys are the aliases and each value is the canonical name of
the timezone to which that alias refers. All such canonical names can
be found in the L hash.
=cut
sub threaded_links {
my($self) = @_;
unless(exists $self->{threaded_links}) {
my $raw_links = $self->raw_links;
my %links = %$raw_links;
while(1) {
my $done_any;
foreach(keys %links) {
next unless exists $raw_links->{$links{$_}};
$links{$_} = $raw_links->{$links{$_}};
die "circular link at $_\n" if $links{$_} eq $_;
$done_any = 1;
}
last unless $done_any;
}
my $canonical_names = $self->canonical_names;
foreach(keys %links) {
die "link from $_ to non-existent zone $links{$_}\n"
unless exists $canonical_names->{$links{$_}};
}
$self->{threaded_links} = \%links;
}
return $self->{threaded_links};
}
=item $download->country_selection
Returns information about how timezones relate to countries, intended
to aid humans in selecting a geographical timezone. This information
is derived from the C and C files in the database
source.
The return value is a reference to a hash, keyed by (ISO 3166 alpha-2
uppercase) country code. The value for each country is a hash containing
these values:
=over
=item B
The ISO 3166 alpha-2 uppercase country code.
=item B
An English name for the country, possibly in a modified form, optimised
to help humans find the right entry in alphabetical lists. This is
not necessarily identical to the country's standard short or long name.
(For other forms of the name, consult a database of countries, keying
by the country code.)
=item B
Information about the regions of the country that use distinct
timezones. This is a hash, keyed by English description of the region.
The description is empty if there is only one region. The value for
each region is a hash containing these values:
=over
=item B
Brief English description of the region, used to distinguish between
the regions of a single country. Empty string if the country has only
one region for timezone purposes. (This is the same string used as the
key in the B hash.)
=item B
Name of the Olson timezone used in this region. This is not necessarily
a canonical name (it may be a link). Typically, where there are aliases
or identical canonical zones, a name is chosen that refers to a location
in the country of interest. It is not guaranteed that the named timezone
exists in the database (though it always should).
=item B
Geographical coordinates of some point within the location referred to in
the timezone name. This is a latitude and longitude, in ISO 6709 format.
=back
=back
This data structure is intended to help a human select the appropriate
timezone based on political geography, specifically working from a
selection of country. It is of essentially no use for any other purpose.
It is not strictly guaranteed that every geographical timezone in the
database is listed somewhere in this structure, so it is of limited use
in providing information about an already-selected timezone. It does
not include non-geographic timezones at all. It also does not claim
to be a comprehensive list of countries, and does not make any claims
regarding the political status of any entity listed: the "country"
classification is loose, and used only for identification purposes.
=cut
sub country_selection {
my($self) = @_;
unless(exists $self->{country_selection}) {
my $itabname = $self->unpacked_dir."/iso3166.tab";
my $ztabname = $self->unpacked_dir."/zone.tab";
local $/ = "\n";
my %itab;
my $itabfh = IO::File->new($itabname, "r")
or die "data file $itabname unreadable: $!\n";
while(defined(my $line = $itabfh->getline)) {
$line = decode("UTF-8", $line, FB_CROAK);
utf8::upgrade($line);
if($line =~ /\A([A-Z]{2})\t(\S[^\t\n]*\S)\n\z/) {
die "duplicate $itabname entry for $1\n"
if exists $itab{$1};
$itab{$1} = $2;
} elsif($line !~ /\A#[^\n]*\n\z/) {
die "bad line in $itabname\n";
}
}
my %sel;
my $ztabfh = IO::File->new($ztabname, "r")
or die "data file $ztabname unreadable: $!\n";
while(defined(my $line = $ztabfh->getline)) {
if($line =~ /\A([A-Z]{2})
\t([-+][0-9]{4}(?:[0-9]{2})?
[-+][0-9]{5}(?:[0-9]{2})?)
\t([!-~]+)
(?:\t([!-~][ -~]*[!-~]))?
\n\z/x) {
my($cc, $coord, $zn, $reg) = ($1, $2, $3, $4);
$reg = "" unless defined $reg;
$sel{$cc} ||= { regions => {} };
die "duplicate $ztabname entry for $cc\n"
if exists $sel{$cc}->{regions}->{$reg};
$sel{$cc}->{regions}->{$reg} = {
olson_description => $reg,
timezone_name => $zn,
location_coords => $coord,
};
} elsif($line !~ /\A#[^\n]*\n\z/) {
die "bad line in $ztabname\n";
}
}
foreach(keys %sel) {
die "unknown country $_\n" unless exists $itab{$_};
$sel{$_}->{alpha2_code} = $_;
$sel{$_}->{olson_name} = $itab{$_};
die "bad region description in $_\n"
if keys(%{$sel{$_}->{regions}}) == 1 xor
exists($sel{$_}->{regions}->{""});
}
$self->{country_selection} = \%sel;
}
return $self->{country_selection};
}
=back
=head2 Compiling zone data
=over
=item $download->source_data_files
Returns a reference to an array containing the pathnames of all the source
data files. These express the database's data (i.e., a description
of known civil timezones) in a textual format, and are intended for
human editing. They are located in the local temporary directory used
by this download.
There is normally approximately one source data file per continent,
though this arrangement could change in the future. The textual format
is machine parseable, the same format intended for input to C, but
when interpreted this way the files do not necessarily correspond to the
the official content of the database. There may be transformations that
the database code would normally apply between the source data files
and the actual input to C.
If you intend to parse the source, taking the place of C, then you
should prefer to use the L method, which provides the
input that C would actually see.
=cut
sub source_data_files {
my($self) = @_;
unless(exists $self->{source_data_files}) {
my $list;
$self->_ensure_unpacked;
my $mf = IO::File->new($self->dir."/Makefile", "r");
my $mfc = $mf ? do { local $/ = undef; $mf->getline } : "";
my $datavars = "\$(TDATA)";
if($mfc =~ m#
\nfulldata\.zi(?:[\ \t]+[0-9A-Z_a-z]+\.zi)*[\ \t]*:
[\ \t]+\$\(DSTDATA_ZI_DEPS\)[\ \t]*\n
\t[\ \t]*\$\(AWK\)\ -v\ outfile\=\'\$\@\'
\ -f\ zidst\.awk
\ \$\(TDATA\)\ \$\(PACKRATDATA\)
\ (?:\\\n\t[\ \t]*)?\>\$\@.out\n
\t[\ \t]*mv\ \$\@\.out\ \$\@\n[^\t]
#x || $mfc =~ m#
\ntzdata\.zi:[\ \t]+\$\(TZDATA_ZI_DEPS\)[\ \t]*\n
(?:\t[\ \t]*version=\`sed\ 1q\ version\`\ \&\&\ \\\n)?
\t[\ \t]*LC_ALL=C\ \$\(AWK\)
(?:\ -v\ version="\$\$version")?
\ -f\ zishrink\.awk
\ (?:\\\n\t[\ \t]*)?
\$\(TDATA\)\ \$\(PACKRATDATA\)\ \>\$\@.out\n
\t[\ \t]*mv\ \$\@\.out\ \$\@\n\n
#x) {
$datavars .= " \$(PACKRATDATA)";
} elsif($mfc =~ m#\ntzdata\.zi:#) {
die "don't know how to extract source data file names ".
"from this form of Olson distribution\n";
}
$list = filter("", "make", "--no-print-directory",
"-C", $self->dir, "names",
"ENCHILADA=$datavars", "VERSION_DEPS=");
$list =~ s#\n\z##;
$self->{source_data_files} =
[ map { $self->dir."/".$_ } split(/ /, $list) ];
}
return $self->{source_data_files};
}
=item $download->zic_input_files
Returns a reference to an array containing the pathnames of all the
data files that would normally be fed to C. These express the
database's data (i.e., a description of known civil timezones) in
the format expected by C, and are suitable for machine parsing.
They are located in the local temporary directory used by this download.
This method will build the files if they didn't already exist.
The C input files are not necessarily source files intended for human
editing. In older versions of the database they are such source files,
but from database version C<2017c> onwards there is a single C input
file, which is generated from the source files and omits the niceties of
the source files. From database version C<2018d> onwards there is some
transformation between the source files and the C input, such that
they do not necessarily express the same data when parsed by C.
These arrangements could change again in the future.
The textual format of C input is not standardised, and is peculiar
to the Olson database. Parsing it directly is in principle a dubious
proposition, but in practice it is very stable.
If you want the human-editable source form of the data, use the
L method instead.
=cut
sub zic_input_files {
my($self) = @_;
unless(exists $self->{zic_input_files}) {
$self->_ensure_unpacked;
my $mf = IO::File->new($self->dir."/Makefile", "r");
my $mfc = $mf ? do { local $/ = undef; $mf->getline } : "";
if($mfc =~ m#\ntzdata\.zi:#) {
filter("", "make", "-C", $self->dir, "tzdata.zi",
"VERSION_DEPS=");
$self->{zic_input_files} = [ $self->dir."/tzdata.zi" ];
} else {
$self->{zic_input_files} = $self->source_data_files;
}
}
return $self->{zic_input_files};
}
=item $download->data_files
Returns a reference to an array containing the pathnames of all the
source data files, provided that the database code would feed the
same data to C. This method is deprecated: you should use either
L or L depending on which aspect of
the data files you are interested in. In older versions of the database
the same files were both human-editable and used as C input, so
this single method served both roles. From database version C<2018d>
onwards there is some transformation between the source files and the
C input, so the two roles of the files need to be distinguished.
=cut
sub data_files {
my($self) = @_;
unless(exists $self->{data_files_dual_role}) {
my $list;
$self->_ensure_unpacked;
my $mf = IO::File->new($self->dir."/Makefile", "r");
my $mfc = $mf ? do { local $/ = undef; $mf->getline } : "";
if($mfc !~ m#\ntzdata\.zi:# || $mfc =~ m#
\ntzdata\.zi:[\ \t]+\$\(TZDATA_ZI_DEPS\)[\ \t]*\n
(?:\t[\ \t]*version=\`sed\ 1q\ version\`\ \&\&\ \\\n)?
\t[\ \t]*LC_ALL=C\ \$\(AWK\)
(?:\ -v\ version="\$\$version")?
\ -f\ zishrink\.awk
\ (?:\\\n\t[\ \t]*)?
\$\(TDATA\)\ \$\(PACKRATDATA\)\ \>\$\@.out\n
\t[\ \t]*mv\ \$\@\.out\ \$\@\n\n
#x) {
$self->{data_files_dual_role} = 1;
} else {
$self->{data_files_dual_role} = 0;
}
}
if($self->{data_files_dual_role}) {
return $self->source_data_files;
} else {
die "source data files and zic input are distinct in ".
"this form of Olson distribution\n";
}
}
sub _ensure_zic_built {
my($self) = @_;
unless($self->{zic_built}) {
$self->_ensure_unpacked;
filter("", "make", "-C", $self->dir, "zic", "VERSION_DEPS=");
$self->{zic_built} = 1;
}
}
=item $download->zic_exe
Returns the pathname of the C executable that has been built from
the downloaded source. This is located in the local temporary directory
used by this download. This method will build C if it has not
already been built.
=cut
sub zic_exe {
my($self) = @_;
$self->_ensure_zic_built;
return $self->dir."/zic";
}
=item $download->zoneinfo_dir([OPTIONS])
Returns the pathname of the directory containing binary tzfiles (in
L format) that have been generated from the downloaded source.
This is located in the local temporary directory used by this download,
and the files within it have names that match the timezone names (as
returned by L). This method will generate the tzfiles if
they have not already been generated.
The optional parameter I controls which kind of tzfiles are
desired. If supplied, it must be a reference to a hash, in which these
keys are permitted:
=over
=item B
Truth value, controls whether the tzfiles incorporate information about
known leap seconds offsets that account for the known leap seconds.
If false (which is the default), the tzfiles have no knowledge of leap
seconds, and are intended to be used on a system where C is some
flavour of UT (as is conventional on Unix and is the POSIX standard).
If true, the tzfiles know about leap seconds that have occurred between
1972 and the date of the database, and are intended to be used on a
system where C is (from 1972 onwards) a linear count of TAI
seconds (which is a non-standard arrangement).
=back
=cut
sub _foreach_nondir_under($$);
sub _foreach_nondir_under($$) {
my($dir, $callback) = @_;
my $dh = IO::Dir->new($dir) or die "can't examine $dir: $!\n";
while(defined(my $ent = $dh->read)) {
next if $ent =~ /\A\.\.?\z/;
my $entpath = $dir."/".$ent;
if(-d $entpath) {
_foreach_nondir_under($entpath, $callback);
} else {
$callback->($entpath);
}
}
}
sub zoneinfo_dir {
my($self, $options) = @_;
$options = {} if is_undef($options);
foreach(keys %$options) {
die "bad option `$_'\n" unless /\Aleaps\z/;
}
my $type = $options->{leaps} ? "right" : "posix";
my $zidir = $self->dir."/zoneinfo_$type";
unless($self->{"zoneinfo_built_$type"}) {
filter("", "make", "-C", $self->unpacked_dir,
"${type}_only", "TZDIR=$zidir", "VERSION_DEPS=");
my %expect_names = %{$self->all_names};
my $skiplen = length($zidir) + 1;
_foreach_nondir_under($zidir, sub {
my($fname) = @_;
my $lname = substr($fname, $skiplen);
unless(exists $expect_names{$lname}) {
die "unexpected file $lname\n";
}
delete $expect_names{$lname};
});
if(keys %expect_names) {
die "missing file @{[(sort keys %expect_names)[0]]}\n";
}
$self->{"zoneinfo_built_$type"} = 1;
}
return $zidir;
}
=back
=head1 BUGS
Most of what this class does will only work on Unix platforms. This is
largely because the Olson database source is heavily Unix-oriented.
This class also depends on the availability of some tools beyond
baseline Unix. Specifically, it requires GNU C, GNU C,
C, C, and GNU C.
It also won't be much good if you're not connected to the Internet.
This class is liable to break if the format of the Olson database source
ever changes substantially. If that happens, an update of this class
will be required. It should at least recognise that it can't perform,
rather than do the wrong thing.
=head1 SEE ALSO
L,
L,
L
=head1 AUTHOR
Andrew Main (Zefram)
=head1 COPYRIGHT
Copyright (C) 2010, 2011, 2012, 2017, 2018
Andrew Main (Zefram)
=head1 LICENSE
This module is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.
=cut
1;
Time-OlsonTZ-Download-0.009/t 000755 001750 001750 0 13234264036 15734 5 ustar 00zefram zefram 000000 000000 Time-OlsonTZ-Download-0.009/t/latest.at 000444 001750 001750 12367 13234264036 17744 0 ustar 00zefram zefram 000000 000000 use warnings;
use strict;
use Params::Classify qw(is_blessed is_ref is_string);
use Test::More tests => 61;
BEGIN { use_ok "Time::OlsonTZ::Download"; }
my $lv = Time::OlsonTZ::Download->latest_version;
ok is_string($lv), "latest_version well formed";
like $lv, qr/\A[0-9]{4}[a-z]\z/, "latest_version well formed";
my $ld = Time::OlsonTZ::Download->new;
ok is_blessed($ld), "constructor returns object";
my $v = $ld->version;
ok is_string($v), "version well formed";
like $v, qr/\A[0-9]{4}[a-z]\z/, "version well formed";
is $v, $lv, "version is latest version";
my $cv = $ld->code_version;
ok is_string($cv), "code_version well formed";
like $cv, qr/\A[0-9]{4}[a-z]\z/, "code_version well formed";
ok $cv le $lv, "code_version is no later than latest version";
my $dv = $ld->data_version;
ok is_string($dv), "data_version well formed";
like $dv, qr/\A[0-9]{4}[a-z]\z/, "data_version well formed";
ok $dv eq $lv, "data_version is latest version";
my $dir = $ld->dir;
ok is_string($dir), "dir well formed";
like $dir, qr#\A/#, "dir well formed";
my $udir = $ld->unpacked_dir;
ok is_string($udir), "unpacked_dir well formed";
is $udir, $dir, "unpacked_dir is dir";
ok(-f "$dir/zic.c", "code (zic.c) unpacked");
ok(-f "$dir/iso3166.tab", "data (iso3166.tab) unpacked");
if($dir =~ m#\A/# && $udir eq $dir) {
# date.c is a copyrighted file; check that we can go on without it
unlink "$dir/date.c";
}
my $zname_rx = qr#[A-Za-z0-9\-\+_]{1,14}(?:/[A-Za-z0-9\-\+_]{1,14})*|Canada/East-Saskatchewan#;
my $cn = $ld->canonical_names;
ok is_ref($cn, "HASH"), "canonical_names well formed";
ok !(grep { !/\A$zname_rx\z/ } keys %$cn), "canonical_names well formed";
ok !(grep { defined } values %$cn), "canonical_names well formed";
ok keys(%$cn) >= 100, "at least 100 canonical zones";
note "have @{[scalar keys %$cn]} canonical zones";
my $ln = $ld->link_names;
ok is_ref($ln, "HASH"), "link_names well formed";
ok !(grep { !/\A$zname_rx\z/ } keys %$ln), "link_names well formed";
ok !(grep { defined } values %$ln), "link_names well formed";
ok keys(%$ln) >= 1, "at least 1 link";
note "have @{[scalar keys %$ln]} links";
ok !(grep { exists $ln->{$_} } keys %$cn), "no link names in canonical_names";
ok !(grep { exists $cn->{$_} } keys %$ln), "no canonical names in link_names";
my $an = $ld->all_names;
ok is_ref($an, "HASH"), "all_names well formed";
ok !(grep { defined } values %$an), "all_names well formed";
is_deeply $an, { %$cn, %$ln }, "all_names is canonical_names plus link_names";
ok exists($an->{"Europe/London"}), "Europe/London zone defined";
my $rl = $ld->raw_links;
ok is_ref($rl, "HASH"), "raw_links well formed";
ok !(grep { !/\A$zname_rx\z/ } keys %$rl), "raw_links well formed";
ok !(grep { !(is_string($_) && /\A$zname_rx\z/) } values %$rl), "raw_links well formed";
is_deeply [ sort keys %$rl ], [ sort keys %$ln ], "raw_links keys match link_names";
my $tl = $ld->threaded_links;
ok is_ref($tl, "HASH"), "threaded_links well formed";
ok !(grep { !/\A$zname_rx\z/ } keys %$tl), "threaded_links well formed";
ok !(grep { !(is_string($_) && /\A$zname_rx\z/) } values %$tl), "threaded_links well formed";
is_deeply [ sort keys %$tl ], [ sort keys %$ln ], "threaded_links keys match link_names";
ok !(grep { !exists($cn->{$_}) } values %$tl), "threaded_links refer to canonical zones";
my $cs = $ld->country_selection;
ok is_ref($cs, "HASH"), "country_selection well formed";
ok keys(%$cs) >= 100, "at least 100 countries";
my $failures = 0;
foreach(keys %$cs) {
/\A[A-Z]{2}\z/ or $failures++;
my $cnt = $cs->{$_};
is_ref($cnt, "HASH") or $failures++;
is_string($cnt->{alpha2_code}) or $failures++;
$cnt->{alpha2_code} eq $_ or $failures++;
is_string($cnt->{olson_name}) or $failures++;
my $regs = $cnt->{regions};
is_ref($regs, "HASH") or $failures++;
scalar(keys %$regs) != 0 or $failures++;
(scalar(keys %$regs) != 1 xor exists($regs->{""})) or $failures++;
foreach(keys %$regs) {
my $reg = $regs->{$_};
is_string($reg->{olson_description}) or $failures++;
$reg->{olson_description} eq $_ or $failures++;
is_string($reg->{timezone_name}) or $failures++;
exists $an->{$reg->{timezone_name}} or $failures++;
is_string($reg->{location_coords}) or $failures++;
is_string($reg->{location_coords}) or $failures++;
}
}
is $failures, 0, "country_selection well formed";
my $df = $ld->source_data_files;
ok is_ref($df, "ARRAY"), "source_data_files well formed";
ok @$df >= 1, "at least one data file";
ok !(grep { !(is_string($_) && m#\A/#) } @$df), "source_data_files well formed";
ok !(grep { !m#\A\Q$dir\E/[A-Za-z0-9\-\+_.]{1,14}\z# } @$df), "source data files in right place";
$df = $ld->zic_input_files;
ok is_ref($df, "ARRAY"), "zic_input_files well formed";
ok @$df >= 1, "at least one data file";
ok !(grep { !(is_string($_) && m#\A/#) } @$df), "zic_input_files well formed";
ok !(grep { !m#\A\Q$dir\E/[A-Za-z0-9\-\+_.]{1,14}\z# } @$df), "zic input files in right place";
my $zx = $ld->zic_exe;
ok is_string($zx), "zic_exe well formed";
like $zx, qr#\A/#, "zic_exe well formed";
is $zx, "$dir/zic", "zic executable in right place";
ok(-f $zx, "zic executable exists");
my $zd = $ld->zoneinfo_dir;
ok is_string($zd), "zoneinfo_dir well formed";
like $zd, qr#\A/#, "zoneinfo_dir well formed";
like $zd, qr#\A\Q$dir\E/#, "zoneinfo dir in right place";
ok !(grep { !(-f "$zd/$_") } keys %$cn), "zoneinfo files exist";
1;
Time-OlsonTZ-Download-0.009/t/pod_cvg.t 000444 001750 001750 273 13234264036 17661 0 ustar 00zefram zefram 000000 000000 use warnings;
use strict;
use Test::More;
plan skip_all => "Test::Pod::Coverage not available"
unless eval "use Test::Pod::Coverage; 1";
Test::Pod::Coverage::all_pod_coverage_ok();
1;
Time-OlsonTZ-Download-0.009/t/pod_syn.t 000444 001750 001750 236 13234264036 17712 0 ustar 00zefram zefram 000000 000000 use warnings;
use strict;
use Test::More;
plan skip_all => "Test::Pod not available" unless eval "use Test::Pod 1.00; 1";
Test::Pod::all_pod_files_ok();
1;
Time-OlsonTZ-Download-0.009/t/use.t 000444 001750 001750 141 13234264036 17026 0 ustar 00zefram zefram 000000 000000 use warnings;
use strict;
use Test::More tests => 1;
require_ok "Time::OlsonTZ::Download";
1;