#!perl
use 5.010;
use strict;
use warnings;
use Archive::Tar;
use Getopt::Long;

# Compiles zone1970.tab and backward from an IANA tzdata tarball into
# include/tks/tks_places.h: every zone's representative place, and every
# link's as its target's, sorted by name for a binary search. Shipped so a
# reader can regenerate the table; never installed.
#
#     perl tools/placecompile --tzdata tzdata-2026e.tar.gz --out include/tks/tks_places.h

my ($tarball, $out) = ('', 'include/tks/tks_places.h');
GetOptions('tzdata=s' => \$tarball, 'out=s' => \$out) or die "usage: placecompile --tzdata <tarball> [--out <header>]\n";
die "placecompile: --tzdata <tarball> is needed\n" unless $tarball;
(my $release = $tarball) =~ s{.*tzdata-?([0-9]{4}[a-z]?)\.tar\.gz$}{$1} or die "placecompile: cannot read the release from the tarball's name\n";

my $tar = Archive::Tar->new($tarball) or die "placecompile: $tarball: " . Archive::Tar->error . "\n";
my %file = map { $_ => $tar->get_content($_) } qw(zone1970.tab backward);
die "placecompile: $tarball has no zone1970.tab\n" unless defined $file{'zone1970.tab'};
die "placecompile: $tarball has no backward\n" unless defined $file{backward};

# +DDMM+DDDMM or +DDMMSS+DDDMMSS, ISO 6709, to degrees.
sub coord {
    my ($s) = @_;
    my ($lat, $lon) = $s =~ /^([+-]\d{4}(?:\d{2})?)([+-]\d{5}(?:\d{2})?)$/ or die "placecompile: bad coordinates '$s'\n";
    return (dms($lat, 2), dms($lon, 3));
}
sub dms {
    my ($s, $dd) = @_;
    my $sign = substr($s, 0, 1) eq '-' ? -1 : 1;
    my $body = substr($s, 1);
    my $d = substr($body, 0, $dd);
    my $m = substr($body, $dd, 2);
    my $sec = length($body) > $dd + 2 ? substr($body, $dd + 2, 2) : 0;
    return $sign * ($d + $m / 60 + $sec / 3600);
}

my %place;
for (split /\n/, $file{'zone1970.tab'}) {
    next if /^#/ || !/\S/;
    my (undef, $coords, $name) = split /\t/;
    my ($lat, $lon) = coord($coords);
    $place{$name} = [$lat, $lon];
}
my $zones = keys %place;
my ($links, $skipped) = (0, 0);
for (split /\n/, $file{backward}) {
    next unless /^Link\s+(\S+)\s+(\S+)/;
    my ($target, $name) = ($1, $2);
    next if exists $place{$name};
    # a chain: follow to a zone
    my %seen;
    while (!exists $place{$target}) {
        my ($next) = $file{backward} =~ /^Link\s+(\S+)\s+\Q$target\E\s*(?:#.*)?$/m;
        last if !defined $next || $seen{$target}++;
        $target = $next;
    }
    if (exists $place{$target}) {
        $place{$name} = $place{$target};
        $links++;
    }
    else {
        $skipped++;
    }
}

open my $fh, '>', $out or die "placecompile: $out: $!\n";
print $fh <<"H";
#ifndef TKS_PLACES_H
#define TKS_PLACES_H

/* Generated by tools/placecompile from tzdata $release: every zone of
 * zone1970.tab with its representative place, and every link of backward
 * with its target's, sorted by name. Latitude and longitude are in ten
 * thousandths of a degree, north and east positive. A zone is wide; these
 * are the coordinates of one city in it. */

#define TKS_PLACES_RELEASE "$release"
#define TKS_PLACES_COUNT ${\ scalar keys %place }

typedef struct tks_place_row {
    const char *name;
    int32_t     lat, lon;
} tks_place_row;

static const tks_place_row tks_places[TKS_PLACES_COUNT] = {
H
for my $name (sort keys %place) {
    my ($lat, $lon) = @{$place{$name}};
    printf $fh "    { \"%s\", %d, %d },\n", $name, sprintf('%.0f', $lat * 10000), sprintf('%.0f', $lon * 10000);
}
print $fh <<'H';
};

#endif
H
close $fh;
print "placecompile: $zones zones and $links links from tzdata $release into $out ($skipped links without a place left out)\n";
