#!perl -lw
#
# print out current time in all known time zones, also giving metadata
# about each time zone.  usage:
#
# perl alltimezones.pl [unixtime]
#
# optionally, provide Unix time as a numeric argument to do that time
# instead of the current time.
#
# output:
#
# first output field: time offset from UTC.
# second output field: longitude with a period in front of it
# third output field: 0 if "canonical" time zone name, 1 if a "link" time zone.
# then a colon.
# then time, a colon, time zone name, then metadata about the time zone, including comments in time zone database, country, what it links to if it is a "link" time zone.
#
# the first three fields are intended to be used as sort keys then
# discarded, for example:
#
# perl alltimezones.pl | sort -k1g -k2g | perl -plwe 's/.*?://'
#
# Copyright 2022 Ken Takusagawa

# This program is free software: you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation, either version 3 of the License, or
# (at your option) any later version.

# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.

# You should have received a copy of the GNU General Public License
# along with this program.  If not, see <http://www.gnu.org/licenses/>.


use POSIX qw(strftime);

# the file exists in debian bullseye, not present in buster
$zifile=$ENV{TZDATAZIFILE};
$zifile='/usr/share/zoneinfo/tzdata.zi' unless defined$zifile;
open FI, $zifile or die;
while(<FI>){
    if(/^Z\s+(\S+)/){
	die if $mainzone{$1};
	$mainzone{$1}=1;
    } elsif(/^L\s+(\S+)\s+(\S+)$/){
	die if $link{$2};
	$link{$2}=$1;
    }
}
#for(keys %z){print;}
for(keys %link){
    die if$mainzone{$_};
    #print;
}
open FI,'/usr/share/zoneinfo/zone1970.tab' or die;
while(<FI>){
    chomp;
    next if /^#/;
    @F=split/\t/,$_;
    $zone=$F[2];
    #print "zone=$zone";
    unless ($mainzone{$zone}){
        # this happens if you use incompatible tzdata.zi and zone1970.tab
        print STDERR "ignoring zone1970.tab $zone";
        next;
    }
    die unless ($long1)=($F[1]=~/^[+-]\d+([+-]\d+)$/);
    die if defined($longitude{$zone});
    #print "got $lat1 $long1";
    $longitude{$zone}=$long1;
    @c=split/,/,$F[0];
    for(@c){
	push @{$countrycodes{$_}},$zone;
	push @{$zonecountries{$zone}},$_;
    }
    if($F[3]){
	die if $comment{$zone};
	($zonesuffix)=($zone =~ m,([^/]*)$,);
	unless($F[3] ne $zonesuffix){
	    #print "new ignore redundant comment $_";
	} else {
	    $F[3] =~ s/$zonesuffix/~/g;  # swung dash
	    $comment{$zone}=$F[3];
	}
    }
}
#print for(keys %countrycodes);
#for(keys%z){
#    print"$_" unless defined($lat{$_}) and defined($long{$_});
#}

if (open FI,'/usr/share/zoneinfo/zone.tab'){
    while(<FI>){
	chomp;
	next if /^#/;
	@F=split /\t/,$_;
	$zone=$F[2];
	print STDERR "zone.tab not in zi: $_" unless $mainzone{$zone} or $link{$zone};
	die unless ($long1)=($F[1]=~/^[+-]\d+([+-]\d+)$/);
	die if defined($oldlongitude{$zone});
	$oldlongitude{$zone}=$long1;

	die if defined($oldcountry{$zone});
	$oldcountry{$zone}=$F[0];
	die if defined($oldcomment{$zone});
	if(defined$F[3]){
	    ($zonesuffix)=($zone =~ m,([^/]*)$,);
	    unless($F[3] ne $zonesuffix){
		#print "old ignore redundant comment $_";
	    }
	    else {
		if(defined($comment{$zone}) and $comment{$zone} ne $F[3]){
		    # as of Debian Bullseye (2021a), differences in comments are only in accented letters.
		    # 2021b and beyond (tested 2021e) introduced merged time zones, so a city's time zone could apply to a country it is not, e.g., America/Creston (Canada) -> America/Phoenix (US) . This makes the comments on Phoenix harder to understand.
		    #print "explore $_\nexploreold=($F[3])\nexplorenew=($comment{$zone})"
		}
		$F[3] =~ s/$zonesuffix/~/g; # swung dash
		$oldcomment{$zone}=$F[3];
	    }
	}
    }
}


# these zones have no location information
# CST6CDT
# CET
# EET
# EST
# EST5EDT
# Etc/GMT
# Etc/GMT+1
# Etc/GMT+10
# Etc/GMT+11
# Etc/GMT+12
# Etc/GMT+2
# Etc/GMT+3
# Etc/GMT+4
# Etc/GMT+5
# Etc/GMT+6
# Etc/GMT+7
# Etc/GMT+8
# Etc/GMT+9
# Etc/GMT-1
# Etc/GMT-10
# Etc/GMT-11
# Etc/GMT-12
# Etc/GMT-13
# Etc/GMT-14
# Etc/GMT-2
# Etc/GMT-3
# Etc/GMT-4
# Etc/GMT-5
# Etc/GMT-6
# Etc/GMT-7
# Etc/GMT-8
# Etc/GMT-9
# Etc/UTC
# Factory
# HST
# MET
# MST
# MST7MDT
# PST8PDT
# WET

