File Coverage

blib/lib/Time/OlsonTZ/Clustered.pm

Criterion	Covered	Total	%
statement	68	68	100.0
branch	19	22	86.3
condition	5	7	71.4
subroutine	18	18	100.0
pod	7	7	100.0
total	117	122	95.9

use 5.008001;
use strict;
use warnings;

package Time::OlsonTZ::Clustered;
# ABSTRACT: Olson time zone clusters based on similar offset and DST changes
our $VERSION = '0.002'; # VERSION

use Sub::Exporter -setup => {
    exports => [
        qw/find_cluster find_primary is_primary primary_zones timezone_clusters country_codes country_name/
    ]
};

use File::ShareDir::Tarball qw/dist_file/;
use Path::Class;
use Sereal::Encoder qw/encode_sereal/;
use Sereal::Decoder qw/decode_sereal/;

{
    my $clusters;
    my $reverse;

    sub _clusters {
        return $clusters if defined $clusters;
        my $file = dist_file( 'Time-OlsonTZ-Clustered', 'cluster.srl' )
          or die "Can't find cluster.srl in distribution share data";
        $clusters = decode_sereal( scalar file($file)->slurp );
    }

    sub _get_country {
        my ($code) = shift;
        my $cluster = _clusters()->{ uc $code };
        return $cluster ? decode_sereal( encode_sereal($cluster) ) : undef;
    }

    sub _reverse_map {
        return $reverse if defined $reverse;
        my $file = dist_file( 'Time-OlsonTZ-Clustered', 'reverse.srl' )
          or die "Can't find reverse.srl in distribution share data";
        $reverse = decode_sereal( scalar file($file)->slurp );
    }
}

#--------------------------------------------------------------------------#
# high level functions
#--------------------------------------------------------------------------#


sub primary_zones {
    my ($code) = @_;

    my $country = _get_country($code)
      or return [];
    my $clusters     = $country->{clusters};
    my $order        = $country->{cluster_order};
    my $country_name = $country->{olson_name};

    my @zones;
    for my $c (@$order) {
        my $description = $clusters->{$c}{description};
        my $first       = $clusters->{$c}{zones}[0];
        my %primary     = (
            description => $description || $country_name,
            offset => $first->{offset},
            timezone_name => $first->{timezone_name},
        );
        push @zones, \%primary;
    }
    return \@zones;
}


sub find_primary {
    my ($zone) = @_;
    my $cluster = find_cluster($zone)
      or return;
    return $cluster->{zones}[0]{timezone_name};
}


sub is_primary {
    my ($zone) = @_;
    my $primary = find_primary($zone) || '';
    return $primary eq $zone;
}

#--------------------------------------------------------------------------#
# lower level functions
#--------------------------------------------------------------------------#


sub country_codes {
    my @list = sort keys %{ _clusters() };
    return @list;
}


sub country_name {
    my ($code) = @_;
    my $country = _get_country($code)
      or return '';
    return $country->{olson_name} || '';
}


sub timezone_clusters {
    my ($code) = @_;
    my $country = _get_country($code)
      or return [];
    my $clusters = $country->{clusters};
    my $order    = $country->{cluster_order};

    return [ map { $clusters->{$_} } @$order ];
}


sub find_cluster {
    my ($zone) = @_;
    my $reverse = _reverse_map()->{$zone}
      or return;
    my ( $code, $digest ) = @$reverse;
    my $country = _get_country($code)
      or return;
    return $country->{clusters}{$digest};
}

1;


# vim: ts=4 sts=4 sw=4 et:

__END__