Time::TAI64 - Perl extension for converting TAI64 strings into standard unix timestamps.

  use Time::TAI64 qw/tai64n/;
  use Time::HiRes qw/time/;

  $now = time; # High precision
  printf "%s\n", unixtai64n($now);

  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;

package Time::TAI64;
# vim: et ts=4

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;
}

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;
}

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));
}

sub tai64unix ($) {
    my $tok = shift;
    return 0 unless (length($tok) == 17);
    my $s = _decode_tai64($tok);
    return $s;
}

sub unixtai64 ($) {
    my $secs = shift;
    return '' if ($secs == 0);
    return _encode_tai64(int($secs));
}

sub tai64nunix ($) {
    my $tok = shift;
    return 0 unless (length($tok) == 25);
    my($s,$n) = _decode_tai64n($tok);
    $s += ($n/1e9);
    return $s;
}

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));
}

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);
}

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;
}

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__