File Coverage

blib/lib/DateTime/Format/GeekTime.pm

Criterion	Covered	Total	%
statement	42	50	84.0
branch	3	8	37.5
condition	1	3	33.3
subroutine	8	10	80.0
pod	3	3	100.0
total	57	74	77.0

package DateTime::Format::GeekTime;
use 5.005;
use strict;
use warnings;
use DateTime;
use Carp;
use vars '$VERSION';

$VERSION='1.000_001';
$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,$warn);
    {
        local $SIG{__WARN__}=sub {$warn=shift};
        $chr=chr($seconds);
    }
    if (defined $warn) {$chr=''}
    else {$chr=" $chr"};

    return sprintf '0x%04X on day 0x%03X%s',$seconds,$days,$chr;
}

1;
__END__