As part of the plan for replacing DT:TZ, we discussed the need for a way
to list the available timezones, to replace the static DT:TZ:Catalog
document. Attached is a prototype of a command-line tool that could
take this role. I'd appreciate comments about its current operation
and about what it ought to additionally support.
-zefram
#!perl
{ use 5.006; }
use warnings;
use strict;
use Date::ISO8601 0.000 qw(present_ymd);
use Date::JD 0.005 qw(rdn_to_cjdnn);
use DateTime::TimeZone::Olson ();
use Getopt::Std qw(getopts);
use Params::Classify qw(is_string);
use Time::OlsonTZ::Data ();
use Time::Unix qw(time);
our $VERSION = "0.000";
my %command;
$command{version} = sub () {
getopts("", {}) or die "bad options\n";
die "bad arguments\n" if @ARGV;
print "modules:\n App::olson $VERSION\n";
foreach my $mod (qw(DateTime::TimeZone::Olson Time::OlsonTZ::Data)) {
no strict "refs";
print " $mod ${qq(${mod}::VERSION)}\n";
}
print "Olson database: @{[DateTime::TimeZone::Olson::olson_version]}\n";
};
{
package FakeUtcDateTime;
sub new {
my($class, $rdns) = @_;
return bless({ rdn => $rdns->[0], sod => $rdns->[1] }, $class);
}
sub utc_rd_values { ($_[0]->{rdn}, $_[0]->{sod}, 0) }
}
{
package FakeLocalDateTime;
sub new {
my($class, $rdns) = @_;
return bless({ rdn => $rdns->[0], sod => $rdns->[1] }, $class);
}
sub local_rd_values { ($_[0]->{rdn}, $_[0]->{sod}, 0) }
}
sub handle_exception($$) {
my($val, $err) = @_;
if($err =~ /\A
time\ [-:TZ0-9]+\ is\ not\ represented\ in\ the\ [!-~]+
\ timezone\ due\ to\ (zone\ disuse|)\b
/x) {
return $1 eq "zone disuse" ? "!" : "?";
} elsif($err ne "") {
return "*";
} else {
return $val;
}
}
sub is_exception($) {
return is_string($_[0]) && $_[0] =~ /\A[!?*]\z/;
}
sub rdns_offset($$) {
my($rdns, $offset) = @_;
return $rdns if is_exception($rdns);
return $offset if is_exception($offset);
my($rdn, $sod) = @$rdns;
$sod += $offset;
use integer;
my $doff = $sod < 0 ? -((86399-$sod) / 86400) : $sod / 86400;
$rdn += $doff;
$sod -= 86400*$doff;
return [$rdn, $sod];
}
sub present_rdns($) {
my($rdns) = @_;
return $rdns x 19 if is_exception($rdns);
my($rdn, $sod) = @$rdns;
use integer;
return present_ymd(rdn_to_cjdnn($rdn)).
"T".sprintf("%02d:%02d:%02d", $sod/3600, $sod/60%60, $sod%60);
}
sub now_utc_dt() {
my $now_unixtime = time;
my $now_utc_rdn = 719163 + int($now_unixtime/86400);
my $now_utc_sod = $now_unixtime % 86400;
return FakeUtcDateTime->new([$now_utc_rdn, $now_utc_sod]);
}
sub utc_to_local_dt($$) {
my($utcdt, $offset) = @_;
return $utcdt if is_exception($utcdt);
return $offset if is_exception($offset);
return FakeLocalDateTime->new(
rdns_offset([$utcdt->utc_rd_values], $offset));
}
sub local_to_utc_dt($$) {
my($lcldt, $offset) = @_;
return $lcldt if is_exception($lcldt);
return $offset if is_exception($offset);
return FakeUtcDateTime->new(
rdns_offset([$lcldt->utc_rd_values], -$offset));
}
sub present_utc_dt($) {
my($dt) = @_;
return present_rdns(is_exception($dt) ? $dt : [$dt->utc_rd_values])."Z";
}
sub present_local_dt($) {
my($dt) = @_;
return present_rdns(is_exception($dt) ? $dt : [$dt->local_rd_values]);
}
sub present_offset($) {
my($offset) = @_;
return sprintf("%-9s", $offset x 3) if is_exception($offset);
my $sign = $offset < 0 ? "-" : "+";
$offset = abs($offset);
use integer;
my $disp = sprintf("%s%02d:%02d:%02d", $sign, $offset/3600,
$offset/60%60, $offset%60);
$disp =~ s/(?::00)+\z//;
return sprintf("%-9s", $disp);
}
sub present_abbreviation($) {
my($abbrev) = @_;
return sprintf("%-6s", is_exception($abbrev) ? $abbrev x 3 : $abbrev);
}
sub present_isdst($) {
my($isdst) = @_;
return is_exception($isdst) ? $isdst : $isdst ? "+" : "-";
}
{ my $continents; sub continents() { $continents ||= do {
my %continents;
foreach my $country (
values %{DateTime::TimeZone::Olson::olson_country_selection()}
) {
foreach my $region (values %{$country->{regions}}) {
$continents{$1} = undef
if $region->{timezone_name} =~ m#\A([^/]+)/#;
}
}
\%continents;
} } }
$command{zones} = sub () {
my %opts;
getopts("C:N:tado", \%opts) or die "bad options\n";
die "bad arguments\n" if @ARGV;
my @match;
if(exists $opts{C}) {
my %conts = map { (lc($_) => undef) } keys %{continents()};
if($opts{C} eq "!") {
my $conts = join("|", map { "\Q$_\E" } keys %conts);
my $contrx = qr#\A($conts)/#oi;
push @match, sub ($) { $_[0] !~ $contrx };
} elsif($opts{C} =~ /\A[!-~]+\z/ &&
exists($conts{lc($opts{C})})) {
my $contrx = qr#\A\Q$opts{C}\E/#oi;
push @match, sub ($) { $_[0] =~ $contrx };
} else {
die "no such continent `$opts{C}' ".
"(try `$0 continents` to list them)\n";
}
}
if(exists $opts{N}) {
my $sel = DateTime::TimeZone::Olson::olson_country_selection();
if($opts{N} eq "!") {
my %zones = map {
map { ($_->{timezone_name} => undef) }
values %{$_->{regions}}
} values %$sel;
push @match, sub ($) { !exists($zones{$_[0]}) };
} elsif($opts{N} !~ /\A[A-Za-z]{2}\z/) {
die "malformed country code\n";
} elsif($sel->{uc($opts{N})}) {
my %zones = map { ($_->{timezone_name} => undef) }
values %{$sel->{uc($opts{N})}->{regions}};
push @match, sub ($) { exists $zones{$_[0]} };
} else {
die "no such country `@{[uc($opts{N})]}' ".
"(try `$0 countries` to list them)\n";
}
}
my $now_utc_dt = now_utc_dt();
my $links = DateTime::TimeZone::Olson::olson_links;
foreach my $zname (
sort keys %{DateTime::TimeZone::Olson::olson_all_names()}
) {
next if grep { !$_->($zname) } @match;
my @parts;
my $zone = $opts{t} || $opts{a} || $opts{d} || $opts{o} ?
DateTime::TimeZone::Olson::olson_tz($zname) : undef;
my $offset = $opts{t} || $opts{d} || $opts{o} ?
handle_exception(eval {
local $SIG{__DIE__};
$zone->offset_for_datetime($now_utc_dt);
}, $@)
: undef;
if($opts{t}) {
push @parts, present_local_dt(
utc_to_local_dt($now_utc_dt, $offset));
}
if($opts{a}) {
push @parts, present_abbreviation(
handle_exception(eval {
local $SIG{__DIE__};
$zone->short_name_for_datetime(
$now_utc_dt);
}, $@)
);
}
if($opts{d}) {
push @parts, present_isdst(handle_exception(eval {
local $SIG{__DIE__};
$zone->is_dst_for_datetime($now_utc_dt) ? 1 : 0;
}, $@));
}
if($opts{o}) {
push @parts, present_offset($offset);
}
push @parts, $zname;
push @parts, "(-> $links->{$zname})" if exists $links->{$zname};
print join(" ", @parts), "\n";
}
};
$command{continents} = sub () {
getopts("", {}) or die "bad options\n";
die "bad arguments\n" if @ARGV;
print "$_\n" foreach sort keys %{continents()};
};
$command{countries} = sub () {
getopts("", {}) or die "bad options\n";
die "bad arguments\n" if @ARGV;
foreach my $country (sort {
$a->{olson_name} cmp $b->{olson_name}
} values %{DateTime::TimeZone::Olson::olson_country_selection()}) {
print $country->{alpha2_code}, " ", $country->{olson_name},
"\n";
}
};
getopts("", {}) or die "bad options\n";
die "no subcommand specified\n" unless @ARGV;
($command{shift(@ARGV)} || sub () { die "unrecognised subcommand\n" })->();
exit 0;
=head1 NAME
olson - query the Olson timezone database
=head1 SYNOPSIS
olson continents
olson countries
olson version
olson zones
=head1 DESCRIPTION
This program provides various ways of extracting information from
the Olson timezone database. It can be used to assist selection of
a timezone, and for other purposes. The type of query to perform is
determined by a subcommand, specified as the first command-line argument.
The subcommands are:
=over
=item B<continents>
Lists the continents and oceans that are used for rough geographical
categorisation of geographical timezones. These names are the first
part of the hierarchical geographical timezone names. The names are
sorted alphabetically.
=item B<countries>
Lists the countries for which timezones are known to exist. This list
is primarily intended to support the selection of a timezone based
on political geography. For each country, the list shows its ISO
3166 alpha-2 code and a short version of its name. The list is sorted
alphabetically by name, and the names are optimised to make this a good
way to list them.
=item B<version>
Indicates which version is being used of the Olson database and of the
relevant Perl modules. This information is vital in any bug report.
=item B<zones>
Lists timezones in the Olson database. The range of timezones to list
can be restricted by options. What to show for each timezone can also be
controlled by options. By default all known timezone names are listed,
and for each the listing shows the name, and if the name is an alias
then the target of the alias is also shown. The options are:
=over
=item B<-C> I<continent>
Restrict the listing to timezones whose name starts with the specified
continent name (specified case-insensitively). If "C<!>" is specified,
restricts the listing to timezones whose name does not start with any
continent name.
=item B<-N> I<country>
Restrict the listing to timezones located in the country with the
specified ISO 3166 alpha-2 code (specified case-insensitively). If "C<!>"
is specified, restricts the listing to timezones not associated with
any country. (Note that the no-country listing includes many aliases
for zones that are actually associated with countries.)
=item B<-a>
For each listed zone, show the abbreviation currently used to refer to it.
(The abbreviation may be fixed for the timezone, or may vary over the
course of each year to signal DST changes.)
=item B<-d>
For each listed zone, indicate whether it is currently observing DST.
A "C<+>" character indicates DST, and a "C<->" character indicates
not DST.
=item B<-o>
For each listed zone, show its current offset from UT.
=item B<-t>
For each listed zone, show its current local time.
=back
=back
=head1 SEE ALSO
L<DateTime::TimeZone::Olson>,
L<Time::OlsonTZ::Data>
