#!/usr/bin/perl -w
#
# tzdump - dump the contents of a tzfile(5)-format file to stdout
#
# $Id$

use strict;
use Data::Dumper;

sub tzdump {
   my $filename = shift;

   print "$filename:\n";

   if (not open (FILE, $filename)) {
      warn "open $filename: $!\n";
      return;
   }

   my $tzfile = {};
   my $data;

   sysread (FILE, $data, 44) or die;

   my ($header, $reserved, $ttisgmtcnt, $ttisstdcnt, $leapcnt, $timecnt,
       $typecnt, $charcnt) = unpack "a4 a16 N N N N N N", $data;

   if ($header ne "TZif") {
      warn "$filename: Doesn't look like tzfile data\n";
      close FILE;
      return;
   }

   print "ttisgmtcnt=$ttisgmtcnt, ttisstdcnt=$ttisstdcnt, leapcnt=$leapcnt, timecnt=$timecnt, typecnt=$typecnt, charcnt=$charcnt\n";

   my $tzdata;
   my $index = 0;

   sysread (FILE, $tzdata, 5 * $timecnt + 6 * $typecnt + $charcnt +
	    8 * $leapcnt + $ttisstdcnt + $ttisgmtcnt);

   my $tzchunk = sub {
      my $howbig = shift;
      my $chunk = substr ($tzdata, $index, $howbig);
      $index += $howbig;
      $chunk;
   };

   my %ttimes;
   my @ttimes;
   my @ttindexes;

   if ($timecnt) {
      $data = &$tzchunk (4 * $timecnt);
      @ttimes = unpack ("N" x $timecnt, $data);

      $data = &$tzchunk ($timecnt);
      @ttindexes = unpack "C" x $timecnt, $data;

      map { print scalar (localtime ($ttimes[$_])), " => ",
	      $ttindexes[$_], "\n" } 0 .. $#ttimes;
   }

   my @ttinfo;

   foreach (0 .. $typecnt - 1) {
      $data = &$tzchunk (6);
      my ($gmtoff, $isdst, $abbrind) = unpack ("N c C", $data);
      # gmtoff is really a signed long
      $gmtoff = unpack ("l", pack ("L", $gmtoff));
      print "ttinfo[$_]: gmtoff=$gmtoff isdst=$isdst abbrind=$abbrind\n";
      push (@ttinfo, { gmtoff => $gmtoff, idsst => $isdst,
		       abbrev => $abbrind });
   }

   my $tznames;

   if ($charcnt) {
      $tznames = &$tzchunk ($charcnt) or die;
      print "abbrevs: ", join (", ", split /\000/, $tznames), "\n";
   }

   my @leapsecs;

   if ($leapcnt) {
      $data = &$tzchunk (8 * $leapcnt);
      print "leapsecs: ", join (", ", unpack ("NN" x $leapcnt, $data)), "\n";
   }

   if ($ttisstdcnt) {
      $data = &$tzchunk ($ttisstdcnt);
      print "isstd: ", join (", ", unpack ("C" x $ttisstdcnt, $data)), "\n";
   }

   if ($ttisgmtcnt) {
      $data = &$tzchunk ($ttisgmtcnt);
      print "isgmt: ", join(", ", unpack ("C" x $ttisgmtcnt, $data)), "\n";
   }

   close FILE;
}


foreach my $filename (@ARGV) {
   tzdump ($filename);
}
