1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163
|
#!/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
);
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();
|