File Coverage

blib/lib/DateTime/TimeZone/HPUX.pm

Criterion	Covered	Total	%
statement	42	71	59.1
branch	13	38	34.2
condition	2	3	66.6
subroutine	6	7	85.7
pod	1	1	100.0
total	64	120	53.3

use strict;
use warnings;

package DateTime::TimeZone::HPUX;

use Carp qw/carp croak/;

our $VERSION = '1.04';

our @JAVA_HOMES = (
    '/opt/java1.4',
);

{
    my $_java_bin;
    sub _java_bin
    {
        return $_java_bin if defined $_java_bin;
        $_java_bin = ''; # Default value: java not found (false)
        foreach (
                (map { ("$_/jre/bin/java", "$_/bin/java") }
                     (exists $ENV{JAVA_HOME} ? ($ENV{JAVA_HOME}) : ()),
                     @JAVA_HOMES,
                ),
                (map { "$_/java" } split(/:/, $ENV{PATH}) ),
            ) {
            next unless -x "$_";
            $_java_bin = $_;
            last;
        }
        return $_java_bin;
    }
}


{
    my $_classes_dir;
sub _olson_from_java
{
    my $name;
    my $java_bin = _java_bin();
    if (@_ && $_[0]) {
        $name = $_[0];
    }

    # Set the Java environment
    unless (defined $_classes_dir) {
        my $pm = __PACKAGE__.".pm";
        $pm =~ s!::!/!g;
        $pm = $INC{$pm};
        $_classes_dir = $pm;
        $_classes_dir =~ s/\.pm$//;
    }

    unless (-r "$_classes_dir/TZ.class") {
        carp "Java class '$_classes_dir/TZ.class' not found.";
        return;
    }
    unless ($java_bin) {
        carp "Java not found.";
        return;
    }

    my $olson;
    # Run the JVM to extract the mapping
    {
        local $ENV{TZ};
        $ENV{TZ} = $name if defined $name;
        $olson = qx!"$java_bin" -cp "$_classes_dir" TZ!;
    }
    # Java returns "GMT" for unknown timezones
    return undef unless $olson =~ m!/!;
    chomp $olson;
    return $olson;
}
}


# Returns undef on failure, no exception
sub _hpux_to_olson
{
    my $tz = shift;
    local $@;
    eval { require 'DateTime/TimeZone/HPUX/Map.pm' };
    return undef if $@;
    my $tz_name;
    if (exists $DateTime::TimeZone::HPUX::Map::tz_map{$tz}) {
        $tz_name = $DateTime::TimeZone::HPUX::Map::tz_map{$tz};
    } else {

        # Simple TZ without DST: we can extract reliably an offset
        # This is less clean than what Java /may/ return, but much more faster!
        if ($tz =~ /^([A-Z]{3,})(-?)([1-9]?\d(?::(\d{2}))?)(#\w+)?$/) {
            # Note that GMT+5 gives -0500 as it is how HP-UX handles it
            my ($name, $sign, $offset) = ($1, $2, $3);
            $offset = '0' . $offset if length $offset < 2;
            $offset .= '00' if length $offset == 2;
            # Build a TZ with DT::TZ::OffsetOnly
            # Signs are reversed
            $tz_name = ($sign eq '-' ? '+' : '-') . $offset;
        } else {
            carp("unknown timezone '$tz', trying to resolve it with Java (SLOOOOOW...)");
            $tz_name = _olson_from_java($tz);
        }
        if (defined $tz_name) {
            # Add to the cache
            $DateTime::TimeZone::HPUX::Map::tz_map{$tz} = $tz_name;
        } else {
            return;
        }
    }

    # Build a DateTime::TimeZone object from a TZ name, catching exceptions
    # Returns undef if failure.
    local $@;
    return eval { DateTime::TimeZone->new(name => $tz_name) };
}


# Raise an exception on failure, like DateTime::TimeZone
sub new
{
    my %options = @_;
    croak("Missing 'name' argument") unless exists $options{name};
    my $name = $options{name};
    if ($name eq 'local') {
        return DateTime::TimeZone->new(%options);
    } else {
        my $tz = _hpux_to_olson($name);
        croak("unknown timezone '$tz'") unless defined $tz;
        return $tz;
    }
}



1;
__END__