File Coverage

blib/lib/Time/Tzfile.pm

Criterion	Covered	Total	%
statement	9	9	100.0
branch			n/a
condition			n/a
subroutine	3	3	100.0
pod			n/a
total	12	12	100.0

package Time::Tzfile;
$Time::Tzfile::VERSION = '0.03';
use strict;
use warnings;

use autodie ':all';
use Config;

#ABSTRACT: read binary tzfiles into Perl data structures


sub parse {
  my ($class, $args) = @_;

  my $tzdata = parse_raw($class, $args);

  my $abbrev = $tzdata->[4][0];
  # swap null char for pipe so length() works
  $abbrev =~ s/\0/|/g;

  my @timestamps = ();
  for (0..$#{$tzdata->[2]})
  {
    my $struct = $tzdata->[3][ $tzdata->[2][$_] ];
    my $abbr_substring = substr $abbrev, $struct->[2];
    my ($abbrev, $junk) = split /\|/, $abbr_substring, 2;
    push @timestamps, {
      epoch => $tzdata->[1][$_],
      offset=> $struct->[0],
      is_dst=> $struct->[1],
      type  => $abbrev,
    };
  }
  return \@timestamps;
}


sub parse_raw {
  my ($class, $args) = @_;

  open my $fh, '<:raw', $args->{filename};
  my $use_version_one = $args->{use_version_one};
  my $header = parse_header($fh);

  if ($header->[1] == 2 # it will have the 64 bit entries
      && !$use_version_one  # not forcing to 32bit timestamps
      && ($Config{use64bitint} eq 'define' # Perl is 64bit int capable
          || $Config{longsize} >= 8)
     ) {

    # jump past the version one body
    skip_to_next_record($fh, $header);

    # parse the v2 header
    $header = parse_header($fh);

    return [
      $header,
      parse_time_counts_64($fh, $header),
      parse_time_type_indices($fh, $header),
      parse_types($fh, $header),
      parse_timezone_abbrev($fh, $header),
      parse_leap_seconds_64($fh, $header),
      parse_std($fh, $header),
      parse_gmt($fh, $header),
    ];
  }
  else {
    return [
      $header,
      parse_time_counts($fh, $header),
      parse_time_type_indices($fh, $header),
      parse_types($fh, $header),
      parse_timezone_abbrev($fh, $header),
      parse_leap_seconds($fh, $header),
      parse_std($fh, $header),
      parse_gmt($fh, $header),
    ];
  }
}

sub parse_bytes (*$@) {
  my ($fh, $bytes_to_read, $template) = @_;

  my $bytes_read = read $fh, my($bytes), $bytes_to_read;
  die "Expected $bytes_to_read bytes but got $bytes_read"
    unless $bytes_read == $bytes_to_read;

  return [] unless $template;

  my @data = unpack $template, $bytes;
  return \@data;
}

sub parse_header {
  my ($fh) = @_;
  my $header = parse_bytes($fh, 44, 'a4 a x15 N N N N N N');

  die 'This file does not appear to be a tzfile'
    if $header->[0] ne 'TZif';

  return $header;
}

sub parse_time_counts {
  my ($fh, $header) = @_;
  my $byte_count    =  4   * $header->[5];
  my $template      = 'l>' x $header->[5];
  return parse_bytes($fh, $byte_count, $template);
}

sub parse_time_counts_64 {
  my ($fh, $header) = @_;
  my $byte_count    =  8  * $header->[5];
  my $template      = 'q>' x $header->[5];
  return parse_bytes($fh, $byte_count, $template);
}

sub parse_time_type_indices {
  my ($fh, $header) = @_;
  my $byte_count    = 1   * $header->[5];
  my $template      = 'C' x $header->[5];
  return parse_bytes($fh, $byte_count, $template);
}

sub parse_types {
  my ($fh, $header) = @_;
  my $byte_count    = 6     * $header->[6];
  my $template      = 'l>cC' x $header->[6];
  my $data          = parse_bytes($fh, $byte_count, $template);

  my @mappings   = ();
  for (my $i = 0; $i < @$data-2; $i += 3) {
    push @mappings, [
      $data->[$i],
      $data->[$i + 1],
      $data->[$i + 2],
    ];
  }
  return \@mappings;
}

sub parse_timezone_abbrev {
  my ($fh, $header) = @_;
  my $byte_count    = 1   * $header->[7];
  my $template      = 'a' . $header->[7];
  return parse_bytes($fh, $byte_count, $template);
}

sub parse_leap_seconds {
  my ($fh, $header) = @_;
  my $byte_count    = 8      * $header->[4];
  my $template      = 'l>l>' x $header->[4];
  my $data          = parse_bytes($fh, $byte_count, $template);
  my @mappings   = ();
  for (my $i = 0; $i < @$data-1; $i += 2) {
    push @mappings, {
      timestamp => $data->[$i],
      offset    => $data->[$i + 1],
    };
  }
  return \@mappings;
}

sub parse_leap_seconds_64 {
  my ($fh, $header) = @_;
  my $byte_count    = 12     * $header->[4];
  my $template      = 'q>l>' x $header->[4];
  my $data          = parse_bytes($fh, $byte_count, $template);
  my @mappings   = ();
  for (my $i = 0; $i < @$data-1; $i += 2) {
    push @mappings, [
      $data->[$i],
      $data->[$i + 1],
    ];
  }
  return \@mappings;
}

sub parse_gmt {
  my ($fh, $header) = @_;
  my $byte_count    = 1   * $header->[2];
  my $template      = 'c' x $header->[2];
  return parse_bytes($fh, $byte_count, $template);
}

sub parse_std {
  my ($fh, $header) = @_;
  my $byte_count    = 1   * $header->[3];
  my $template      = 'c' x $header->[3];
  return parse_bytes($fh, $byte_count, $template);
}

sub skip_to_next_record {
  my ($fh, $header) = @_;
  my $bytes_to_skip = 4 * $header->[5]
                    + 1 * $header->[5]
                    + 6 * $header->[6]
                    + 1 * $header->[7]
                    + 8 * $header->[4]
                    + 1 * $header->[2]
                    + 1 * $header->[3];
  parse_bytes($fh, $bytes_to_skip);
}


1;

__END__