|
Packit Service |
f95697 |
=head1 NAME
|
|
Packit Service |
f95697 |
|
|
Packit Service |
f95697 |
DateTime::TimeZone::Tzfile - tzfile (zoneinfo) timezone files
|
|
Packit Service |
f95697 |
|
|
Packit Service |
f95697 |
=head1 SYNOPSIS
|
|
Packit Service |
f95697 |
|
|
Packit Service |
f95697 |
use DateTime::TimeZone::Tzfile;
|
|
Packit Service |
f95697 |
|
|
Packit Service |
f95697 |
$tz = DateTime::TimeZone::Tzfile->new(
|
|
Packit Service |
f95697 |
name => "local timezone",
|
|
Packit Service |
f95697 |
filename => "/etc/localtime");
|
|
Packit Service |
f95697 |
$tz = DateTime::TimeZone::Tzfile->new("/etc/localtime");
|
|
Packit Service |
f95697 |
|
|
Packit Service |
f95697 |
if($tz->is_floating) { ...
|
|
Packit Service |
f95697 |
if($tz->is_utc) { ...
|
|
Packit Service |
f95697 |
if($tz->is_olson) { ...
|
|
Packit Service |
f95697 |
$category = $tz->category;
|
|
Packit Service |
f95697 |
$tz_string = $tz->name;
|
|
Packit Service |
f95697 |
|
|
Packit Service |
f95697 |
if($tz->has_dst_changes) { ...
|
|
Packit Service |
f95697 |
if($tz->is_dst_for_datetime($dt)) { ...
|
|
Packit Service |
f95697 |
$offset = $tz->offset_for_datetime($dt);
|
|
Packit Service |
f95697 |
$abbrev = $tz->short_name_for_datetime($dt);
|
|
Packit Service |
f95697 |
$offset = $tz->offset_for_local_datetime($dt);
|
|
Packit Service |
f95697 |
|
|
Packit Service |
f95697 |
=head1 DESCRIPTION
|
|
Packit Service |
f95697 |
|
|
Packit Service |
f95697 |
An instance of this class represents a timezone that was encoded in a
|
|
Packit Service |
f95697 |
file in the L<tzfile(5)> format. These can express arbitrary patterns
|
|
Packit Service |
f95697 |
of offsets from Universal Time, changing over time. Offsets and change
|
|
Packit Service |
f95697 |
times are limited to a resolution of one second.
|
|
Packit Service |
f95697 |
|
|
Packit Service |
f95697 |
This class implements the L<DateTime::TimeZone> interface, so that its
|
|
Packit Service |
f95697 |
instances can be used with L<DateTime> objects.
|
|
Packit Service |
f95697 |
|
|
Packit Service |
f95697 |
=cut
|
|
Packit Service |
f95697 |
|
|
Packit Service |
f95697 |
package DateTime::TimeZone::Tzfile;
|
|
Packit Service |
f95697 |
|
|
Packit Service |
f95697 |
{ use 5.006; }
|
|
Packit Service |
f95697 |
use warnings;
|
|
Packit Service |
f95697 |
use strict;
|
|
Packit Service |
f95697 |
|
|
Packit Service |
f95697 |
use Carp qw(croak);
|
|
Packit Service |
f95697 |
use Date::ISO8601 0.000 qw(present_ymd);
|
|
Packit Service |
f95697 |
use IO::File 1.13;
|
|
Packit Service |
f95697 |
use IO::Handle 1.08;
|
|
Packit Service |
f95697 |
use Params::Classify 0.000 qw(is_undef is_string is_ref);
|
|
Packit Service |
f95697 |
|
|
Packit Service |
f95697 |
our $VERSION = "0.011";
|
|
Packit Service |
f95697 |
|
|
Packit Service |
f95697 |
my $rdn_epoch_cjdn = 1721425;
|
|
Packit Service |
f95697 |
|
|
Packit Service |
f95697 |
# _fdiv(A, B), _fmod(A, B): divide A by B, flooring remainder
|
|
Packit Service |
f95697 |
#
|
|
Packit Service |
f95697 |
# B must be a positive Perl integer. A must be a Perl integer.
|
|
Packit Service |
f95697 |
|
|
Packit Service |
f95697 |
sub _fdiv($$) {
|
|
Packit Service |
f95697 |
my($a, $b) = @_;
|
|
Packit Service |
f95697 |
if($a < 0) {
|
|
Packit Service |
f95697 |
use integer;
|
|
Packit Service |
f95697 |
return -(($b - 1 - $a) / $b);
|
|
Packit Service |
f95697 |
} else {
|
|
Packit Service |
f95697 |
use integer;
|
|
Packit Service |
f95697 |
return $a / $b;
|
|
Packit Service |
f95697 |
}
|
|
Packit Service |
f95697 |
}
|
|
Packit Service |
f95697 |
|
|
Packit Service |
f95697 |
sub _fmod($$) { $_[0] % $_[1] }
|
|
Packit Service |
f95697 |
|
|
Packit Service |
f95697 |
=head1 CONSTRUCTOR
|
|
Packit Service |
f95697 |
|
|
Packit Service |
f95697 |
=over
|
|
Packit Service |
f95697 |
|
|
Packit Service |
f95697 |
=item DateTime::TimeZone::Tzfile->new(ATTR => VALUE, ...)
|
|
Packit Service |
f95697 |
|
|
Packit Service |
f95697 |
Reads and parses a L<tzfile(5)> format file, then constructs and returns
|
|
Packit Service |
f95697 |
a L<DateTime>-compatible timezone object that implements the timezone
|
|
Packit Service |
f95697 |
encoded in the file. The following attributes may be given:
|
|
Packit Service |
f95697 |
|
|
Packit Service |
f95697 |
=over
|
|
Packit Service |
f95697 |
|
|
Packit Service |
f95697 |
=item B<name>
|
|
Packit Service |
f95697 |
|
|
Packit Service |
f95697 |
Name for the timezone object. This will be returned by the C<name>
|
|
Packit Service |
f95697 |
method described below, and will be included in certain error messages.
|
|
Packit Service |
f95697 |
|
|
Packit Service |
f95697 |
=item B<category>
|
|
Packit Service |
f95697 |
|
|
Packit Service |
f95697 |
The string or C<undef> that will be returned by the C<category> method
|
|
Packit Service |
f95697 |
described below. Default C<undef>.
|
|
Packit Service |
f95697 |
|
|
Packit Service |
f95697 |
=item B<is_olson>
|
|
Packit Service |
f95697 |
|
|
Packit Service |
f95697 |
The truth value that will be returned by the C<is_olson> method described
|
|
Packit Service |
f95697 |
below. Default false.
|
|
Packit Service |
f95697 |
|
|
Packit Service |
f95697 |
=item B<filename>
|
|
Packit Service |
f95697 |
|
|
Packit Service |
f95697 |
Name of the file from which to read the timezone data. The filename
|
|
Packit Service |
f95697 |
must be understood by L<IO::File>.
|
|
Packit Service |
f95697 |
|
|
Packit Service |
f95697 |
=item B<filehandle>
|
|
Packit Service |
f95697 |
|
|
Packit Service |
f95697 |
An L<IO::Handle> object from which the timezone data can be read.
|
|
Packit Service |
f95697 |
This does not need to be a regular seekable file; it is read sequentially.
|
|
Packit Service |
f95697 |
After the constructor has finished, the handle can still be used to read
|
|
Packit Service |
f95697 |
any data that follows the timezone data.
|
|
Packit Service |
f95697 |
|
|
Packit Service |
f95697 |
=back
|
|
Packit Service |
f95697 |
|
|
Packit Service |
f95697 |
Either a filename or filehandle must be given. If a timezone name is not
|
|
Packit Service |
f95697 |
given, then the filename is used instead if supplied; a timezone name
|
|
Packit Service |
f95697 |
must be given explicitly if no filename is given.
|
|
Packit Service |
f95697 |
|
|
Packit Service |
f95697 |
=item DateTime::TimeZone::Tzfile->new(FILENAME)
|
|
Packit Service |
f95697 |
|
|
Packit Service |
f95697 |
Simpler way to invoke the above constructor in the usual case. Only the
|
|
Packit Service |
f95697 |
filename is given; this will also be used as the timezone name.
|
|
Packit Service |
f95697 |
|
|
Packit Service |
f95697 |
=cut
|
|
Packit Service |
f95697 |
|
|
Packit Service |
f95697 |
sub _saferead($$) {
|
|
Packit Service |
f95697 |
my($fh, $len) = @_;
|
|
Packit Service |
f95697 |
my $data;
|
|
Packit Service |
f95697 |
my $rlen = $fh->read($data, $len);
|
|
Packit Service |
f95697 |
croak "can't read tzfile: $!" unless defined($rlen);
|
|
Packit Service |
f95697 |
croak "bad tzfile: premature EOF" unless $rlen == $len;
|
|
Packit Service |
f95697 |
return $data;
|
|
Packit Service |
f95697 |
}
|
|
Packit Service |
f95697 |
|
|
Packit Service |
f95697 |
sub _read_u32($) { unpack("N", _saferead($_[0], 4)) }
|
|
Packit Service |
f95697 |
|
|
Packit Service |
f95697 |
sub _read_s32($) {
|
|
Packit Service |
f95697 |
my $uval = _read_u32($_[0]);
|
|
Packit Service |
f95697 |
return ($uval & 0x80000000) ? ($uval & 0x7fffffff) - 0x80000000 :
|
|
Packit Service |
f95697 |
$uval;
|
|
Packit Service |
f95697 |
}
|
|
Packit Service |
f95697 |
|
|
Packit Service |
f95697 |
sub _read_u8($) { ord(_saferead($_[0], 1)) }
|
|
Packit Service |
f95697 |
|
|
Packit Service |
f95697 |
my $unix_epoch_rdn = 719163;
|
|
Packit Service |
f95697 |
|
|
Packit Service |
f95697 |
sub _read_tm32($) {
|
|
Packit Service |
f95697 |
my $t = _read_s32($_[0]);
|
|
Packit Service |
f95697 |
return [ $unix_epoch_rdn + _fdiv($t, 86400), _fmod($t, 86400) ];
|
|
Packit Service |
f95697 |
}
|
|
Packit Service |
f95697 |
|
|
Packit Service |
f95697 |
sub _read_tm64($) {
|
|
Packit Service |
f95697 |
my($fh) = @_;
|
|
Packit Service |
f95697 |
my $th = _read_s32($fh);
|
|
Packit Service |
f95697 |
my $tl = _read_u32($fh);
|
|
Packit Service |
f95697 |
my $dh = _fdiv($th, 86400);
|
|
Packit Service |
f95697 |
$th = (_fmod($th, 86400) << 10) | ($tl >> 22);
|
|
Packit Service |
f95697 |
my $d2 = _fdiv($th, 86400);
|
|
Packit Service |
f95697 |
$th = (_fmod($th, 86400) << 10) | (($tl >> 12) & 0x3ff);
|
|
Packit Service |
f95697 |
my $d3 = _fdiv($th, 86400);
|
|
Packit Service |
f95697 |
$th = (_fmod($th, 86400) << 12) | ($tl & 0xfff);
|
|
Packit Service |
f95697 |
my $d4 = _fdiv($th, 86400);
|
|
Packit Service |
f95697 |
$th = _fmod($th, 86400);
|
|
Packit Service |
f95697 |
my $d = $dh * 4294967296 + $d2 * 4194304 + (($d3 << 12) + $d4);
|
|
Packit Service |
f95697 |
return [ $unix_epoch_rdn + $d, $th ];
|
|
Packit Service |
f95697 |
}
|
|
Packit Service |
f95697 |
|
|
Packit Service |
f95697 |
my $factory_abbr = "Local time zone must be set--see zic manual page";
|
|
Packit Service |
f95697 |
|
|
Packit Service |
f95697 |
sub new {
|
|
Packit Service |
f95697 |
my $class = shift;
|
|
Packit Service |
f95697 |
unshift @_, "filename" if @_ == 1;
|
|
Packit Service |
f95697 |
my $self = bless({}, $class);
|
|
Packit Service |
f95697 |
my($filename, $fh);
|
|
Packit Service |
f95697 |
while(@_) {
|
|
Packit Service |
f95697 |
my $attr = shift;
|
|
Packit Service |
f95697 |
my $value = shift;
|
|
Packit Service |
f95697 |
if($attr eq "name") {
|
|
Packit Service |
f95697 |
croak "timezone name specified redundantly"
|
|
Packit Service |
f95697 |
if exists $self->{name};
|
|
Packit Service |
f95697 |
croak "timezone name must be a string"
|
|
Packit Service |
f95697 |
unless is_string($value);
|
|
Packit Service |
f95697 |
$self->{name} = $value;
|
|
Packit Service |
f95697 |
} elsif($attr eq "category") {
|
|
Packit Service |
f95697 |
croak "category value specified redundantly"
|
|
Packit Service |
f95697 |
if exists $self->{category};
|
|
Packit Service |
f95697 |
croak "category value must be a string or undef"
|
|
Packit Service |
f95697 |
unless is_undef($value) || is_string($value);
|
|
Packit Service |
f95697 |
$self->{category} = $value;
|
|
Packit Service |
f95697 |
} elsif($attr eq "is_olson") {
|
|
Packit Service |
f95697 |
croak "is_olson flag specified redundantly"
|
|
Packit Service |
f95697 |
if exists $self->{is_olson};
|
|
Packit Service |
f95697 |
$self->{is_olson} = !!$value;
|
|
Packit Service |
f95697 |
} elsif($attr eq "filename") {
|
|
Packit Service |
f95697 |
croak "filename specified redundantly"
|
|
Packit Service |
f95697 |
if defined($filename) || defined($fh);
|
|
Packit Service |
f95697 |
croak "filename must be a string"
|
|
Packit Service |
f95697 |
unless is_string($value);
|
|
Packit Service |
f95697 |
$filename = $value;
|
|
Packit Service |
f95697 |
} elsif($attr eq "filehandle") {
|
|
Packit Service |
f95697 |
croak "filehandle specified redundantly"
|
|
Packit Service |
f95697 |
if defined($filename) || defined($fh);
|
|
Packit Service |
f95697 |
$fh = $value;
|
|
Packit Service |
f95697 |
} else {
|
|
Packit Service |
f95697 |
croak "unrecognised attribute `$attr'";
|
|
Packit Service |
f95697 |
}
|
|
Packit Service |
f95697 |
}
|
|
Packit Service |
f95697 |
croak "file not specified" unless defined($filename) || defined($fh);
|
|
Packit Service |
f95697 |
unless(exists $self->{name}) {
|
|
Packit Service |
f95697 |
croak "timezone name not specified" unless defined $filename;
|
|
Packit Service |
f95697 |
$self->{name} = $filename;
|
|
Packit Service |
f95697 |
}
|
|
Packit Service |
f95697 |
unless(exists $self->{category}) {
|
|
Packit Service |
f95697 |
$self->{category} = undef;
|
|
Packit Service |
f95697 |
}
|
|
Packit Service |
f95697 |
unless(exists $self->{is_olson}) {
|
|
Packit Service |
f95697 |
$self->{is_olson} = !!0;
|
|
Packit Service |
f95697 |
}
|
|
Packit Service |
f95697 |
if(defined $filename) {
|
|
Packit Service |
f95697 |
($fh = IO::File->new($filename, "r")) && $fh->binmode
|
|
Packit Service |
f95697 |
or croak "can't read $filename: $!";
|
|
Packit Service |
f95697 |
}
|
|
Packit Service |
f95697 |
croak "bad tzfile: wrong magic number"
|
|
Packit Service |
f95697 |
unless _saferead($fh, 4) eq "TZif";
|
|
Packit Service |
f95697 |
my $fmtversion = _saferead($fh, 1);
|
|
Packit Service |
f95697 |
croak "bad tzfile: malformed version number"
|
|
Packit Service |
f95697 |
unless $fmtversion =~ /\A[2-9\0]\z/;
|
|
Packit Service |
f95697 |
_saferead($fh, 15);
|
|
Packit Service |
f95697 |
my($ttisgmtcnt, $ttisstdcnt, $leapcnt, $timecnt, $typecnt, $charcnt) =
|
|
Packit Service |
f95697 |
map { _read_u32($fh) } 1 .. 6;
|
|
Packit Service |
f95697 |
croak "bad tzfile: no local time types" if $typecnt == 0;
|
|
Packit Service |
f95697 |
my @trn_times = map { _read_tm32($fh) } 1 .. $timecnt;
|
|
Packit Service |
f95697 |
my @obs_types = map { _read_u8($fh) } 1 .. $timecnt;
|
|
Packit Service |
f95697 |
my @types = map {
|
|
Packit Service |
f95697 |
[ _read_s32($fh), !!_read_u8($fh), _read_u8($fh) ]
|
|
Packit Service |
f95697 |
} 1 .. $typecnt;
|
|
Packit Service |
f95697 |
my $chars = _saferead($fh, $charcnt);
|
|
Packit Service |
f95697 |
for(my $i = $leapcnt; $i--; ) { _saferead($fh, 8); }
|
|
Packit Service |
f95697 |
for(my $i = $ttisstdcnt; $i--; ) { _saferead($fh, 1); }
|
|
Packit Service |
f95697 |
for(my $i = $ttisgmtcnt; $i--; ) { _saferead($fh, 1); }
|
|
Packit Service |
f95697 |
my $late_rule;
|
|
Packit Service |
f95697 |
if($fmtversion ge "2") {
|
|
Packit Service |
f95697 |
croak "bad tzfile: wrong magic number"
|
|
Packit Service |
f95697 |
unless _saferead($fh, 4) eq "TZif";
|
|
Packit Service |
f95697 |
_saferead($fh, 16);
|
|
Packit Service |
f95697 |
($ttisgmtcnt, $ttisstdcnt, $leapcnt,
|
|
Packit Service |
f95697 |
$timecnt, $typecnt, $charcnt) =
|
|
Packit Service |
f95697 |
map { _read_u32($fh) } 1 .. 6;
|
|
Packit Service |
f95697 |
croak "bad tzfile: no local time types" if $typecnt == 0;
|
|
Packit Service |
f95697 |
@trn_times = map { _read_tm64($fh) } 1 .. $timecnt;
|
|
Packit Service |
f95697 |
@obs_types = map { _read_u8($fh) } 1 .. $timecnt;
|
|
Packit Service |
f95697 |
@types = map {
|
|
Packit Service |
f95697 |
[ _read_s32($fh), !!_read_u8($fh), _read_u8($fh) ]
|
|
Packit Service |
f95697 |
} 1 .. $typecnt;
|
|
Packit Service |
f95697 |
$chars = _saferead($fh, $charcnt);
|
|
Packit Service |
f95697 |
for(my $i = $leapcnt; $i--; ) { _saferead($fh, 12); }
|
|
Packit Service |
f95697 |
for(my $i = $ttisstdcnt; $i--; ) { _saferead($fh, 1); }
|
|
Packit Service |
f95697 |
for(my $i = $ttisgmtcnt; $i--; ) { _saferead($fh, 1); }
|
|
Packit Service |
f95697 |
croak "bad tzfile: missing newline"
|
|
Packit Service |
f95697 |
unless _saferead($fh, 1) eq "\x0a";
|
|
Packit Service |
f95697 |
$late_rule = "";
|
|
Packit Service |
f95697 |
while(1) {
|
|
Packit Service |
f95697 |
my $c = _saferead($fh, 1);
|
|
Packit Service |
f95697 |
last if $c eq "\x0a";
|
|
Packit Service |
f95697 |
$late_rule .= $c;
|
|
Packit Service |
f95697 |
}
|
|
Packit Service |
f95697 |
}
|
|
Packit Service |
f95697 |
$fh = undef;
|
|
Packit Service |
f95697 |
for(my $i = @trn_times - 1; $i-- > 0; ) {
|
|
Packit Service |
f95697 |
unless(($trn_times[$i]->[0] <=> $trn_times[$i+1]->[0] ||
|
|
Packit Service |
f95697 |
$trn_times[$i]->[1] <=> $trn_times[$i+1]->[1]) == -1) {
|
|
Packit Service |
f95697 |
croak "bad tzfile: unsorted change times";
|
|
Packit Service |
f95697 |
}
|
|
Packit Service |
f95697 |
}
|
|
Packit Service |
f95697 |
my $first_std_type_index;
|
|
Packit Service |
f95697 |
my %offsets;
|
|
Packit Service |
f95697 |
for(my $i = 0; $i != $typecnt; $i++) {
|
|
Packit Service |
f95697 |
my $abbrind = $types[$i]->[2];
|
|
Packit Service |
f95697 |
croak "bad tzfile: invalid abbreviation index"
|
|
Packit Service |
f95697 |
if $abbrind > $charcnt;
|
|
Packit Service |
f95697 |
pos($chars) = $abbrind;
|
|
Packit Service |
f95697 |
$chars =~ /\G([^\0]*)/g;
|
|
Packit Service |
f95697 |
$types[$i]->[2] = $1;
|
|
Packit Service |
f95697 |
$first_std_type_index = $i
|
|
Packit Service |
f95697 |
if !defined($first_std_type_index) && !$types[$i]->[1];
|
|
Packit Service |
f95697 |
$self->{has_dst} = 1 if $types[$i]->[1];
|
|
Packit Service |
f95697 |
if($types[$i]->[0] == 0 && !$types[$i]->[1] &&
|
|
Packit Service |
f95697 |
$types[$i]->[2] eq "zzz") {
|
|
Packit Service |
f95697 |
# "zzz" means the zone is not defined at this time,
|
|
Packit Service |
f95697 |
# due for example to the location being uninhabited
|
|
Packit Service |
f95697 |
$types[$i] = "zone disuse";
|
|
Packit Service |
f95697 |
} else {
|
|
Packit Service |
f95697 |
$offsets{$types[$i]->[0]} = undef;
|
|
Packit Service |
f95697 |
}
|
|
Packit Service |
f95697 |
}
|
|
Packit Service |
f95697 |
unshift @obs_types,
|
|
Packit Service |
f95697 |
defined($first_std_type_index) ? $first_std_type_index : 0;
|
|
Packit Service |
f95697 |
foreach my $obs_type (@obs_types) {
|
|
Packit Service |
f95697 |
croak "bad tzfile: invalid local time type index"
|
|
Packit Service |
f95697 |
if $obs_type >= $typecnt;
|
|
Packit Service |
f95697 |
$obs_type = $types[$obs_type];
|
|
Packit Service |
f95697 |
}
|
|
Packit Service |
f95697 |
if(defined($late_rule) && $late_rule eq "<$factory_abbr>0" &&
|
|
Packit Service |
f95697 |
defined($obs_types[-1]) && $obs_types[-1]->[0] == 0 &&
|
|
Packit Service |
f95697 |
!$obs_types[-1]->[1] &&
|
|
Packit Service |
f95697 |
$obs_types[-1]->[2] eq $factory_abbr) {
|
|
Packit Service |
f95697 |
# This bizarre timezone abbreviation is used in the Factory
|
|
Packit Service |
f95697 |
# timezone in the Olson database. It's not valid in a
|
|
Packit Service |
f95697 |
# SysV-style TZ value, because it contains spaces, but zic
|
|
Packit Service |
f95697 |
# puts it into one anyway because the file format demands
|
|
Packit Service |
f95697 |
# it. DT:TZ:SystemV would object, so as a special
|
|
Packit Service |
f95697 |
# exception we ignore the TZ value in this case.
|
|
Packit Service |
f95697 |
$late_rule = undef;
|
|
Packit Service |
f95697 |
}
|
|
Packit Service |
f95697 |
if(defined $late_rule) {
|
|
Packit Service |
f95697 |
if($late_rule eq "") {
|
|
Packit Service |
f95697 |
$obs_types[-1] = "missing data";
|
|
Packit Service |
f95697 |
} elsif($late_rule =~
|
|
Packit Service |
f95697 |
/\A(?:zzz|<zzz>)[-+]?00?(?::00(?::00)?)?\z/) {
|
|
Packit Service |
f95697 |
$obs_types[-1] = "zone disuse";
|
|
Packit Service |
f95697 |
} else {
|
|
Packit Service |
f95697 |
require DateTime::TimeZone::SystemV;
|
|
Packit Service |
f95697 |
DateTime::TimeZone::SystemV->VERSION("0.009");
|
|
Packit Service |
f95697 |
$obs_types[-1] =
|
|
Packit Service |
f95697 |
DateTime::TimeZone::SystemV->new(
|
|
Packit Service |
f95697 |
system => $fmtversion ge "3" ?
|
|
Packit Service |
f95697 |
"tzfile3" : "posix",
|
|
Packit Service |
f95697 |
recipe => $late_rule);
|
|
Packit Service |
f95697 |
}
|
|
Packit Service |
f95697 |
}
|
|
Packit Service |
f95697 |
$self->{trn_times} = \@trn_times;
|
|
Packit Service |
f95697 |
$self->{obs_types} = \@obs_types;
|
|
Packit Service |
f95697 |
$self->{offsets} = [ sort { $a <=> $b } keys %offsets ];
|
|
Packit Service |
f95697 |
return $self;
|
|
Packit Service |
f95697 |
}
|
|
Packit Service |
f95697 |
|
|
Packit Service |
f95697 |
sub _present_rdn_sod($$) {
|
|
Packit Service |
f95697 |
my($rdn, $sod) = @_;
|
|
Packit Service |
f95697 |
return sprintf("%sT%02d:%02d:%02d",
|
|
Packit Service |
f95697 |
present_ymd($rdn + $rdn_epoch_cjdn),
|
|
Packit Service |
f95697 |
int($sod/3600), int($sod/60)%60, $sod%60);
|
|
Packit Service |
f95697 |
}
|
|
Packit Service |
f95697 |
|
|
Packit Service |
f95697 |
=back
|
|
Packit Service |
f95697 |
|
|
Packit Service |
f95697 |
=head1 METHODS
|
|
Packit Service |
f95697 |
|
|
Packit Service |
f95697 |
These methods are all part of the L<DateTime::TimeZone> interface.
|
|
Packit Service |
f95697 |
See that class for the general meaning of these methods; the documentation
|
|
Packit Service |
f95697 |
below only comments on the specific behaviour of this class.
|
|
Packit Service |
f95697 |
|
|
Packit Service |
f95697 |
=head2 Identification
|
|
Packit Service |
f95697 |
|
|
Packit Service |
f95697 |
=over
|
|
Packit Service |
f95697 |
|
|
Packit Service |
f95697 |
=item $tz->is_floating
|
|
Packit Service |
f95697 |
|
|
Packit Service |
f95697 |
Returns false.
|
|
Packit Service |
f95697 |
|
|
Packit Service |
f95697 |
=cut
|
|
Packit Service |
f95697 |
|
|
Packit Service |
f95697 |
sub is_floating { 0 }
|
|
Packit Service |
f95697 |
|
|
Packit Service |
f95697 |
=item $tz->is_utc
|
|
Packit Service |
f95697 |
|
|
Packit Service |
f95697 |
Returns false.
|
|
Packit Service |
f95697 |
|
|
Packit Service |
f95697 |
=cut
|
|
Packit Service |
f95697 |
|
|
Packit Service |
f95697 |
sub is_utc { 0 }
|
|
Packit Service |
f95697 |
|
|
Packit Service |
f95697 |
=item $tz->is_olson
|
|
Packit Service |
f95697 |
|
|
Packit Service |
f95697 |
Returns the truth value that was provided to the constructor for this
|
|
Packit Service |
f95697 |
purpose, default false. This nominally indicates whether the timezone
|
|
Packit Service |
f95697 |
data is from the Olson database. The files interpreted by this class
|
|
Packit Service |
f95697 |
are very likely to be from the Olson database, but there is no explicit
|
|
Packit Service |
f95697 |
indicator for this in the file, so this information must be supplied to
|
|
Packit Service |
f95697 |
the constructor if required.
|
|
Packit Service |
f95697 |
|
|
Packit Service |
f95697 |
=cut
|
|
Packit Service |
f95697 |
|
|
Packit Service |
f95697 |
sub is_olson { $_[0]->{is_olson} }
|
|
Packit Service |
f95697 |
|
|
Packit Service |
f95697 |
=item $tz->category
|
|
Packit Service |
f95697 |
|
|
Packit Service |
f95697 |
Returns the value that was provided to the constructor for this purpose,
|
|
Packit Service |
f95697 |
default C<undef>. This is intended to indicate the general region
|
|
Packit Service |
f95697 |
(continent or ocean) in which a geographical timezone is used, when
|
|
Packit Service |
f95697 |
the timezone is named according to the hierarchical scheme of the Olson
|
|
Packit Service |
f95697 |
timezone database.
|
|
Packit Service |
f95697 |
|
|
Packit Service |
f95697 |
=cut
|
|
Packit Service |
f95697 |
|
|
Packit Service |
f95697 |
sub category { $_[0]->{category} }
|
|
Packit Service |
f95697 |
|
|
Packit Service |
f95697 |
=item $tz->name
|
|
Packit Service |
f95697 |
|
|
Packit Service |
f95697 |
Returns the timezone name. Usually this is the filename that was supplied
|
|
Packit Service |
f95697 |
to the constructor, but it can be overridden by the constructor's B<name>
|
|
Packit Service |
f95697 |
attribute.
|
|
Packit Service |
f95697 |
|
|
Packit Service |
f95697 |
=cut
|
|
Packit Service |
f95697 |
|
|
Packit Service |
f95697 |
sub name { $_[0]->{name} }
|
|
Packit Service |
f95697 |
|
|
Packit Service |
f95697 |
=back
|
|
Packit Service |
f95697 |
|
|
Packit Service |
f95697 |
=head2 Offsets
|
|
Packit Service |
f95697 |
|
|
Packit Service |
f95697 |
=over
|
|
Packit Service |
f95697 |
|
|
Packit Service |
f95697 |
=item $tz->has_dst_changes
|
|
Packit Service |
f95697 |
|
|
Packit Service |
f95697 |
Returns a truth value indicating whether any of the observances in the file
|
|
Packit Service |
f95697 |
are marked as DST. These DST flags are potentially arbitrary, and don't
|
|
Packit Service |
f95697 |
affect any of the zone's behaviour.
|
|
Packit Service |
f95697 |
|
|
Packit Service |
f95697 |
=cut
|
|
Packit Service |
f95697 |
|
|
Packit Service |
f95697 |
sub has_dst_changes { $_[0]->{has_dst} }
|
|
Packit Service |
f95697 |
|
|
Packit Service |
f95697 |
#
|
|
Packit Service |
f95697 |
# observance lookup
|
|
Packit Service |
f95697 |
#
|
|
Packit Service |
f95697 |
|
|
Packit Service |
f95697 |
sub _type_for_rdn_sod {
|
|
Packit Service |
f95697 |
my($self, $utc_rdn, $utc_sod) = @_;
|
|
Packit Service |
f95697 |
my $lo = 0;
|
|
Packit Service |
f95697 |
my $hi = @{$self->{trn_times}};
|
|
Packit Service |
f95697 |
while($lo != $hi) {
|
|
Packit Service |
f95697 |
my $try = do { use integer; ($lo + $hi) / 2 };
|
|
Packit Service |
f95697 |
if(($utc_rdn <=> $self->{trn_times}->[$try]->[0] ||
|
|
Packit Service |
f95697 |
$utc_sod <=> $self->{trn_times}->[$try]->[1]) == -1) {
|
|
Packit Service |
f95697 |
$hi = $try;
|
|
Packit Service |
f95697 |
} else {
|
|
Packit Service |
f95697 |
$lo = $try + 1;
|
|
Packit Service |
f95697 |
}
|
|
Packit Service |
f95697 |
}
|
|
Packit Service |
f95697 |
return $self->{obs_types}->[$lo];
|
|
Packit Service |
f95697 |
}
|
|
Packit Service |
f95697 |
|
|
Packit Service |
f95697 |
sub _type_for_datetime {
|
|
Packit Service |
f95697 |
my($self, $dt) = @_;
|
|
Packit Service |
f95697 |
my($utc_rdn, $utc_sod) = $dt->utc_rd_values;
|
|
Packit Service |
f95697 |
$utc_sod = 86399 if $utc_sod >= 86400;
|
|
Packit Service |
f95697 |
my $type = $self->_type_for_rdn_sod($utc_rdn, $utc_sod);
|
|
Packit Service |
f95697 |
if(is_string($type)) {
|
|
Packit Service |
f95697 |
croak "time @{[_present_rdn_sod($utc_rdn, $utc_sod)]}Z ".
|
|
Packit Service |
f95697 |
"is not represented ".
|
|
Packit Service |
f95697 |
"in the @{[$self->{name}]} timezone ".
|
|
Packit Service |
f95697 |
"due to $type";
|
|
Packit Service |
f95697 |
}
|
|
Packit Service |
f95697 |
return $type;
|
|
Packit Service |
f95697 |
}
|
|
Packit Service |
f95697 |
|
|
Packit Service |
f95697 |
=item $tz->offset_for_datetime(DT)
|
|
Packit Service |
f95697 |
|
|
Packit Service |
f95697 |
I must be a L<DateTime>-compatible object (specifically, it must
|
|
Packit Service |
f95697 |
implement the C<utc_rd_values> method). Returns the offset from UT that
|
|
Packit Service |
f95697 |
is in effect at the instant represented by I, in seconds.
|
|
Packit Service |
f95697 |
|
|
Packit Service |
f95697 |
=cut
|
|
Packit Service |
f95697 |
|
|
Packit Service |
f95697 |
sub offset_for_datetime {
|
|
Packit Service |
f95697 |
my($self, $dt) = @_;
|
|
Packit Service |
f95697 |
my $type = $self->_type_for_datetime($dt);
|
|
Packit Service |
f95697 |
return is_ref($type, "ARRAY") ? $type->[0] :
|
|
Packit Service |
f95697 |
$type->offset_for_datetime($dt);
|
|
Packit Service |
f95697 |
}
|
|
Packit Service |
f95697 |
|
|
Packit Service |
f95697 |
=item $tz->is_dst_for_datetime(DT)
|
|
Packit Service |
f95697 |
|
|
Packit Service |
f95697 |
I must be a L<DateTime>-compatible object (specifically, it must
|
|
Packit Service |
f95697 |
implement the C<utc_rd_values> method). Returns a truth value indicating
|
|
Packit Service |
f95697 |
whether the timezone's observance at the instant represented by I
|
|
Packit Service |
f95697 |
is marked as DST. This DST flag is potentially arbitrary, and doesn't
|
|
Packit Service |
f95697 |
affect anything else.
|
|
Packit Service |
f95697 |
|
|
Packit Service |
f95697 |
=cut
|
|
Packit Service |
f95697 |
|
|
Packit Service |
f95697 |
sub is_dst_for_datetime {
|
|
Packit Service |
f95697 |
my($self, $dt) = @_;
|
|
Packit Service |
f95697 |
my $type = $self->_type_for_datetime($dt);
|
|
Packit Service |
f95697 |
return is_ref($type, "ARRAY") ? $type->[1] :
|
|
Packit Service |
f95697 |
$type->is_dst_for_datetime($dt);
|
|
Packit Service |
f95697 |
}
|
|
Packit Service |
f95697 |
|
|
Packit Service |
f95697 |
=item $tz->short_name_for_datetime(DT)
|
|
Packit Service |
f95697 |
|
|
Packit Service |
f95697 |
I must be a L<DateTime>-compatible object (specifically, it must
|
|
Packit Service |
f95697 |
implement the C<utc_rd_values> method). Returns the abbreviation
|
|
Packit Service |
f95697 |
used to label the time scale at the instant represented by I.
|
|
Packit Service |
f95697 |
This abbreviation is potentially arbitrary, and does not uniquely identify
|
|
Packit Service |
f95697 |
either the timezone or the offset.
|
|
Packit Service |
f95697 |
|
|
Packit Service |
f95697 |
=cut
|
|
Packit Service |
f95697 |
|
|
Packit Service |
f95697 |
sub short_name_for_datetime {
|
|
Packit Service |
f95697 |
my($self, $dt) = @_;
|
|
Packit Service |
f95697 |
my $type = $self->_type_for_datetime($dt);
|
|
Packit Service |
f95697 |
return is_ref($type, "ARRAY") ? $type->[2] :
|
|
Packit Service |
f95697 |
$type->short_name_for_datetime($dt);
|
|
Packit Service |
f95697 |
}
|
|
Packit Service |
f95697 |
|
|
Packit Service |
f95697 |
=item $tz->offset_for_local_datetime(DT)
|
|
Packit Service |
f95697 |
|
|
Packit Service |
f95697 |
I must be a L<DateTime>-compatible object (specifically, it
|
|
Packit Service |
f95697 |
must implement the C<local_rd_values> method). Takes the local
|
|
Packit Service |
f95697 |
time represented by I (regardless of what absolute time it also
|
|
Packit Service |
f95697 |
represents), and interprets that as a local time in the timezone of the
|
|
Packit Service |
f95697 |
timezone object (not the timezone used in I). Returns the offset
|
|
Packit Service |
f95697 |
from UT that is in effect at that local time, in seconds.
|
|
Packit Service |
f95697 |
|
|
Packit Service |
f95697 |
If the local time given is ambiguous due to a nearby offset change,
|
|
Packit Service |
f95697 |
the numerically lowest offset (usually the standard one) is returned
|
|
Packit Service |
f95697 |
with no warning of the situation. (Equivalently: the latest possible
|
|
Packit Service |
f95697 |
absolute time is indicated.) If the local time given does not exist
|
|
Packit Service |
f95697 |
due to a nearby offset change, the method C<die>s saying so.
|
|
Packit Service |
f95697 |
|
|
Packit Service |
f95697 |
=cut
|
|
Packit Service |
f95697 |
|
|
Packit Service |
f95697 |
sub _local_to_utc_rdn_sod($$$) {
|
|
Packit Service |
f95697 |
my($rdn, $sod, $offset) = @_;
|
|
Packit Service |
f95697 |
$sod -= $offset;
|
|
Packit Service |
f95697 |
while($sod < 0) {
|
|
Packit Service |
f95697 |
$rdn--;
|
|
Packit Service |
f95697 |
$sod += 86400;
|
|
Packit Service |
f95697 |
}
|
|
Packit Service |
f95697 |
while($sod >= 86400) {
|
|
Packit Service |
f95697 |
$rdn++;
|
|
Packit Service |
f95697 |
$sod -= 86400;
|
|
Packit Service |
f95697 |
}
|
|
Packit Service |
f95697 |
return ($rdn, $sod);
|
|
Packit Service |
f95697 |
}
|
|
Packit Service |
f95697 |
|
|
Packit Service |
f95697 |
sub offset_for_local_datetime {
|
|
Packit Service |
f95697 |
my($self, $dt) = @_;
|
|
Packit Service |
f95697 |
my($lcl_rdn, $lcl_sod) = $dt->local_rd_values;
|
|
Packit Service |
f95697 |
$lcl_sod = 86399 if $lcl_sod >= 86400;
|
|
Packit Service |
f95697 |
my %seen_error;
|
|
Packit Service |
f95697 |
foreach my $offset (@{$self->{offsets}}) {
|
|
Packit Service |
f95697 |
my($utc_rdn, $utc_sod) =
|
|
Packit Service |
f95697 |
_local_to_utc_rdn_sod($lcl_rdn, $lcl_sod, $offset);
|
|
Packit Service |
f95697 |
my $ttype = $self->_type_for_rdn_sod($utc_rdn, $utc_sod);
|
|
Packit Service |
f95697 |
if(is_string($ttype)) {
|
|
Packit Service |
f95697 |
$seen_error{$ttype} = undef;
|
|
Packit Service |
f95697 |
next;
|
|
Packit Service |
f95697 |
}
|
|
Packit Service |
f95697 |
my $local_offset = is_ref($ttype, "ARRAY") ? $ttype->[0] :
|
|
Packit Service |
f95697 |
eval { local $SIG{__DIE__};
|
|
Packit Service |
f95697 |
$ttype->offset_for_local_datetime($dt);
|
|
Packit Service |
f95697 |
};
|
|
Packit Service |
f95697 |
return $offset
|
|
Packit Service |
f95697 |
if defined($local_offset) && $local_offset == $offset;
|
|
Packit Service |
f95697 |
}
|
|
Packit Service |
f95697 |
my $error;
|
|
Packit Service |
f95697 |
foreach("zone disuse", "missing data") {
|
|
Packit Service |
f95697 |
if(exists $seen_error{$_}) {
|
|
Packit Service |
f95697 |
$error = $_;
|
|
Packit Service |
f95697 |
last;
|
|
Packit Service |
f95697 |
}
|
|
Packit Service |
f95697 |
}
|
|
Packit Service |
f95697 |
$error ||= "offset change";
|
|
Packit Service |
f95697 |
croak "local time @{[_present_rdn_sod($lcl_rdn, $lcl_sod)]} ".
|
|
Packit Service |
f95697 |
"does not exist in the @{[$self->{name}]} timezone ".
|
|
Packit Service |
f95697 |
"due to $error";
|
|
Packit Service |
f95697 |
}
|
|
Packit Service |
f95697 |
|
|
Packit Service |
f95697 |
=back
|
|
Packit Service |
f95697 |
|
|
Packit Service |
f95697 |
=head1 SEE ALSO
|
|
Packit Service |
f95697 |
|
|
Packit Service |
f95697 |
L<DateTime>,
|
|
Packit Service |
f95697 |
L<DateTime::TimeZone>,
|
|
Packit Service |
f95697 |
L<DateTime::TimeZone::Olson>,
|
|
Packit Service |
f95697 |
L<Time::OlsonTZ::Data>,
|
|
Packit Service |
f95697 |
L<Time::OlsonTZ::Download>,
|
|
Packit Service |
f95697 |
L<tzfile(5)>
|
|
Packit Service |
f95697 |
|
|
Packit Service |
f95697 |
=head1 AUTHOR
|
|
Packit Service |
f95697 |
|
|
Packit Service |
f95697 |
Andrew Main (Zefram) <zefram@fysh.org>
|
|
Packit Service |
f95697 |
|
|
Packit Service |
f95697 |
=head1 COPYRIGHT
|
|
Packit Service |
f95697 |
|
|
Packit Service |
f95697 |
Copyright (C) 2007, 2009, 2010, 2011, 2012, 2013, 2017
|
|
Packit Service |
f95697 |
Andrew Main (Zefram) <zefram@fysh.org>
|
|
Packit Service |
f95697 |
|
|
Packit Service |
f95697 |
=head1 LICENSE
|
|
Packit Service |
f95697 |
|
|
Packit Service |
f95697 |
This module is free software; you can redistribute it and/or modify it
|
|
Packit Service |
f95697 |
under the same terms as Perl itself.
|
|
Packit Service |
f95697 |
|
|
Packit Service |
f95697 |
=cut
|
|
Packit Service |
f95697 |
|
|
Packit Service |
f95697 |
1;
|