The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!/usr/bin/env perl

use strict;
use warnings;
use autodie qw( :all );

use File::pushd;
use Getopt::Long;
use Net::FTP;
use Path::Class qw( dir tempdir );

sub main {
    my %opts = (
        download => 1,
        tests    => 1,
    );

    GetOptions(
        'download!' => \$opts{download},
        'dir:s'     => \$opts{dir},
        'tests!'    => \$opts{tests},
    );

    my $olson_version;
    my $dir
        = $opts{dir}
        ? dir( $opts{dir} )
        : tempdir( CLEANUP => 1 );

    if ( $opts{download} ) {
        $olson_version = _download($dir);
    }
    else {
        ($olson_version) = $dir =~ m{/([^/]+)$};
    }

    _compile_tzdata($dir);
    _parse_olson( $dir, $olson_version, $opts{tests} );
}

sub _download {
    my $pushed = pushd(shift);

    my $host = 'ftp.iana.org';

    my $ftp = Net::FTP->new( $host, Passive => 1 )
        or die "Cannot connect to $host: $@";
    $ftp->login()
        or die 'Cannot login: ', $ftp->message;

    my $dir = '/tz/releases';
    $ftp->cwd($dir)
        or die "Cannot cwd to $dir: ", $ftp->message;

    my @code;
    my @data;
    for my $file ( $ftp->ls() ) {
        next unless $file =~ /tz(code|data)(\d+)(\w+)\.tar\.gz/;

        if ( $1 eq 'code' ) {
            push @code, [ $file, $2, $3 ];
        }
        else {
            push @data, [ $file, $2, $3 ];
        }
    }

    my $data
        = ( sort { $b->[1] <=> $a->[1] or $b->[2] cmp $a->[2] } @data )[0]
        ->[0];

    my $code
        = ( sort { $b->[1] <=> $a->[1] or $b->[2] cmp $a->[2] } @code )[0]
        ->[0];

    $ftp->binary();

    my $olson_version;
    for my $file ( $code, $data ) {
        print "Getting $file\n";
        $ftp->get($file)
            or die "Cannot fetch $file: ", $ftp->message;

        system( 'tar', 'xzf', $file );

        ($olson_version) = $file =~ /(\d\d\d\d\w)/;

        die "Did not retrieve anything from elsie"
            unless $olson_version;
    }

    return $olson_version;
}

sub _compile_tzdata {
    my $dir = shift;

    my $pushed = pushd($dir);

    # The CFLAGS bit is necessary because of an issue introduced in 2017c with
    # the use of snprintf. This works fine on my machine without the flag but
    # blows up on Travis.
    system( 'make', 'CFLAGS=-DHAVE_SNPRINTF' )
        and die "Cannot run make: $!";

    my $target = $dir->subdir('target');
    $target->mkpath( 0, 0755 );

    my @files = qw(
        africa
        antarctica
        asia
        australasia
        europe
        northamerica
        southamerica
        etcetera
        factory
        backward
        systemv
        pacificnew
    );

    for my $f (@files) {
        system( './zic', '-d', $target, $f )
            and die "Cannot run zic on $f";
    }

    # The rdfind and symlinks bits are copied from the Debian tzdata packages
    # rules file.
    system(
        'rdfind',
        '-outputname',       '/dev/null',
        '-makesymlinks',     'true',
        '-removeidentinode', 'false',
        $target
    );

    system( qw( symlinks -r -s -c ), $target );

    system(qw( sudo rm -fr /usr/share/zoneinfo ));
    system( qw( sudo mv ), $target, '/usr/share/zoneinfo' );
    system(qw( sudo chown -R root:root /usr/share/zoneinfo ));
}

sub _parse_olson {
    my $dir            = shift;
    my $olson_version  = shift;
    my $generate_tests = shift;

    system(
        './tools/parse_olson',
        '--clean',
        '--version', $olson_version,
        '--dir',     $dir,
    ) and die "Cannot run parse_olson: $!";

    if ($generate_tests) {
        print "Generating tests from zdump\n";
        system('./tools/tests_from_zdump')
            and die "Cannot run tests_from_zdump: $!";
    }
}

main();