diff options
| -rw-r--r-- | Makefile.PL | 1 | ||||
| -rw-r--r-- | lib/DateTime/Format/GeekTime.pm | 148 | ||||
| -rw-r--r-- | t/format.t | 46 | ||||
| -rw-r--r-- | t/precision.t | 18 | ||||
| -rw-r--r-- | t/precision2.t | 22 |
5 files changed, 225 insertions, 10 deletions
diff --git a/Makefile.PL b/Makefile.PL index 722d778..30437aa 100644 --- a/Makefile.PL +++ b/Makefile.PL @@ -4,5 +4,6 @@ name 'DateTime-Format-GeekTime'; all_from 'lib/DateTime/Format/GeekTime.pm'; requires 'DateTime' => 0; +requires 'Carp' => 0; WriteAll; diff --git a/lib/DateTime/Format/GeekTime.pm b/lib/DateTime/Format/GeekTime.pm index 534e86a..9eb367b 100644 --- a/lib/DateTime/Format/GeekTime.pm +++ b/lib/DateTime/Format/GeekTime.pm @@ -1,32 +1,166 @@ 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->truncate(to=>'day')->set_time_zone('UTC'); - my $start_of_year=$dt->clone->truncate(to=>'year')->set_time_zone('UTC'); + 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->subtract_datetime_absolute($start_of_year)->in_units('days'); - $seconds*=(65_536/86_400); + my $days=$dt->day_of_year - 1; + + $seconds=int($seconds/86_400*65_536+0.5); - my $chr=eval { chr($seconds) }; - if (!defined $chr) {$chr=''} + my ($chr,$warn); + { + local $SIG{__WARN__}=sub {$warn=shift}; + $chr=chr($seconds); + } + if (defined $warn) {$chr=''} else {$chr=" $chr"}; - return sprintf '0x%04X 0x%04X%s',$seconds,$days,chr($seconds); + return sprintf '0x%04X on day 0x%03X%s',$seconds,$days,$chr; } 1; +__END__ + +=head1 NAME + +DateTime::Format::GeekTime - parse and format GeekTime + +=head1 SYNOPSIS + + use DateTime::Format::GeekTime; + use DateTime; + + my $dt=DateTime->now(); + print DateTime::Format::GeekTime->format_datetime($dt); + + $dt=DateTime::Format::GeekTime->parse_datetime('0xBA45 on day 0x042'); + + $dt=DateTime::Format::GeekTime->new(2010) + ->parse_datetime('0xBA45 on day 0x042'); + +=head1 DESCRIPTION + +This module formats and parses "GeekTime". See L<http://geektime.org/> +for the inspiration. + +=head1 METHODS + +=over 4 + +=item C<new> + + my $dtf=DateTime::Format::GeekTime->new(2010); + +The single optional parameter to C<new> is the year to use for +parsing. Since GeekTime does not carry this information, we have to +supply it externally. If you don't specify it, or if you call +C<parse_datetime> as a class method, the current yuor will be used. + +=item C<format_datetime> + + my $string=DateTime::Format::GeekTime->format_datetime($dt); + +Returns the full GeekTime string, like C<0x0041 on day 0x042 A>. + +Note the character at the end of the string: it's the character +corresponding to the Unicode codepoint with the same value as the +first word in the string. If the codepoint corresponds to a "high +surrogate" or a "low surrogate", the character (and the preceding +space) will not be returned. + +=item C<parse_datetime> + + my $dt=DateTime::Format::GeekTime->parse_datetime('0xb4b1 0x0042'); + +Parses a GeekTime and returns a C<DateTime> object. + +The parsing is somewhat lenient: you can omit the C<0x>, you can +express the day as 3 or 4 digits, all space is optional (as is the "on +day" in the middle). The character after the day number is ignored, if +present. + +=back + +=head1 NOTES + +Since GeekTime divides the day in 65536 intervals, but we usually +divide it in 86400 seconds, don't expect all times to round-trip +correctly: some loss of precision is to be expected. Note that going +from GeekTime to a C<DateTime> object and back to GeekTime is +guaranteed to give you the same numbers you started from. Going the +other way can lose one second. + +=head1 AUTHOR + +Gianni Ceccarelli <dakkar@thenautilus.net> + +GeekTime http://geektime.org/ http://twitter.com/geektime + +=head1 COPYRIGHT and LICENSE + +This program is E<copy> 2010 Gianni Ceccarelli. This library is free +software; you can redistribute it and/or modify it under the same +terms as Perl itself. + +=head1 SEE ALSO + +http://geektime.org/ + +L<DateTime> + +=cut @@ -1,8 +1,48 @@ #!perl -use Test::More; +use Test::More tests=>17; use DateTime; use DateTime::Format::GeekTime; +{ my $dt=DateTime->new(year=>2010,month=>3,day=>8, - hour=>16,minute=>56,seconds=>23); -diag DateTime::Format::GeekTime->format_datetime($dt); + hour=>17,minute=>56,second=>23, + time_zone=>'Europe/Rome', + ); +is(DateTime::Format::GeekTime->format_datetime($dt), + "0xB4B1 on day 0x042 \x{b4b1}"); +} + +{ +my $dt=DateTime::Format::GeekTime->parse_datetime("0xB4B1 0x0042 \x{b4b0}"); +is($dt->month,3); +is($dt->day,8); +is($dt->hour,16); +is($dt->minute,56); +is($dt->second,23); +is($dt->time_zone->name,'UTC'); + +my $other=DateTime::Format::GeekTime->parse_datetime("0xB4B1 0x0042"); +cmp_ok($dt,'==',$other); +$other=DateTime::Format::GeekTime->parse_datetime("0xB4B1 on day 0x0042"); +cmp_ok($dt,'==',$other); +$other=DateTime::Format::GeekTime->parse_datetime("B4B1 0042"); +cmp_ok($dt,'==',$other); +$other=DateTime::Format::GeekTime->parse_datetime("B4B10042"); +cmp_ok($dt,'==',$other); +$other=DateTime::Format::GeekTime->parse_datetime("b4b10042"); +cmp_ok($dt,'==',$other); +$other=DateTime::Format::GeekTime->parse_datetime("0xB4B1 0x042"); +cmp_ok($dt,'==',$other); +$other=DateTime::Format::GeekTime->parse_datetime("B4B1 042"); +cmp_ok($dt,'==',$other); +$other=DateTime::Format::GeekTime->parse_datetime("B4B1042"); +cmp_ok($dt,'==',$other); +$other=DateTime::Format::GeekTime->parse_datetime("b4b1042"); +cmp_ok($dt,'==',$other); +} + +{ # bad codepoint +my $dt=DateTime::Format::GeekTime->parse_datetime('0xdc01 0x000'); +is(DateTime::Format::GeekTime->format_datetime($dt), + '0xDC01 on day 0x000'); +} diff --git a/t/precision.t b/t/precision.t new file mode 100644 index 0000000..751e1d6 --- /dev/null +++ b/t/precision.t @@ -0,0 +1,18 @@ +#!perl +use Test::More; +use DateTime; +use DateTime::Format::GeekTime; + +if ($ENV{SLOW_TESTS}) { + plan tests=>65536; +} +else { + plan skip_all => 'Slow test, set $ENV{SLOW_TESTS} to run it'; +} + +for my $i (0..65535) { + my $gkt=sprintf '0x%04X on day 0x000',$i; + my $dt=DateTime::Format::GeekTime->parse_datetime($gkt); + my $round_trip=DateTime::Format::GeekTime->format_datetime($dt); + is(substr($round_trip,0,19),$gkt); +} diff --git a/t/precision2.t b/t/precision2.t new file mode 100644 index 0000000..ef38f2a --- /dev/null +++ b/t/precision2.t @@ -0,0 +1,22 @@ +#!perl +use Test::More; +use DateTime; +use DateTime::Format::GeekTime; + +if ($ENV{SLOW_TESTS}) { + plan tests=>86400; +} +else { + plan skip_all => 'Slow test, set $ENV{SLOW_TESTS} to run it'; +} + +my $dt=DateTime->new(day=>1,month=>1,year=>2010, + hour=>0,minute=>0,second=>0, + time_zone=>'UTC'); +for my $i (0..86399) { + my $gkt=DateTime::Format::GeekTime->format_datetime($dt); + my $round_trip=DateTime::Format::GeekTime->parse_datetime($gkt); + my $diff=$round_trip->subtract_datetime_absolute($dt)->in_units('seconds'); + cmp_ok($diff,'<=',1); + $dt->add(seconds=>1); +} |