File Coverage

blib/lib/Test/Deep/DateTime/RFC3339.pm

Criterion	Covered	Total	%
statement	78	78	100.0
branch	25	28	89.2
condition	7	9	77.7
subroutine	19	19	100.0
pod	1	6	16.6
total	130	140	92.8

package Test::Deep::DateTime::RFC3339;

use strict;
use warnings;
use 5.008_005;
our $VERSION = '0.04';

use Test::Deep::Cmp;    # isa

use Exporter 'import';
our @EXPORT = qw(datetime_rfc3339);

use Carp 'confess';

use DateTime;
use DateTime::Duration;
use DateTime::Format::RFC3339;
use DateTime::Format::Duration::DurationString;
use DateTime::Format::Human::Duration;
use Safe::Isa '$_isa';

sub datetime_rfc3339 {
    __PACKAGE__->new(@_);
}

sub init {
    my $self = shift;

    $self->{parser} = DateTime::Format::RFC3339->new;
    return unless @_;

    my $expected  = shift or confess "Expected datetime required for datetime_rfc3339() with arguments";
    my $tolerance = shift || DateTime::Duration->new; # default to an ->is_zero duration

    unless ($expected->$_isa("DateTime")) {
        my $parsed = eval { $self->{parser}->parse_datetime($expected) }
            or confess "Expected datetime isn't a DateTime and can't be parsed as RFC3339: '$expected', $@";
        $expected = $parsed;
    }
    unless ($tolerance->$_isa("DateTime::Duration")) {
        my $parser = DateTime::Format::Duration::DurationString->new;
        my $parsed = eval { $parser->parse($tolerance)->to_duration }
            or confess "Expected tolerance isn't a DateTime::Duration and can't be parsed: '$tolerance', $@";
        $tolerance = $parsed;
    }

    # Do all comparisons and math in UTC
    $expected->set_time_zone('UTC');

    $self->{expected}  = $expected;
    $self->{tolerance} = $tolerance;

    return;
}

sub descend {
    my ($self, $got) = @_;
    my ($expected, $tolerance) = @$self{'expected', 'tolerance'};

    $got = eval { $self->{parser}->parse_datetime($got) };

    if ($@ or not $got) {
        $self->{diag_message} = sprintf "Can't parse %s as an RFC3339 timestamp: %s",
            (defined $_[1] ? "'$_[1]'" : "an undefined value"), $@;
        return 0;
    }

    $got->set_time_zone('UTC')
        if $expected;

    # This lets us receive the DateTime object in renderGot
    $self->data->{got_string} = $self->data->{got};
    $self->data->{got} = $got;

    return $expected
        ? ($got >= $expected - $tolerance and $got <= $expected + $tolerance)
        : 1;    # we parsed!
}

# reported at top of diagnostic output on failure
sub diag_message {
    my ($self, $where) = @_;
    my $msg = "Compared $where";
    $msg .= "\n" . $self->{diag_message}
        if $self->{diag_message};
    return $msg;
}

# used in diagnostic output on failure to render the expected value
sub renderExp {
    my $self = shift;
    return "any RFC3339 timestamp" unless $self->{expected};

    my $expected = $self->_format( $self->{expected} );
    return $self->{tolerance}->is_zero
        ? $expected
        : $expected . " +/- " . DateTime::Format::Human::Duration->new->format_duration($self->{tolerance});
}

sub renderGot {
    my ($self, $got) = @_;
    return $got->$_isa("DateTime") ? $self->_format($got) : $got;
}

sub _format {
    my $self = shift;
    return $self->{parser}->format_datetime(@_);
}

1;
__END__