package Time::TAI64;
# vim: et ts=4
=head1 NAME
Time::TAI64 - Perl extension for converting TAI64 strings into standard unix timestamps.
=head1 SYNOPSIS
Generate TAI64 timestamps
use Time::TAI64 qw/tai64n/;
use Time::HiRes qw/time/;
$now = time; # High precision
printf "%s\n", unixtai64n($now);
Print out human readable logs
use Time::TAI64 qw/:tai64n/;
open FILE, "/var/log/multilog/stats";
while(my $line = <FILE>) {
my($tai,$log) = split(' ',$line,2);
printf "%s %s",tai64nlocal($tai),$log;
}
close FILE;
=head1 DESCRIPTION
This is a package provides routines to convert TAI64 strings, like timestamps produced
by B<multilog>, into values that can be processed by other perl functions to
display the timestamp in human-readable form and/or use in mathematical
computations.
=cut
use strict;
use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION $FUZZ $AUTOLOAD);
#require 5.008;
require Exporter;
@ISA = qw(Exporter);
@EXPORT = ();
@EXPORT_OK = qw(
tai2unix
tai2strftime
tai64unix
tai64nunix
tai64naunix
tai64nlocal
unixtai64
unixtai64n
unixtai64na
);
$EXPORT_TAGS{'tai'} = [
qw( tai2unix tai2strftime )
];
$EXPORT_TAGS{'tai64'} = [
@{ $EXPORT_TAGS{'tai'} },
qw( tai64unix unixtai64 )
];
$EXPORT_TAGS{'tai64n'} = [
@{ $EXPORT_TAGS{'tai'} },
qw( tai64nunix unixtai64n tai64nlocal )
];
$EXPORT_TAGS{'tai64na'} = [
@{ $EXPORT_TAGS{'tai'} },
qw( tai64naunix unixtai64na )
];
$EXPORT_TAGS{'all'} = [
@{ $EXPORT_TAGS{'tai'} },
@{ $EXPORT_TAGS{'tai64'} },
@{ $EXPORT_TAGS{'tai64n'} },
@{ $EXPORT_TAGS{'tai64na'} },
];
use POSIX qw(strftime);
$VERSION = '2.11';
#-----------
#
## Extra second difference... leap-seconds...
##
#-----------
$FUZZ = 10;
#-----------
#
## Internal Routines
##
#-----------
#-----------
#
## decode_tai64:
## returns the number of seconds;
##
#-----------
sub _decode_tai64 ($) {
my $tok = shift;
my $secs = 0;
if (substr($tok,0,9) eq '@40000000') {
$secs = hex(substr($tok,9,8)) - $FUZZ;
}
return $secs;
}
#-----------
#
## decode_tai64n:
## returns a two element array containing the number
## of seconds and nanoseconds respectively.
#-----------
sub _decode_tai64n ($) {
my $tok = shift;
my $secs = 0;
my $nano = 0;
if (substr($tok, 0, 9) eq '@40000000') {
$secs = hex(substr($tok,9,8)) - $FUZZ;
$nano = hex(substr($tok,17,8));
}
return ($secs,$nano);
}
#-----------
#
## decode_tai64na:
## returns a three element array containing the number
## of seconds, nanoseconds, and attoseconds respectively.
#-----------
sub _decode_tai64na ($) {
my $tok = shift;
my $secs = 0;
my $nano = 0;
my $atto = 0;
if (substr($tok, 0, 9) eq '@40000000') {
$secs = hex(substr($tok,9,8)) - $FUZZ;
$nano = hex(substr($tok,17,8));
$atto = hex(substr($tok,25,8));
}
return ($secs,$nano,$atto);
}
#-----------
#
## encode_tai64:
## returns a 16 character string tai64 encoded
## using the timestamp supplied, preceded by '@'.
#-----------
sub _encode_tai64 ($) {
my $s = shift; $s += $FUZZ;
my $t = '@40000000'. sprintf("%08x",$s);
return $t;
}
#-----------
#
## encode_tai64n:
## returns a 24 character string tai64n encoded
## using the timestamp supplied, preceded by '@'.
#-----------
sub _encode_tai64n ($$) {
my($s,$n) = @_;
my $t = _encode_tai64($s) . sprintf("%08x",$n);
return $t;
}
#-----------
#
## encode_tai64na:
## returns a 32 character string tai64na encoded
## using the timestamp supplied, preceded by '@'.
#-----------
sub _encode_tai64na ($$$) {
my($s,$n,$a) = @_;
my $t = _encode_tai64n($s,$n) . sprintf("%08x",$a);
return $t;
}
=head1 EXPORTS
In order to use any of these functions, they must be properly imported
by using any of the following tags to use related functions:
=over 4
=item :tai
Generic Functions
=item tai2unix ( $tai_string )
This method converts a tai64, tai64n, or tai64na string into a unix
timestamp. If successfull, this function returns an integer value
containing the number of seconds since Jan 1, 1970 as would perl's
C<time> function. If an error occurs, the function returns a 0.
=cut
sub tai2unix ($) {
my $tok = shift;
return int(tai64unix($tok)) if length($tok) == 17;
return int(tai64nunix($tok)) if length($tok) == 25;
return int(tai64naunix($tok)) if length($tok) == 33;
return 0;
}
=item tai2strftime ( $tai64_string, $format_string )
This method converts the tai64, tai64n, or tai64na string given as its
first parameter and, returns a formatted string of the converted I<timestamp>
as formatted by its second parameter using strftime conventions.
If this second parameter is ommited, it defaults to "%a %b %d %H:%M:%S %Y"
which should print the timestamp as:
Mon Nov 1 12:00:00 2004
=cut
sub tai2strftime ($;$) {
my $tok = shift;
my $fmt = shift || "%a %b %d %H:%M:%S %Y";
my $secs = tai2unix($tok);
return ($secs == 0) ? '' : strftime($fmt,localtime($secs));
}
=item :tai64
TAI64 Functions as well as Generic Functions
=item tai64unix ( $tai64_string )
This method converts the tai64 string given as its only parameter and
if successfull, returns a value for I<timestamp> that is compatible
with the value returned from C<time>.
=cut
sub tai64unix ($) {
my $tok = shift;
return 0 unless (length($tok) == 17);
my $s = _decode_tai64($tok);
return $s;
}
=item unixtai64 ( I<timestamp> )
This method converts a unix timestamp into a TAI64 string.
=cut
sub unixtai64 ($) {
my $secs = shift;
return '' if ($secs == 0);
return _encode_tai64(int($secs));
}
=item :ta64n
TAI64N Functions as well as Generic Functions
=item tai64nunix ( $tai64n_string )
This method converts the tai64n string given as its only parameter
and if successfull, returns a value for I<timestamp> that is compatible
with the value returned from C<Time::HiRes::time>.
=cut
sub tai64nunix ($) {
my $tok = shift;
return 0 unless (length($tok) == 25);
my($s,$n) = _decode_tai64n($tok);
$s += ($n/1e9);
return $s;
}
=item unixtai64n ( I<timestamp> )
=item unixtai64n ( I<seconds> , I<nanoseconds> )
This methods returns a tai64n string using the parameters supplied by the user
making the following assumptions:
=over 6
=item *
If I<seconds> and I<nanoseconds> are given, these values are used to compute
the tai64n string. If I<nanoseconds> evaluates to more than 1 second, the value
of both I<seconds> and I<nanoseconds> are reevaluated. Both I<seconds> and I<nanoseconds>
are assumed to be integers, any fractional part is truncated.
=item *
If I<timestamp> is an integer, I<nanoseconds> is assumed to be 0.
=item *
If I<timestamp> is a C<real> number, the integer part is used for the I<seconds>
and the fractional part is converted to I<nanoseconds>.
=back
=cut
sub unixtai64n ($;$) {
my($secs,$nano) = @_;
if (defined($nano)) {
if ($nano >= 1e9) {
$secs += int($nano / 1e9);
$nano = ($nano % 1e9);
}
} else {
$nano = ($secs - int($secs));
$nano *= 1e9;
}
return '' if ($secs == 0 && $nano == 0);
return _encode_tai64n(int($secs),int($nano));
}
=item tai64nlocal ( $tai64n_string )
This utility returns a string representing the tai64n timestamp
converted to local time in ISO format: YYYY-MM-DD HH:MM:SS.SSSSSSSSS.
The reason to include this funtion is to provide compatibility with the
command-line version included in B<daemontools>.
=cut
sub tai64nlocal ($) {
my $tok = shift;
my ($secs,$nano) = _decode_tai64n($tok);
my $x = ($secs ==0) ? '' :
strftime("%Y-%m-%d %H:%M:%S",localtime($secs)) .
sprintf(".%09d",$nano);
return($x);
}
=item :tai64na
TAI64NA Functions as well as Generic Functions
=item tai64naunix ( $tai64na_string )
This method converts the tai64na string given as its only parameter
and if successfull, returns a value for I<timestamp> that is compatible
with the value returned from C<Time::HiRes::time>.
=cut
sub tai64naunix ($) {
my $tok = shift;
return 0 unless (length($tok) == 33);
my ($s,$n,$a) = _decode_tai64na($tok);
$n += ($a/1e9);
$s += ($n/1e9);
return $s;
}
=item unixtai64na ( I<timestamp> )
=item unixtai64na ( I<seconds> , I<nanoseconds> , I<attoseconds> )
This method returns a tai64na string unsing the parameters supplied by the
user making the following assumptions:
=over 6
=item *
If I<seconds>, I<nanoseconds> and I<attoseconds> are given, these values are
used to compute the tai64na string. If either I<nanoseconds> evaluates to
more than 1 second, or I<attoseconds> evaluates to more than 1 nanosecond,
then I<seconds>, I<nanoseconds>, and I<attoseconds> are reevaluated. These
values are assumed to be integers, any fractional part is truncated.
=item *
If I<timestamp> is an integer, both I<nanoseconds> and I<attoseconds> are
assumed to be 0.
=item *
If I<timestamp> is a C<real> number, the integer part is used for the I<seconds>
and the fractional part is converted to I<nanoseconds> amd I<attoseconds>.
=back
=cut
sub unixtai64na ($;$$) {
my($secs,$nano,$atto) = @_;
if (defined($nano)) {
if ($nano >= 1e9) {
$secs += int($nano / 1e9);
$nano = ($nano % 1e9);
}
} else {
$nano = ($secs - int($secs));
$nano *= 1e9;
}
if (defined($atto)) {
if ($atto >= 1e9) {
$nano += int($atto / 1e9);
$atto = ($atto % 1e9);
}
} else {
$atto = ($nano - int($nano));
$atto *= 1e9;
}
return '' if ($secs == 0 and $nano == 0 and $atto == 0);
return _encode_tai64na(int($secs),int($nano),int($atto));
}
#-----
# Make PERL Happy!!
1;
__END__
=head1 SEE ALSO
http://pobox.com/~djb/libtai/tai64.html
http://cr.yp.to/daemontools.html
=head1 AUTHOR
Jorge Valdes, E<lt>jorge@joval.infoE<gt>
=head1 HISTORY
This module was started by AMS, but would not have been completed
if Iain Truskett hadn't taken over. After his death, Jorge Valdes
assumed ownership and rewrote it in Perl.
=head1 COPYRIGHT AND LICENSE
Copyright (C) 2004-2006 by Jorge Valdes
This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself, either Perl version 5.8.3 or,
at your option, any later version of Perl 5 you may have available.
=head1 AVAILABILITY
The lastest version of this library is likely to be available from
CPAN.
=cut
