File Coverage

blib/lib/Time/TZ.pm

Criterion	Covered	Total	%
statement	52	65	80.0
branch	11	20	55.0
condition	5	9	55.5
subroutine	9	10	90.0
pod	6	6	100.0
total	83	110	75.4

# Copyright 2007, 2008, 2009, 2010, 2011, 2019, 2020 Kevin Ryde

# This file is part of Tie-TZ.
#
# Tie-TZ is free software; you can redistribute it and/or modify it under
# the terms of the GNU General Public License as published by the Free
# Software Foundation; either version 3, or (at your option) any later
# version.
#
# Tie-TZ is distributed in the hope that it will be useful, but WITHOUT ANY
# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
# FOR A PARTICULAR PURPOSE.  See the GNU General Public License for more
# details.
#
# You should have received a copy of the GNU General Public License along
# with Tie-TZ.  If not, see .

package Time::TZ;
# require 5;
use strict;
use Carp;
use Tie::TZ;
use vars qw($VERSION);

# uncomment this to run the ### lines
#use Smart::Comments;

$VERSION = 11;

sub new {
  my ($class, %self) = @_;
  my $self = bless \%self, $class;
  unless (delete $self{'defer'}) {
    $self->tz;
  }
  return $self;
}

sub name {
  my ($self) = @_;
  return $self->{'name'};
}

sub tz {
  my ($self) = @_;
  my $choose = delete $self->{'choose'};
  if ($choose) {
    foreach (@$choose) {
      if ($self->tz_known($_)) {
        ### Time-TZ choose: $_
        return ($self->{'tz'} = $_);
      }
    }
    my $name = $self->name;
    my $msg = "TZ" . (defined $name ? " '$name'" : '')
      . ': no zone known to the system among: '
        . join(' ',@$choose);
    if (defined (my $tz = delete $self->{'fallback'})) {
      warn $msg,", using $tz instead\n";
      return ($self->{'tz'} = $tz);
    }
    croak $msg;
  }
  return $self->{'tz'};
}

my %tz_known = (UTC => 1, GMT => 1);
my $zonedir;
sub tz_known {
  my ($class_or_self, $tz) = @_;
  ### tz_known(): $tz
  if (! defined $tz || $tz_known{$tz}) {
    return 1;
  }

  # EST-10 or EST-10EDT etc
  if ($tz =~ /^[A-Z]+[0-9+-]+([A-Z]+)?($|,)/) {
    ### yes, std+offset form
    return 1;
  }

  {
    require File::Spec;
    $zonedir ||= File::Spec->catdir (File::Spec->rootdir,
                                     'usr','share','zoneinfo');
    my $filename = $tz;
    $filename =~ s/^://;
    $filename = File::Spec->rel2abs ($filename, $zonedir);
    ### $filename
    if (-e $filename) {
      ### yes, file exists
      return 1;
    }
  }

  # any hour or minute different from GMT in any of 12 calendar months
  my $timet = time();
  local $Tie::TZ::TZ = $tz;
  foreach (1 .. 12) {
    my $mon = $_;
    my $delta = $mon * 30 * 86400;
    my $t = $timet + $delta;
    my ($l_sec,$l_min,$l_hour,$l_mday,$l_mon,$l_year,$l_wday,$l_yday,$l_isdst)
      = localtime ($t);
    my ($g_sec,$g_min,$g_hour,$g_mday,$g_mon,$g_year,$g_wday,$g_yday,$g_isdst)
      = gmtime ($t);
    if ($l_hour != $g_hour || $l_min != $g_min) {
      ### yes, different from GMT in mon: $mon
      return 1;
    }
  }

  ### no
  return 0;
}

sub localtime {
  my ($self, $timet) = @_;
  if (! defined $timet) { $timet = time(); }
  local $Tie::TZ::TZ = $self->tz;
  return localtime ($timet);
}

sub call {
  my $self = shift;
  my $subr = shift;
  local $Tie::TZ::TZ = $self->tz;
  return &$subr(@_);
}

1;
__END__