package DateTime::Format::GeekTime;
use 5.005;
use strict;
use warnings;
use DateTime;
use Carp;
use vars '$VERSION';
$VERSION='1.000_002';
$VERSION=eval $VERSION;
sub new {
my ($class,$year)=@_;
if (!defined $year) {
$year = DateTime->now->year;
}
return bless {year=>$year},$class;
}
sub parse_datetime {
my ($self,$string)=@_;
my ($seconds,$days) =
($string =~ m{\A \s*
(?:0x)? ( [0-9a-fA-F]{4} )
(?: [\w\s]*? )
(?:0x)? ( [0-9a-fA-F]{3,4} )
(?: \s+ .)? # optional character representation
\s* \z}smx);
if (!(defined $seconds and defined $days)) {
croak "<$string> is not a proper GeekTime string";
}
$seconds=hex($seconds);$days=hex($days);
$seconds=int($seconds*86_400/65_536+0.5);
my $base_year;
if (ref($self)) {
$base_year=$self->{year};
}
else {
$base_year=DateTime->now->year;
}
my $dt=DateTime->new(year=>$base_year,time_zone=>'UTC');
$dt->add(days=>$days,seconds=>$seconds);
return $dt;
}
sub format_datetime {
my ($self,$dt)=@_;
my $start_of_day=$dt->clone->set_time_zone('UTC')->truncate(to=>'day');
my $seconds=$dt->subtract_datetime_absolute($start_of_day)->in_units('seconds');
my $days=$dt->day_of_year - 1;
$seconds=int($seconds/86_400*65_536+0.5);
my $chr = $seconds <= 0xD800 || $seconds >= 0xDFFF
? ' '.chr($seconds)
: '';
return sprintf '0x%04X on day 0x%03X%s',$seconds,$days,$chr;
}
1;
__END__