#!/usr/bin/perl

use warnings;
use strict;

use threads;
use threads::shared;

use Getopt::Std qw(getopts);

our $VERSION = "0.002";

#
# initial argument parsing
#

sub usage() {
	print STDERR "$0: usage: $0 [<display-format>]\n";
	exit 2;
}

my %opts;
getopts("cglz:", \%opts) or usage;
usage unless @ARGV <= 1;

#
# global variables
#

my %subparser;

my %setup_before_fork;
my %do_after_display;
my %setup_research;
my %do_research;

my($utc_mjdn, $utc_secs, $bound);

#
# utilities
#

use constant TAI_EPOCH_MJD => 36204;
use constant MJD_EPOCH_CJD => 2400001;
use constant UNIX_EPOCH_MJD => 40587;

sub fdiv($$) {
	my($a, $b) = @_;
	if($a < 0) {
		use integer;
		return -(($b - 1 - $a) / $b);
	} else {
		use integer;
		return $a / $b;
	}
}

sub parse_number($) {
	my($str) = @_;
	die "bad number syntax `$str'\n" unless $str =~ /\A[-+]?\d+\z/;
	return $str;
}

sub parse_extent($$) {
	my($hx, $lx) = map { parse_number($_) } @_;
	die "bad extent $hx/$lx\n" unless $hx > $lx;
	return ($hx, $lx);
}

sub add_sna($$) {
	my($a, $b) = @_;
	my($cs, $cn, $ca);
	$ca = $a->[2] + $b->[2];
	$cn = $a->[1] + $b->[1];
	$cs = $a->[0] + $b->[0];
	if($ca >= 1000000000) {
		$ca -= 1000000000;
		$cn++;
	}
	if($cn >= 1000000000) {
		$cn -= 1000000000;
		$cs++;
	}
	return [ $cs, $cn, $ca ];
}

#
# multi-purpose UTC day information
#

my %utc_day_to_tai : shared;
my %utc_day_leaps : shared;

my $bigrat_zero;

sub setup_utc_day_info() {
	require Math::BigRat;
	Math::BigRat->VERSION(0.08);
	require Time::UTC;
	Time::UTC->VERSION(0.000);
	$bigrat_zero = Math::BigRat->new(0);
}

sub update_utc_day_info($$) {
	my($base_mjdn, $base_secs) = @_;
	foreach my $mjdn (keys %utc_day_to_tai) {
		delete $utc_day_to_tai{$mjdn}
			unless $mjdn >= $base_mjdn-1 && $mjdn <= $base_mjdn+1;
	}
	foreach my $mjdn (keys %utc_day_leaps) {
		delete $utc_day_leaps{$mjdn}
			unless $mjdn >= $base_mjdn-1 && $mjdn <= $base_mjdn+1;
	}
	for(my $mjdn = $base_mjdn-1; $mjdn != $base_mjdn+2; $mjdn++) {
		unless(exists $utc_day_to_tai{$mjdn}) {
			my $brmjdn = Math::BigRat->new($mjdn);
			my $midnight_tai = eval {
				Time::UTC::utc_to_tai($brmjdn - TAI_EPOCH_MJD,
						      $bigrat_zero)
			};
			if(defined $midnight_tai) {
				$utc_day_to_tai{$mjdn} = sprintf("%d,%d",
					($midnight_tai / 1000000000)
						->bfloor->numify,
					($midnight_tai % 1000000000)->numify);
			}
		}
		unless(exists $utc_day_leaps{$mjdn}) {
			my $brmjdn = Math::BigRat->new($mjdn);
			my $leaps = eval {
				Time::UTC::utc_day_leap_seconds($brmjdn -
								TAI_EPOCH_MJD)
			};
			if(defined $leaps) {
				$utc_day_leaps{$mjdn} = "$leaps";
			}
		}
	}
}

sub want_utc_day_to_tai() {
	$setup_research{utc_day_info} = \&setup_utc_day_info;
	$do_research{utc_day_info} = \&update_utc_day_info;
}

BEGIN { *want_utc_day_leaps = \&want_utc_day_to_tai; }

#
# fixed text
#

