File Coverage

blib/lib/Protocol/XMLRPC/Value/DateTime.pm

Criterion	Covered	Total	%
statement	27	28	96.4
branch	3	6	50.0
condition	7	15	46.6
subroutine	6	6	100.0
pod	3	3	100.0
total	46	58	79.3

package Protocol::XMLRPC::Value::DateTime;

use strict;
use warnings;

use base 'Protocol::XMLRPC::Value';

require Time::Local;

sub type {'datetime'}

sub parse {
    my $class = shift;
    my ($datetime) = @_;

    my ($year, $month, $mday, $hour, $minute, $second) =
      ($datetime =~ m/(\d\d\d\d)(\d\d)(\d\d)T(\d\d):(\d\d):(\d\d)/);

    die "Invalid 'Datetime' value"
      unless defined $year
          && defined $month
          && defined $mday
          && defined $hour
          && defined $minute
          && defined $second;

    my $epoch;

    # Prevent crash
    eval {
        $epoch =
          Time::Local::timegm($second, $minute, $hour, $mday, --$month, $year);
        1;
    } or do {
        die "Invalid 'DateTime' value";
    };

    die "Invalid 'DateTime' value" if $epoch < 0;

    return $class->new($epoch);
}

sub to_string {
    my $self = shift;

    my $value = $self->value;

    my ($second, $minute, $hour, $mday, $month, $year, $wday) = gmtime($value);

    $year += 1900;
    $month++;

    #19980717T14:08:55
    $value = sprintf('%d%02d%02dT%02d:%02d:%02d',
        $year, $month, $mday, $hour, $minute, $second);

    return "$value";
}

1;
__END__