open FI,'/usr/share/zoneinfo/iso3166.tab' or die;
while(<FI>){
    next if/^#/;
    die unless /^(\S\S)\t(.+)/;
    die if defined($codelookup{$1});
    $codelookup{$1}=$2;
}

$now=$ARGV[0];
$now=time() unless defined$now;

sub getlongitude {
    my$a=shift;
    my$n;
    if(defined($longitude{$a})){
	$n=$longitude{$a};
    }
    # assigning longitudes to time zones is all around questionable, defended by wanting things to be roughly in the correct location
    elsif ($a =~ m,^Etc/GMT([+-]\d+)$,) {
	$n=0-$1;
	$n*=(360/24); # 15 degrees per time zone
	$n-=360 while($n>180); # because madness like GMT-14
	$n+=360 while($n<-180); # currently unneeded
	if($n>=0){
	    $n=sprintf("+%03d",$n);
	} else {
	    $n=sprintf("%04d",$n);
	}
	#print "#n $n";
    } elsif ($a eq 'PST8PDT') {
	$n=$longitude{$link{'US/Pacific'}};
    } elsif ($a eq 'MST7MDT') {
	$n=$longitude{$link{'US/Mountain'}};
    } elsif ($a eq 'MST') {
	# no summer time, assigning location to the most famous place
	$n=$longitude{$link{'US/Arizona'}};
    } elsif ($a eq 'CST6CDT') {
	$n=$longitude{$link{'US/Central'}};
    } elsif ($a eq 'EST5EDT') {
	$n=$longitude{$link{'US/Eastern'}};
    } elsif ($a eq 'HST') {
	$n=$longitude{$link{'US/Hawaii'}}; # questionable, because Alaska is sometimes Hawaii
    } elsif ($a eq 'CET' or $a eq 'MET') {
	# does summer time
	$n="+015"
    } elsif ($a eq 'EET') {
	# does summer time
	$n="+030"
    } elsif ($a eq 'EST') {
	# no summer time
	$n="-075"
    }else {
	# everything else not assigned a longitude get assigned to 0.
	# this includes incompatibities between tzdata.zi and zone1970.tab
	$n="+00";
	# WET does summer time
    }
    &makesortable($n);
}

sub makesortable {
    my$n=shift;
    $n =~ s/^(.)(.*)/${1}0.$2/;  # make it something that sort -g can sort
    # we need some sort of numeric sort because the negative sign essentially changes sort order to reverse
    $n;
}

# almost the same as %c, but including AM/PM
$mainformat=":%a %d %b %Y %T %P %Z (%z)";

sub calldate {
    my $z=shift;
    my $format=shift;
    #my $y=`env TZ=:$z date --date="\@$now"`;
    # shelling out is 70 times slower
    # colon indicates it is a file name in tzdata
    $ENV{TZ}=":$z";
    my@t=localtime($now);
    strftime($format,$t[0],$t[1],$t[2],$t[3],$t[4],$t[5],$t[6],$t[7],$t[8]);
    # passing $t[8] is necessary for %z to work
}

for(keys%mainzone){
    if($comm=$comment{$_}){
	$comm=" ($comm)";
    } else {
	$comm="";
    }
    $countrystring="";
    for$country(@{$zonecountries{$_}}){

	$countrystring.="[".$country.":".$codelookup{$country};
	if(1==scalar(@{$countrycodes{$country}})){
	    $countrystring.=":entirety";
	}
	$countrystring.="]";

    }
    $countrystring=" ".$countrystring if $countrystring ne "";
    $done=&calldate($_,$mainformat);
    die if defined$save{$_};
    $save{$_}=$done;
    $offset=&calldate($_,"%z");
    print "$offset ",&getlongitude($_)," 0 ",$done," : ",$_,$comm,$countrystring;
    # extra field "0" for sorting: canonical comes first
}
for$l(keys%link){
    $m=$link{$l};
    die unless defined($mainzone{$m});
    die unless defined($done=$save{$m});
    $longi=$oldlongitude{$l};
    $longi=&makesortable($longi) if defined$longi;
    $longi=&getlongitude($m) unless defined$longi;
    $countrystring=$oldcountry{$l};
    unless(defined$countrystring){
	$countrystring="";
    } else {
	$countrystring=" [$countrystring:".$codelookup{$countrystring}."]";
    }
    $comment=$oldcomment{$l};
    unless(defined$comment){
        $comment="";
    }else{
        $comment=" ($comment)";
    }
    $offset=&calldate($l,"%z");
    print "$offset ",$longi," 1 ",$done," : ",$l,$comment,$countrystring," (->$m)";
}

# no longer done
sub docountries {
    for$c(keys %countrycodes){
	if(1==scalar(@{$countrycodes{$c}})){
	    $m=${$countrycodes{$c}}[0];
	    if(defined($name=$codelookup{$c})){
		$name=" ($name)";
	    } else {
		# currently all country codes have expansions, so this branch is not taken
		$name="";
	    }
	    print "",&getlongitude($m)," 2 ",&calldate($m,$mainformat)," : ",".",lc$c,$name;
	} else {
	    #print "country has multiple time zones $c";
	    # AQ AR AU BR CA CD CL CN CY DE EC ES FM GL ID KI KZ MH MN MX MY NZ PF PG PS PT RU TF UA UM US UZ VN
	}
    }
}