$subparser{fixed} = sub {
	die "wrong number of arguments for `fixed'\n" unless @_ == 1;
	my($string) = @_;
	$string =~ s/([^\!\#-\[\]-\~])/sprintf("\\x{%x}", ord($1))/eg;
	return "\"".$string."\"";
};

#
# Exim message ID date
#

my %eximinfo : shared;

my $eximlen = 0;

sub setup_exim() {
	require Data::ID::Exim;
	Data::ID::Exim->VERSION(0.000);
}

sub update_eximinfo($$) {
	my($base_mjdn, $base_secs) = @_;
	foreach my $mjdn (keys %eximinfo) {
		delete $eximinfo{$mjdn}
			unless $mjdn >= $base_mjdn-1 && $mjdn <= $base_mjdn+1;
	}
	for(my $mjdn = $base_mjdn-1; $mjdn != $base_mjdn+2; $mjdn++) {
		next if exists $eximinfo{$mjdn};
		my $tm = Math::BigInt->new($mjdn - UNIX_EPOCH_MJD) * 86400;
		my $hipart = ($tm / (62*62*62));
		my $offset = ($tm - $hipart * (62*62*62))->numify;
		$hipart = $hipart->numify;
		$eximinfo{$mjdn} = sprintf("%s,%d,%s",
			scalar(Data::ID::Exim::base62($eximlen, $hipart)),
			$offset,
			scalar(Data::ID::Exim::base62($eximlen, $hipart + 1)));
	}
}

sub gen_exim_time($$) {
	my($hx, $lx) = @_;
	return "?" x ($hx-$lx) unless defined $utc_mjdn;
	my $info = $eximinfo{$utc_mjdn};
	return "?" x ($hx-$lx) unless defined $info;
	my($pfx, $off, $npfx) = ($info =~ /\A(\w*),(\d+),(\w*)\z/);
	my $secs = $utc_secs->[0] + $off;
	my $digits = ($secs >= 62*62*62 ? $npfx : $pfx) .
			Data::ID::Exim::base62(3, $secs);
	return substr($digits, length($digits) - $hx, $hx - $lx);
}

$subparser{exim} = sub {
	die "wrong number of arguments for `exim'\n" unless @_ == 2;
	my($hx, $lx) = @_;
	($hx, $lx) = parse_extent($hx, $lx);
	die "bad extent for $hx/$lx for `exim'\n" unless $lx >= 0;
	$setup_before_fork{exim} = \&setup_exim;
	$do_research{exim} = \&update_eximinfo;
	$eximlen = $hx - $lx - 3 if $hx - $lx - 3 > $eximlen;
	return "gen_exim_time($hx,$lx)";
};

#
# spinners
#

my @pos_spinner = qw(/ | \ -);
my @neg_spinner = qw(\ | / -);

my $spinner_phase = 0;
sub update_spinner() {
	$spinner_phase = ($spinner_phase + 1) & 3;
}

sub gen_pos_spinner() { $pos_spinner[$spinner_phase] }
sub gen_neg_spinner() { $neg_spinner[$spinner_phase] }

$subparser{spin} = sub {
	die "wrong number of arguments for `spin'\n" unless @_ == 1;
	my($direction) = @_;
	die "bad spinner direction `$direction'\n"
		unless $direction =~ /\A[-+]\z/;
	$do_after_display{spin} = \&update_spinner;
	return $direction eq "+" ? "gen_pos_spinner" : "gen_neg_spinner";
};

#
# Modified Julian Date
#
# The generic data structure for an unrounded MJD encodes an arbitrary
# length, possibly recurring, decimal fraction.  It is a reference to a
# hash with these members:
#     int => integer part, as a string of digits
#     frac => non-repeating part of fraction, as a string of digits
#     recur => repeating tail of fraction, as a non-empty string of digits
#

sub gen_mjd($$$) {
	my($hx, $lx, $mjd) = @_;
	unless(defined $mjd) {
		return $hx > 0 && $lx < 0 ?
			("?" x $hx).".".("?" x -$lx) :
			"?" x ($hx-$lx);
	}
	my $digits = $mjd->{int}.$mjd->{frac}.$mjd->{recur};
	my $hd = length($mjd->{int});
	if($hx > $hd) {
		$digits = ("0" x ($hx - $hd)) . $digits;
		$hd = $hx;
	}
	my $ld = -length($mjd->{frac}) - length($mjd->{recur});
	while($lx <= $ld) {
		$digits .= $mjd->{recur};
		$ld -= length($mjd->{recur});
	}
	my $choplen = $lx - $ld;
	$digits++ if substr($digits, -$choplen, $choplen, "") =~ /\A[5-9]/;
	if($hx > 0 && $lx < 0) {
		return substr($digits, $lx-$hx, $hx).".".
			substr($digits, $lx, -$lx);
	} else {
		return substr($digits, $lx-$hx, $hx-$lx);
	}
}

sub calc_mjd_utcsls() {
	return undef unless defined $utc_mjdn;
	# To calculate the fractional part of the MJD, we need to divide
	# the number of seconds since midnight by 86_400.  That doesn't
	# give a terminating decimal: 1/86_400 = 0.000_011_57[4_07] ("407"
	# recurring).  To make it easier, first multiply by 115_625 and
	# then divide by 9_990_000_000 (which is done by a process of
	# limb addition).
	#
	# If there is a positive leap second, then for seconds [85401,
	# 86401) we want to divide by 86_400/0.999 and add an offset.
	# That is because the last 1000 UTC seconds correspond to 999
	# UTC-SLS seconds.  Conveniently, we do this by multiplying by
	# 0.000_011_562_5, which is the just the first half of the above
	# recipe for a normal day, aside from a shift (which is implicit
	# anyway).
	#
	# If there is a negative leap second, then for seconds [85399,
	# 86399) we want to divide by 86_400/1.001 and add an offset.
	# That is because the last 1000 UTC seconds correspond to 1_001
	# UTC-SLS seconds.  This is done by multiplying by 115_740_625
	# (= 115_625 * 1_001) and dividing by 9_990_000_000_000.
	#
	# If there is a leap of more than one second, or a non-integer
	# number of seconds, then UTC-SLS is not defined.
	my $leaps;
	if($utc_secs->[0] >= 85399) {
		$leaps = $utc_day_leaps{$utc_mjdn};
		return undef unless defined $leaps;
		if($leaps =~ /\A[-+]?0+\z/) {
			$leaps = 0;
		} elsif($leaps =~ /\A\+?0*1\z/) {
			$leaps = $utc_secs->[0] >= 85401 ? +1 : 0;
		} elsif($leaps =~ /\A-0*1\z/) {
			$leaps = -1;
		} else {
			return undef;
		}
		return undef if $utc_secs->[0] >= 86400 + $leaps;
	} else {
		$leaps = 0;
	}
	my @r = (
		0, 0,
		fdiv($utc_secs->[0], 1000),
		$utc_secs->[0] % 1000,
		fdiv($utc_secs->[1], 1000000),
		fdiv($utc_secs->[1] % 1000000, 1000),
		$utc_secs->[1] % 1000,
		fdiv($utc_secs->[2], 1000000),
		fdiv($utc_secs->[2] % 1000000, 1000),
		$utc_secs->[2] % 1000,
	);
	for(my $i = @r; $i-- != 2; ) {
		$r[$i] *= 115625;
	}
	if($leaps != 0) {
		if($leaps == +1) {
			$r[1] += 9;
			$r[2] += 884;
			$r[3] += 375;
		} elsif($leaps == -1) {
			push @r, 0;
			for(my $i = @r; --$i; ) {
				$r[$i] += $r[$i-1];
			}
			$r[0] -= 1;
			$r[1] += 990;
			$r[2] += 125;
			$r[3] += 740;
			$r[4] += 625;
		}
	}
	my $c = 0;
	for(my $i = @r; $i--; ) {
		$c += $r[$i];
		$r[$i] = $c % 1000;
		$c = fdiv($c, 1000);
	}
	if($leaps == +1) {
		push @r, 0;
	} else {
		my $a = $r[0];
		for(my $i = 0; ++$i != @r; ) {
			$a += $r[$i];
			$r[$i] = $a;
		}
		$c = fdiv($a, 999);
		$a %= 999;
		$r[-1] = $a;
		for(my $i = @r - 1; $i--; ) {
			$c += $r[$i];
			$r[$i] = $c % 1000;
			$c = fdiv($c, 1000);
		}
	}
	my $recur = pop(@r);
	return {
		int => $utc_mjdn,
		frac => sprintf("%01d", $r[0]).
			join("", map { sprintf("%03d", $_) } @r[1 .. $#r]),
		recur => sprintf("%03d", $recur),
	};
}

sub calc_mjd_tai_plus($$) {
	my($add_s, $add_ms) = @_;
	my $utc_day_to_tai;
	unless(defined($utc_mjdn) &&
		    defined($utc_day_to_tai = $utc_day_to_tai{$utc_mjdn})) {
		return undef;
	}
	my($linear_gs, $linear_s) = split(/,/, $utc_day_to_tai);
	$linear_s += $utc_secs->[0] + $add_s;
	if($linear_s >= 1000000000) {
		$linear_s -= 1000000000;
		$linear_gs++;
	} elsif($linear_s < 0) {
		$linear_s += 1000000000;
		$linear_gs--;
	}
	# To calculate the MJD, we need to divide the number of seconds
	# by 86_400.  That doesn't give a terminating decimal: 1/86_400 =
	# 0.000_011_57[4_07] ("407" recurring).  To make it easier, first
	# multiply by 115_625 and then divide by 9_990_000_000 (which is
	# done by a process of limb addition).
	my @r = (
		0, 0,
		fdiv($linear_gs, 1000000),
		fdiv($linear_gs % 1000000, 1000),
		$linear_gs % 1000,
		fdiv($linear_s, 1000000),
		fdiv($linear_s % 1000000, 1000),
		$linear_s % 1000,
		fdiv($utc_secs->[1], 1000000) + $add_ms,
		fdiv($utc_secs->[1] % 1000000, 1000),
		$utc_secs->[1] % 1000,
		fdiv($utc_secs->[2], 1000000),
		fdiv($utc_secs->[2] % 1000000, 1000),
		$utc_secs->[2] % 1000,
	);
	for(my $i = @r; $i-- != 2; ) {
		$r[$i] *= 115625;
	}
	my $c = 0;
	for(my $i = @r; $i--; ) {
		$c += $r[$i];
		$r[$i] = $c % 1000;
		$c = fdiv($c, 1000);
	}
	my $a = $r[0];
	for(my $i = 0; ++$i != @r; ) {
		$a += $r[$i];
		$r[$i] = $a;
	}
	$c = fdiv($a, 999);
	$a %= 999;
	$r[-1] = $a;
	$r[4] += TAI_EPOCH_MJD * 10;
	for(my $i = @r - 1; $i--; ) {
		$c += $r[$i];
		$r[$i] = $c % 1000;
		$c = fdiv($c, 1000);
	}
	my $recur = pop(@r);
	my $digits = join("", map { sprintf("%03d", $_) } @r);
	return {
		int => substr($digits, 0, 14),
		frac => substr($digits, 14),
		recur => sprintf("%03d", $recur),
	};
}

sub calc_mjd_tai() { calc_mjd_tai_plus(0, 0) }

sub calc_mjd_tttai() { calc_mjd_tai_plus(32, 184) }

sub calc_mjd_gpst() { calc_mjd_tai_plus(-19, 0) }

my %mjd_calc_fns = (
	gpst    => "calc_mjd_gpst",
	tai     => "calc_mjd_tai",
	tt_tai  => "calc_mjd_tttai",
	utc_sls => "calc_mjd_utcsls",
);

$subparser{mjd} = sub {
	die "wrong number of arguments for `mjd'\n" unless @_ == 2 || @_ == 3;
	my($hx, $lx, $scale) = @_;
	$scale = "utc_sls" unless defined $scale;
	($hx, $lx) = parse_extent($hx, $lx);
	my $calc_fn = $mjd_calc_fns{lc($scale)};
	die "time scale `$scale' unknown for `mjd'\n" unless defined $calc_fn;
	want_utc_day_leaps();
	want_utc_day_to_tai();
	return "gen_mjd($hx,$lx,${calc_fn}())";
};

#
# uncertainty
#

my $disp_life_n = 25;
my $disp_life_i = 0;
my @disp_life;

sub max_disp_life() {
	return undef unless @disp_life == $disp_life_n;
	my $max = $disp_life[$disp_life_n-1];
	for(my $i = $disp_life_n-1; $i--; ) {
		my $d = $disp_life[$i];
		if($d->[0] > $max->[0] ||
		   ($d->[0] == $max->[0] &&
		    ($d->[1] > $max->[1] ||
		     ($d->[1] == $max->[1] && $d->[2] > $max->[2])))) {
			$max = $d;
		}
	}
	return $max;
}

sub gen_unc($$) {
	my($lx, $len) = @_;
	my $disp_life = max_disp_life();
	return "?" x $len unless defined($bound) && defined($disp_life);
	my $base_unc = add_sna($bound, $disp_life);
	my $digits = sprintf("%d%09d%09d", @$base_unc);
	$digits = ("0" x ($len+$lx-2)).$digits if $len+$lx > 2;
	if($lx < -17) {
		$digits .= "0" x (-17-$lx);
	} else {
		my $chopped = substr($digits, -17-$lx, 17+$lx, "");
		$digits++ if $chopped =~ /[^0]/;
	}
	for(my $n = 5; $n--; ) { $digits++; }
	my $ret = substr($digits, -$len, $len, "");
	return $digits =~ /[^0]/ ? "?" x $len : $ret;
}

my($prev_utc_mjdn, $prev_utc_secs);

sub update_disp_life() {
	my($after_dn, $after_secs) = eval { Time::UTC::Now::now_utc_sna() };
	my $after_mjdn = defined($after_dn) ? $after_dn + TAI_EPOCH_MJD :
					      undef;
	if(defined($prev_utc_mjdn) && defined($after_mjdn) &&
			$after_mjdn == $prev_utc_mjdn) {
		# Calculate and store lifetime of previous display.  That's
		# the time from when the date was determined for display
		# until the following display overwrote it.  Lifetimes that
		# cross midnight are ignored, because of clocks that
		# misbehave at leap seconds.  Negative lifetimes are also
		# ignored as obviously bogus.
		my $life_as = $after_secs->[2] - $prev_utc_secs->[2];
		my $life_ns = $after_secs->[1] - $prev_utc_secs->[1];
		my $life_s = $after_secs->[0] - $prev_utc_secs->[0];
		if($life_as < 0) {
			$life_as += 1000000000;
			$life_ns--;
		}
		if($life_ns < 0) {
			$life_ns += 1000000000;
			$life_s--;
		}
		unless($life_s < 0) {
			$disp_life[$disp_life_i] =
				[ $life_s, $life_ns, $life_as ];
			$disp_life_i = 0 if ++$disp_life_i == $disp_life_n;
		}
	}
	($prev_utc_mjdn, $prev_utc_secs) = ($utc_mjdn, $utc_secs);
}

$subparser{unc} = sub {
	die "wrong number of arguments for `unc'\n" unless @_ == 2;
	my($lx, $uncdig) = @_;
	$lx = parse_number($lx);
	$uncdig = parse_number($uncdig);
	die "bad number of uncertainty digits `$uncdig'\n" unless $uncdig > 0;
	$do_after_display{unc} = \&update_disp_life;
	return "gen_unc($lx,$uncdig)";
};

#
# linear TAI date
#

my @expt_ind = qw(j s a f c n r w u k m g t p e z y);

sub gen_lin($$) {
	my($hx, $lx) = @_;
	my $digits;
	if(defined($utc_mjdn) &&
		    defined(my $utc_day_to_tai = $utc_day_to_tai{$utc_mjdn})) {
		my($tai_gs, $tai_s) = split(/,/, $utc_day_to_tai);
		$tai_s += $utc_secs->[0];
		if($tai_s >= 1000000000) {
			$tai_s -= 1000000000;
			$tai_gs++;
		}
		$digits = sprintf("%d%09d%09d%09d", $tai_gs, $tai_s,
				$utc_secs->[1], $utc_secs->[2]);
		$digits = ("0" x ($hx-(length($digits)-18))).$digits
			if $hx > length($digits) - 18;
		if($lx > -18) {
			my $len = 18+$lx;
			my $chopped = substr($digits, -$len, $len, "");
			$digits++ if $chopped =~ /\A[5-9]/;
		} elsif($lx < -18) {
			$digits .= "0" x (-18-$lx);
		}
		substr $digits, 0, length($digits)-($hx-$lx), "";
	} else {
		$digits = "?" x ($hx-$lx);
	}
	for(my $pos = $lx+1; $pos != $hx; $pos++) {
		next unless $pos % 3 == 0;
		substr $digits, $hx-$pos, 0,
			$pos < -24 || $pos > +24 ? sprintf("(%+d)", $pos) :
			$expt_ind[$pos/3 + 8];
	}
	return $digits;
}

$subparser{lin} = sub {
	die "wrong number of arguments for `lin'\n" unless @_ == 2;
	my($hx, $lx) = @_;
	($hx, $lx) = parse_extent($hx, $lx);
	want_utc_day_to_tai();
	return "gen_lin($hx,$lx)";
};

$subparser{linunc} = sub {
	die "wrong number of arguments for `linunc'\n" unless @_ == 3;
	my($hx, $lx, $uncdig) = @_;
	($hx, $lx) = parse_extent($hx, $lx);
	$uncdig = parse_number($uncdig);
	die "bad number of uncertainty digits `$uncdig'\n" unless $uncdig > 0;
	want_utc_day_to_tai();
	$do_after_display{unc} = \&update_disp_life;
	return "gen_lin($hx,$lx).\".\".gen_unc($lx,$uncdig)";
};

#
# ISO 8601 date formats
#
# The generic data structure for an unrounded day+tod date encodes the
# abstract day identity and time-of-day in seconds with an arbitrary
# length, possibly recurring, decimal fraction.  It is a reference to a
# hash with these members:
#     cjdn => abstract day, as a CJDN as a native Perl integer
#     int => integer part of seconds since midnight, as a native Perl integer
#     frac => non-repeating part of fractional seconds, as a string of digits
#     recur => repeating tail of fraction, as a non-empty string of digits
#
# UTC is handled by a different mechanism, because it doesn't obey the
# usual rules of the 24-hour clock.
#

sub setup_iso8601() {
	require Date::ISO8601;
	Date::ISO8601->VERSION(0.000);
}

my %timezones;
my %mininfo : shared;

sub setup_timezones() {
	require DateTime;
	require DateTime::TimeZone;
	foreach my $tzname (keys %timezones) {
		$timezones{$tzname} = DateTime::TimeZone->new(name => $tzname);
	}
}

sub update_mininfo($$) {
	my($base_mjdn, $base_secs) = @_;
	$base_secs = $base_secs->[0];
	my $base_mins = $base_secs == 86400 ? 1439 : fdiv($base_secs, 60);
	my $base_amin = $base_mjdn*1440 + $base_mins;
	foreach my $key (keys %mininfo) {
		$key =~ /\A(\d+),/;
		delete $mininfo{$key}
			unless $1 >= $base_amin-2 && $1 <= $base_amin+2;
	}
	for(my $amin = $base_amin-2; $amin <= $base_amin+2; $amin++) {
		my $utc_mjdn = fdiv($amin, 1440);
		my $utc_mins = $amin % 1440;
		my($utc_y, $utc_m, $utc_d) =
			Date::ISO8601::cjdn_to_ymd($utc_mjdn + MJD_EPOCH_CJD);
		my $dt = DateTime->new(year => $utc_y, month => $utc_m,
				day => $utc_d, hour => fdiv($utc_mins, 60),
				minute => $utc_mins % 60, time_zone => "UTC");
		foreach my $tzname (keys %timezones) {
			my $key = "$amin,$tzname";
			next if exists $mininfo{$key};
			my $tz = $timezones{$tzname};
			my $offset = eval { $tz->offset_for_datetime($dt) };
			next unless defined $offset;
			$offset = fdiv($offset + 30, 60);
			my $utc_mjdn = fdiv($amin + $offset, 1440);
			my $mins = ($amin + $offset) % 1440;
			my $cjdn = $utc_mjdn + MJD_EPOCH_CJD;
			my $tzsign;
			if($offset < 0) {
				$tzsign = "-";
				$offset = -$offset;
			} else {
				$tzsign = "+";
			}
			my $hr_offset_disp = $offset < 6000 ?
				sprintf("%02d", fdiv($offset, 60)) : "??";
			$mininfo{$key} =
				sprintf("%s,%s,%s,%02d:%02d,%s%s:%02d",
				Date::ISO8601::present_ymd($cjdn),
				Date::ISO8601::present_ywd($cjdn),
				Date::ISO8601::present_yd($cjdn),
				fdiv($mins, 60), $mins % 60,
				$tzsign, $hr_offset_disp, $offset % 60);
		}
	}
}

sub gen_tod_sfrac($$) {
	my($hx, $lx) = @_;
	return "?" x ($hx-$lx) unless defined $utc_mjdn;
	my(undef, $utc_secs_ns, $utc_secs_as) = @$utc_secs;
	my $digits = sprintf("%09d%09d", $utc_secs_ns, $utc_secs_as);
	if($lx < -18) {
		$digits .= "0" x (-18-$lx);
	} else {
		$digits = substr($digits, 0, -$lx);
	}
	return substr($digits, -$hx);
}

sub gen_year($$$) {
	my($y, $hx, $lx) = @_;
	return "?" x ($hx-$lx) if $y eq "?";
	my $len = length($y);
	if($hx <= $len) {
		$y = substr($y, $len-$hx);
	} else {
		$y = ("0" x ($hx-$len)).$y;
	}
	return substr($y, 0, $hx-$lx);
}

sub gen_iso8601_utc($$$$) {
	my($type, $tzname, $hx, $lx) = @_;
	my $result = "";
	my $mininfo = "?-??-??,?-W??-?,?-???,??:??,???:??";
	my $s;
	if(defined $utc_mjdn) {
		my $utc_secs_s = $utc_secs->[0];
		my $mins;
		if($utc_secs_s >= 86400-60) {
			$mins = 1439;
			$s = $utc_secs_s - (86400-60);
		} else {
			$mins = fdiv($utc_secs_s, 60);
			$s = $utc_secs_s % 60;
		}
		my $real_mininfo =
			$mininfo{($utc_mjdn*1440+$mins).",".$tzname};
		$mininfo = $real_mininfo if defined $real_mininfo;
	}
	my($ymd_y, $ymd_m, $ymd_d, $ywd_y, $ywd_w, $ywd_d, $yd_y, $yd_d,
	   $h, $m, $tzdesc) =
		($mininfo =~ /\A\+?(.*?)-(..)-(..),
				\+?(.*?)-W(..)-(.),
				\+?(.*?)-(...),
				(..):(..),
				(...:..)\z/x);
	goto TIMEZONE if $type eq "z";
	goto SFRAC if $hx <= 0;
	goto qw(SECOND MINUTE HOUR)[$hx-1] if $hx <= 3;
	if($type =~ /\Aymdhmsz?\z/) {
		goto qw(YMD_DAY YMD_MONTH)[$hx-4] if $hx <= 5;
		$result .= gen_year($ymd_y, $hx - 5, $lx < 5 ? 0 : $lx - 5);
		goto TIMEZONE if $lx >= 5;
		$result .= "-";
		YMD_MONTH:
		$result .= $ymd_m;
		goto TIMEZONE if $lx == 4;
		$result .= "-";
		YMD_DAY:
		$result .= $ymd_d;
		goto TIMEZONE if $lx == 3;
	} elsif($type =~ /\Aywdhmsz?\z/) {
		goto qw(YWD_DAY YWD_WEEK)[$hx-4] if $hx <= 5;
		$result .= gen_year($ywd_y, $hx - 5, $lx < 5 ? 0 : $lx - 5);
		goto TIMEZONE if $lx >= 5;
		$result .= "-W";
		YWD_WEEK:
		$result .= $ywd_w;
		goto TIMEZONE if $lx == 4;
		$result .= "-";
		YWD_DAY:
		$result .= $ywd_d;
		goto TIMEZONE if $lx == 3;
	} else {
		goto YD_DAY if $hx == 4;
		$result .= gen_year($yd_y, $hx - 4, $lx < 4 ? 0 : $lx - 4);
		goto TIMEZONE if $lx >= 4;
		$result .= "-";
		YD_DAY:
		$result .= $yd_d;
		goto TIMEZONE if $lx == 3;
	}
	$result .= "T";
	HOUR:
	$result .= $h;
	goto TIMEZONE if $lx == 2;
	$result .= ":";
	MINUTE:
	$result .= $m;
	goto TIMEZONE if $lx == 1;
	$result .= ":";
	SECOND:
	$result .= defined($s) && $s < 100 ? sprintf("%02d", $s) : "??";
	goto TIMEZONE if $lx == 0;
	$result .= ".";
	SFRAC:
	$result .= gen_tod_sfrac($hx > 0 ? 0 : $hx, $lx);
	TIMEZONE:
	if($type =~ /z\z/) {
		$result .= "T" if $lx >= 3;
		$result .= $tzdesc;
	}
	return $result;
}

my %fake_dtod = (
	cjdn => MJD_EPOCH_CJD + TAI_EPOCH_MJD,
	int => 0,
	frac => "",
	recur => "0",
);

sub gen_iso8601($$$$) {
	my($type, $hx, $lx, $dtod) = @_;
	my $dtod_unavailable = !defined($dtod);
	$dtod = \%fake_dtod if $dtod_unavailable;
	my $result = "";
	goto TIMEZONE if $type eq "z";
	goto SFRAC if $hx <= 0;
	goto qw(SECOND MINUTE HOUR)[$hx-1] if $hx <= 3;
	if($type =~ /\Aymdhmsz?\z/) {
		my($y, $m, $d) = Date::ISO8601::cjdn_to_ymd($dtod->{cjdn});
		goto qw(YMD_DAY YMD_MONTH)[$hx-4] if $hx <= 5;
		$result .= gen_year($y, $hx - 5, $lx < 5 ? 0 : $lx - 5);
		goto TIMEZONE if $lx >= 5;
		$result .= "-";
		YMD_MONTH:
		$result .= sprintf("%02d", $m);
		goto TIMEZONE if $lx == 4;
		$result .= "-";
		YMD_DAY:
		$result .= sprintf("%02d", $d);
	} elsif($type =~ /\Aywdhmsz?\z/) {
		my($y, $w, $d) = Date::ISO8601::cjdn_to_ywd($dtod->{cjdn});
		goto qw(YWD_DAY YWD_WEEK)[$hx-4] if $hx <= 5;
		$result .= gen_year($y, $hx - 5, $lx < 5 ? 0 : $lx - 5);
		goto TIMEZONE if $lx >= 5;
		$result .= "-W";
		YWD_WEEK:
		$result .= sprintf("%02d", $w);
		goto TIMEZONE if $lx == 4;
		$result .= "-";
		YWD_DAY:
		$result .= sprintf("%01d", $d);
	} else {
		my($y, $d) = Date::ISO8601::cjdn_to_yd($dtod->{cjdn});
		goto YD_DAY if $hx == 4;
		$result .= gen_year($y, $hx - 4, $lx < 4 ? 0 : $lx - 4);
		goto TIMEZONE if $lx >= 4;
		$result .= "-";
		YD_DAY:
		$result .= sprintf("%03d", $d);
	}
	goto TIMEZONE if $lx == 3;
	$result .= "T";
	HOUR:
	$result .= sprintf("%02d", fdiv($dtod->{int}, 3600));
	goto TIMEZONE if $lx == 2;
	$result .= ":";
	MINUTE:
	$result .= sprintf("%02d", fdiv($dtod->{int} % 3600, 60));
	goto TIMEZONE if $lx == 1;
	$result .= ":";
	SECOND:
	$result .= sprintf("%02d", $dtod->{int} % 60);
	goto TIMEZONE if $lx == 0;
	$result .= ".";
	SFRAC:
	my $digits = $dtod->{frac}.$dtod->{recur};
	while($lx < -length($digits)) {
		$digits .= $dtod->{recur};
	}
	my $fhx = $hx > 0 ? 0 : $hx;
	$result .= substr($digits, -$fhx, $fhx-$lx);
	TIMEZONE:
	if($type =~ /z\z/) {
		$result .= "T" if $lx >= 3;
		$result .= "+00:00";
	}
	$result =~ tr/0123456789/??????????/ if $dtod_unavailable;
	return $result;
}

sub calc_dtod_tai_plus($$) {
	my($add_s, $add_ms) = @_;
	my $utc_day_to_tai;
	unless(defined($utc_mjdn) &&
		    defined($utc_day_to_tai = $utc_day_to_tai{$utc_mjdn})) {
		return undef;
	}
	my($linear_gs, $linear_s) = split(/,/, $utc_day_to_tai);
	my($linear_ns, $linear_as) = @{$utc_secs}[1, 2];
	$linear_ns += $add_ms * 1000000;
	if($linear_ns >= 1000000000) {
		$linear_ns -= 1000000000;
		$linear_s++;
	}
	$linear_s += $utc_secs->[0] + $add_s;
	if($linear_s >= 1000000000) {
		$linear_s -= 1000000000;
		$linear_gs++;
	} elsif($linear_s < 0) {
		$linear_s += 1000000000;
		$linear_gs--;
	}
	my @r = (
		fdiv($linear_gs, 1000000),
		fdiv($linear_gs % 1000000, 1000),
		$linear_gs % 1000,
		fdiv($linear_s, 1000000),
		fdiv($linear_s % 1000000, 1000),
		$linear_s % 1000,
	);
	my $c = 0;
	for(my $i = 0; $i != @r; $i++) {
		my $v = $c * 1000 + $r[$i];
		$r[$i] = fdiv($v, 86400);
		$c = $v % 86400;
	}
	return {
		cjdn => MJD_EPOCH_CJD + TAI_EPOCH_MJD +
			join("", map { sprintf("%03d", $_) } @r),
		int => $c,
		frac => sprintf("%09d%09d", $linear_ns, $linear_as),
		recur => "0",
	};
}

sub calc_dtod_tai() { calc_dtod_tai_plus(0, 0) }

sub calc_dtod_tttai() { calc_dtod_tai_plus(32, 184) }

sub calc_dtod_gpst() { calc_dtod_tai_plus(-19, 0) }

my %dtod_calc_fns = (
	gpst    => "calc_dtod_gpst",
	tai     => "calc_dtod_tai",
	tt_tai  => "calc_dtod_tttai",
);

sub subparser_iso8601($@) {
	my $type = shift;
	die "wrong number of arguments for `$type'\n" unless @_ == 3;
	my($scale, $hx, $lx) = @_;
	($hx, $lx) = parse_extent($hx, $lx);
	my $calc_fn = $dtod_calc_fns{lc($scale)};
	$setup_before_fork{iso8601} = \&setup_iso8601;
	if(defined $calc_fn) {
		want_utc_day_to_tai();
		return "gen_iso8601(\"$type\",$hx,$lx,${calc_fn}())";
	} else {
		$timezones{$scale} = undef;
		$scale =~ s/([^\!\#-\[\]-\~])/sprintf("\\x{%x}", ord($1))/eg;
		$setup_research{iso8601_utc} = \&setup_timezones;
		$do_research{iso8601_utc} = \&update_mininfo;
		return "gen_iso8601_utc(\"$type\",\"$scale\",$hx,$lx)";
	}
}

foreach my $type (qw(ydhms ydhmsz ymdhms ymdhmsz ywdhms ywdhmsz)) {
	$subparser{$type} = sub { subparser_iso8601($type, @_) };
};

$subparser{z} = sub {
	die "wrong number of arguments for `z'\n" unless @_ == 1;
	return subparser_iso8601("z", $_[0], 1, 0);
};

#
# parse arguments
#

$opts{z} = "50" unless exists $opts{z};
die "invalid frame rate `$opts{z}'" unless $opts{z} =~ /\A0*[1-9]\d*\z/;

sub parse_display_format($) {
	my($recipe) = @_;
	$recipe =~ s/\s+//g;
	my $expr = "\"\"";
	while($recipe !~ /\G\z/gc) {
		if($recipe =~ /\G_/gc) {
			$expr .= ".\" \"";
		} elsif($recipe =~ m#\G/#gc) {
			$expr .= ",\"\"";
		} elsif($recipe =~ /\G\(([a-z]+)((?:,(?:[\!-\$\&\'\*\+\--\~]|
							\%[0-9a-fA-F]{2})*)*)
				      \)/xgc) {
			my($fname, $args) = ($1, $2);
			my $subparser = $subparser{$fname};
			die "unrecognised function `$fname'\n"
				unless defined $subparser;
			my @args = map {
				s/\%(..)/chr(hex($1))/eg; $_
			} split(/,/, $args.",x");
			pop @args;
			shift @args;
			$expr .= ".".$subparser->(@args);
		} else {
			die "syntax error in display format after ".
				pos($recipe)." characters looking at \"".
				substr($recipe, pos($recipe), 4)."\"\n";
		}
	}
	return eval("sub() { ($expr) }");
}

my $default_display_format =
	"(ydhms,local,8,3)_(ymdhms,local,5,3)_(fixed,W)(ywdhms,local,5,3)/".
	"(ydhms,local,3,-1)_(z,local)_(mjd,0,-2)/".
	"(linunc,11,-1,3)";
my $gen_display =
	parse_display_format(@ARGV ? $ARGV[0] : $default_display_format);

if($opts{g}) {
	my @display = $gen_display->();
	my $longline = 0;
	foreach my $line (@display) {
		my $len = length($line);
		$longline = $len if $len > $longline;
	}
	print $longline, "x", scalar(@display), "\n";
	exit 0;
}

#
# start up research thread
#

require Time::HiRes;
require Time::UTC::Now;
Time::UTC::Now->VERSION(0.001);
$_->() foreach values %setup_before_fork;

my $want_exit : shared;

$SIG{INT} = $SIG{TERM} = $SIG{HUP} = sub { $want_exit = 1; };

my $research_thread = async {
	eval {
		foreach(values %setup_research) {
			return if $want_exit;
			$_->();
		}
		while(!$want_exit) {
			my($dn, $secs) = Time::UTC::Now::now_utc_sna();
			my $mjdn = $dn + TAI_EPOCH_MJD;
			foreach(values %do_research) {
				last if $want_exit;
				$_->($mjdn, $secs);
			}
			for(my $s = 200 + int(rand(20)); $s; $s--) {
				last if $want_exit;
				Time::HiRes::sleep(0.25);
			}
			last if $want_exit;
			Time::HiRes::sleep(rand(1));
		}
	};
	$want_exit = 1;
	return $@;
};

#
# operate display
#

require IO::Handle;

my @outputs;
END {
	foreach my $output (@outputs) {
		my $tio = $output->{tio};
		next unless $tio;
		$tio->setoflag($output->{tio_oflag});
		$tio->setattr($output->{fh}->fileno, POSIX::TCSADRAIN());
	}
}

if($opts{l}) {
	push @outputs, {
		fh => \*STDOUT,
		nl => " ",
		ho => "\n",
		cl => "\n",
	};
} else {
	require Term::Cap;
	my $termcap = Term::Cap->Tgetent({ TERM => $ENV{TERM}, OSPEED=>9600 });
	require POSIX;
	push @outputs, {
		fh => \*STDOUT,
		nl => "\r\n",
		ho => $termcap->Tputs("ho"),
		cl => $termcap->Tputs("cl"),
		tio => undef,
	};
}

foreach my $output (@outputs) {
	next unless exists $output->{tio};
	my $tio = POSIX::Termios->new;
	my $fileno = $output->{fh}->fileno;
	$tio->getattr($fileno) or next;
	my $oflag = $tio->getoflag;
	next unless $oflag;
	$output->{tio_oflag} = $oflag;
	$output->{tio} = $tio;
	$tio->setoflag(0);
	$tio->setattr($fileno, POSIX::TCSADRAIN());
}

if($opts{c}) {
	$_->{fh}->syswrite($_->{cl}) foreach @outputs;
}

while(!$want_exit) {
	(my $utc_dn, $utc_secs, $bound) =
		eval { Time::UTC::Now::now_utc_sna() };
	$utc_mjdn = TAI_EPOCH_MJD + $utc_dn;
	my @display = $gen_display->();
	$_->{fh}->syswrite(join($_->{nl}, @display).$_->{ho}) foreach @outputs;
	$_->() foreach values %do_after_display;
	last if $want_exit;
	Time::HiRes::sleep(1.0 / $opts{z});
}

my $err = $research_thread->join;
die $err unless $err eq "";
exit 0;

=head1 NAME

purchron - purists' chronometer

=head1 SYNOPSIS

	purchron [<display-format>]

=head1 DESCRIPTION

This program generates a clock display which updates in real time.
The display can indicate not only the estimated current time, in several
forms, but also a bound on the inaccuracy of this estimate.  It correctly
handles leap seconds and timezone offset changes.  Leap seconds are
handled even where they are not announced before the program starts
running.  Timezone rules are fixed at the time of program startup,
and later modifications to the rules will not be picked up; this may be
corrected in a future version.

The display is strictly textual, made up of a grid of characters.
It consists of fixed-length fields, the arrangement of which is determined
by the I<display-format> argument (or the built-in default).  Where the
information to fill a field in the display is not available, the field
will be filled with "B<?>"s.  It is normal for this to occur for several
fields immediately after startup.  After the first few seconds, the
appearance of "B<?>"s indicates that something is amiss.

For maximal consistency of timing behaviour, each display update is
emitted atomically in a single B<write> system call (see L<write(2)>).

The default behaviour is to display on standard output, using B<termcap>
control sequences to maintain a display in the top left corner of the
terminal screen.  This can be modified by options.

=head1 TIMEKEEPING

This clock is concerned with the International Atomic Time (TAI) time
scale, which is the principal realisation of Terrestrial Time (TT), and
with time scales derived from it (UTC, UTC-SLS).  It does not assume that
the host, user, or display are located in or near the TT reference frame.

The clock display is refreshed cyclically.  Each cycle begins with
the determination of the then-current point on the TAI/UTC scale, the
"reference time".  This determination is necessarily approximate, and
the degree of uncertainty is noted.  The reference time is then expressed
in configured formats for display.  This involves rounding the notional
exact reference time to displayable values; the rounding type varies
between display formats.  The resulting display is emitted atomically.
Then the clock pauses for a certain amount of host local time (regardless
of the progress of TT or TAI time), and the cycle begins again.

At the time a display update is emitted, the reference time that it
describes is already in the past.  The program does not extrapolate from
the reference time to predict what the TAI time will be at the time the
display is emitted.  However, the uncertainty in the displayed time
may also be displayed, and this does include uncertainty that is due
to the display's lifetime.  A future version of this program may change
this behaviour, so that the reference time is a future time that it is
estimated will occur while the display is current.

=head1 DISPLAY FORMAT

=head2 Controlling the display

The I<display-format> argument specifies the layout and content of the
clock display.  Display elements are specified in normal textual order:
top row to bottom row, and left to right within each row.  Rows within
the format specification are separated by "B</>".  An "B<_>" puts a
space character in the layout (i.e., skips a column).

Everything else in the format specification must be a command invocation.
This is a construct bracketed by parentheses ("B<(>" and "B<)>").
The first thing within the parentheses must be the alphabetical name of
the command.  The command name is followed by zero or more arguments,
separated from each other and the command name by commas ("B<,>").
Each argument is a character string, specified in a quoted form: ASCII
graphical characters other than the metacharacters "B<%>", "B<(>",
"B<)>", and "B<,>" stand for themselves, and a "B<%>" followed by
two hexadecimal digits stands for the codepoint given by the digits.
For example, "B<(foo,,a%20b)>" is an invocation of the B<foo> command
with two arguments, the first argument being the empty string and the
second being the three-character string "B<< a b >>".

Many commands are concerned with the output of some particular expression
of the current time.  To fully express the time would require an infinite
number of digits, so the actual output is necessarily a finite subset of
the full expression.  Such commands therefore consistently take a pair
of integer numeric arguments that indicate the range of digits that
should be output.  The first argument specifies the most-significant
end, and the second argument the least-significant end, of the extent
of what is output.  Each integer value corresponds to some unit of time
that corresponds to the division between two adjacent output digits.

The commands available are:

=over

=item B<exim>

Unix time number (based on UTC) expressed in base 62, as used in message
IDs for the Exim mail transport agent.  The value is rounded down.
Takes two arguments giving the output extent.  Extent value 0 corresponds
to 1 s, 1 corresponds to 62 s, and so on.  (Extent value I<n> corresponds
to 62^I<n> s.)

Negative extent values, for sub-second resolution, are not supported.
(Exim handles sub-second resolution in a different manner.)  The positive
extent is unlimited, even though Exim only uses six digits.

=item B<fixed>

Fixed text.  Takes one argument, the text to output.

=item B<lin>

Linear date: the number of TAI seconds since 1958-01-01T00:00:00 TAI.
This is output in the format described in "notation for dates on linear
time scales" at L<http://www.fysh.org/~zefram/text_rep/linear_date.txt>.
The value is rounded to nearest, as described in that document.  Takes
two arguments giving the output extent.  Extent value 0 corresponds
to 1 s, 1 corresponds to 10 s, -1 corresponds to 100 ms, and so on.
(Extent value I<n> corresponds to 10^I<n> s.)  The range of digits
supported is unlimited in both directions.

=item B<linunc>

The output of matching B<lin> and B<unc> invocations, concatenated,
separated by "B<.>".  Takes three arguments: the first two give the
extent for B<lin>, and the third gives the number of uncertainty digits
for B<unc>.

=item B<mjd>

Modified Julian date, based on UTC-SLS.  The value is rounded to nearest.
Takes two arguments giving the output extent.  Extent value 0 corresponds
to 1 day, 1 corresponds to 10 days, -1 corresponds to 0.1 days, and so on.
(Extent value I<n> corresponds to 10^I<n> days.)  The range of digits
supported is unlimited in both directions.

Experimental additional feature: a third argument may be given to
specify the time scale to be used.  The values accepted (recognised
case-insensitively) are "B<gpst>" for GPS time, "B<tai>" for TAI,
"B<tt_tai>" for TT(TAI), and "B<utc_sls>" for UTC-SLS (the default).
This feature is likely to change in future versions, so do not rely on it.

=item B<spin>

A single-character twirling baton.  The baton turns 1/8 cycle with each
display update, regardless of the time.  This is not a time display, but
used to indicate liveness of the display.  Takes one argument indicating
which way the baton is to twirl: "B<+>" to twirl in the positive direction
(anticlockwise) or "B<->" to twirl in the negative direction (clockwise).

=item B<unc>

Uncertainty of the time display.  Specifically, this is intended to
match a linear date display from B<lin>, but it can be used in other
contexts also.  Takes two arguments: the first gives the low-order extent
of the display to describe (extent value I<n> corresponds to 10^I<n> s),
and the second gives the number of digits of uncertainty to display.
The value displayed is decimal, in units of 1/10 of the unit value
of the least-significant digit of the time display.  (E.g., if the
low-order extent value is 0, representing a display with resolution 1 s,
the uncertainty is given in units of deciseconds.)

The uncertainty value displayed is the sum of the original uncertainty
in determining the reference time, the estimated maximum lifetime of
the time display, and the inherent display uncertainty that comes from
rounding to a displayable time (which depends on the display resolution).
The uncertainty is rounded upwards, so that it may be used as an
absolute limit.

If the uncertainty is too large to display fully in the specified number
of digits then a string of "B<?>"s is displayed instead.  This is also
done if an uncertainty bound could not be established.  In either case
the time display cannot be trusted, so this is how a "B<???>" uncertainty
display should be interpreted.

=item B<ydhms>

The most basic ISO 8601 calendar (year-day), with hour-minute-second
time of day, based on UTC.  Takes three arguments: the first specifies
the timezone in which the time is to be expressed, in the same format
as for B<z>, and the latter two give the output extent.  Extent values
are: ..., -2 = centisecond, -1 = decisecond, 0 = second, 1 = minute,
2 = hour, 3 = day, 4 = year, 5 = decayear, 6 = hectoyear, ....

=item B<ydhmsz>

As for B<ydhms>, but the timezone's offset from UT is also included in
the output (as for B<z>).

=item B<ymdhms>

The year-month-day (Gregorian) ISO 8601 calendar, with hour-minute-second
time of day, based on UTC.  Takes three arguments: the first specifies
the timezone in which the time is to be expressed, in the same format
as for B<z>, and the latter two give the output extent.  Extent values
are: ..., -2 = centisecond, -1 = decisecond, 0 = second, 1 = minute,
2 = hour, 3 = day, 4 = month, 5 = year, 6 = decayear, 7 = hectoyear, ....

=item B<ymdhmsz>

As for B<ymdhms>, but the timezone's offset from UT is also included in
the output (as for B<z>).

=item B<ywdhms>

The year-week-day ISO 8601 calendar, with hour-minute-second time of day,
based on UTC.  Takes three arguments: the first specifies the timezone
in which the time is to be expressed, in the same format as for B<z>,
and the latter two give the output extent.  Extent values are: ..., -2 =
centisecond, -1 = decisecond, 0 = second, 1 = minute, 2 = hour, 3 = day,
4 = week, 5 = year, 6 = decayear, 7 = hectoyear, ....

=item B<ywdhmsz>

As for B<ywdhms>, but the timezone's offset from UT is also included in
the output (as for B<z>).

=item B<z>

ISO 8601 timezone offset, based on UTC.  The output consists of a sign,
two digits giving a number of hours, a "B<:>", and two digits giving
a number of minutes.  Takes one argument, specifying the timezone.
Precisely, the argument identifies a set of rules for determining an
offset from UT at any particular time.  The offset is not necessarily
constant.

The main form is a geographical specification such as
"B<America/Chicago>", which refers to the civil time rules prevailing
in that location (in this case, the US Central timezone with periodic
Daylight Saving Time).  The string "B<local>" causes the program to
attempt to determine the user's or system's preferred timezone.  A fixed
offest may be given in the form "B<+01:10>".  Some other types of string
are also accepted; see L<DateTime::TimeZone>.

Experimental additional feature: the timezone argument may be instead
used to specify a non-UTC time scale to be used.  The values accepted
(recognised case-insensitively) are "B<gpst>" for GPS time, "B<tai>"
for TAI, and "B<tt_tai>" for TT(TAI).  When a non-UTC timescale is
used, the offset that B<z> will display is always zero; this feature
is meant for use with B<ymdhms> and similar commands, not B<z> itself.
This feature is likely to change in future versions, so do not rely on it.

If a timezone string is not understood, the program signals an error,
but not immediately upon startup.  This is because timezone data is
loaded in the background for a quicker initialisation.

=back

The default display format specification is:


    (ydhms,local,8,3)_(ymdhms,local,5,3)_(fixed,W)(ywdhms,local,5,3)/
    (ydhms,local,3,-1)_(z,local)_(mjd,0,-2)/
    (linunc,11,-1,3)

=head2 ISO 8601 display formats

The following recipes produce displays that conform to various versions
of ISO 8601:

=over

=item (ymdhms,ZONE,9,LO) where LO <= 5

=item (ymdhms,ZONE,9,7)

=item (ydhms,ZONE,8,LO) where LO <= 3

=item (ywdhms,ZONE,9,LO) where LO <= 4

Complete and reduced-accuracy representations of date or date and time
of day.  These conform to all versions of ISO 8601, provided that the
year can be fully represented (that is, until the year 10000).

=item (fixed,+)(ymdhms,ZONE,HI,LO) where HI >= 9 and LO <= 5

=item (fixed,+)(ymdhms,ZONE,HI,7) where HI >= 9

=item (fixed,+)(ydhms,ZONE,HI,LO) where HI >= 8 and LO <= 3

=item (fixed,+)(ywdhms,ZONE,HI,LO) where HI >= 9 and LO <= 4

Expanded representations.  These conform to ISO 8601:2004 but not ISO
8601:1988: they were added in the revision, principally it seems to
satisfy the Long Now Foundation.  Due to conflicts with other standard
representations and with each other, they are only permitted if it is
specially agreed to use them.  They also only conform so long as the
year can be fully represented.

=item (ymdhms,ZONE,3,LO) where LO <= 2

Complete and reduced-accuracy representations of time of day alone.
These conform to all versions of ISO 8601.

Note that if the hour is displayed alone, this is ambiguous with the
display of a century alone.  If a date representation is expected then
a time-of-day-only representation may be explicitly flagged by preceding
it with a "B<T>".

=item (ymdhms,ZONE,7,LO) where LO <= 3

=item (fixed,-)(ymdhms,ZONE,7,5)

=item (fixed,-)(ymdhms,ZONE,7,4)

=item (fixed,--)(ymdhms,ZONE,5,LO) where LO <= 4

=item (fixed,---)(ymdhms,ZONE,4,LO) where LO <= 3

=item (ydhms,ZONE,6,LO) where LO <= 3

=item (fixed,-)(ydhms,ZONE,4,LO) where LO <= 3

=item (ywdhms,ZONE,7,LO) where LO <= 4

=item (fixed,-)(ywdhms,ZONE,6,LO) where LO <= 3

=item (fixed,-W)(ywdhms,ZONE,5,LO) where LO <= 4

=item (fixed,-W-)(ywdhms,ZONE,4,LO) where LO <= 3

=item (fixed,-)(ymdhms,ZONE,2,LO) where LO <= 1

=item (fixed,--)(ymdhms,ZONE,1,LO) where LO <= 0

Truncated representations.  These conform to ISO 8601:1988 but not to
ISO 8601:2004: they were removed in the revision.

Note that if the minute or second is displayed alone, this is ambiguous
with the display of a century alone.  If a date representation is expected
then a time-of-day-only representation may be explicitly flagged by
preceding it with a "B<T>".

=back

Additionally, a timezone representation may be included, by using the
command "B<ymdhmsz>" instead of "B<ymdhms>", and so on.  Alternatively,
a fixed "B<Z>" may be appended if the timezone offset is always zero.
Either form of timezone representation is only permitted by the standard
when the time of day is also being represented (i.e., where LO <= 2).

=head1 OPTIONS

=over

=item B<-c>

Before commencing normal output, clear the screen.

=item B<-g>

Instead of producing clock output, give the geometry of the display
on standard output.  The display format given on the command line
(or the built-in default) is parsed, and the width (number of columns)
and height (number of rows) are output in decimal separated by "B<x>".
Any parsing errors are flagged in the usual manner, so this option can
be used to merely check a format specification for validity.

=item B<-l>

Instead of displaying to a terminal using B<termcap>, format output
for a plain text file.  Each display update is emitted as a single
newline-terminated line.  The lines of a multi-line display are separated
by spaces.  This output goes to standard output.

=item B<-z> I<RATE>

Target frame rate, in hertz (frames per second).  Must be a positive
integer.  Default 50 Hz.  The target is not guaranteed to be met.  Due to
the lack of a portable mechanism to achieve it, the frame rate is highly
unlikely to match the target; this will improve in future versions.

=back

=head1 DEPENDENCIES

For full functionality, the following Perl modules must be installed,
in the version listed or any later version:

=over

=item Data::ID::Exim 0.000

=item Date::ISO8601 0.000

=item DateTime

=item DateTime::TimeZone

=item Getopt::Std

=item IO::Handle

=item Math::BigRat 0.08

=item POSIX

=item Term::Cap

=item Time::HiRes

=item Time::UTC 0.000

=item Time::UTC::Now 0.001

=back

Some of these modules are required in order to do anything at all.
Some are only required depending on the display format and other options
selected.

=head1 AUTHOR

Andrew Main (Zefram) <zefram@fysh.org>

=head1 COPYRIGHT

Copyright (C) 2006, 2007 Andrew Main (Zefram) <zefram@fysh.org>

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 2 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.

=head1 SEE ALSO

L<Data::ID::Exim>,
L<Date::ISO8601>,
L<DateTime::TimeZone>,
L<Time::TAI::Now>,
L<Time::UTC::Now>