package DateEasyTestUtil;
use strict;
use warnings;
use parent 'Exporter';
our @EXPORT_OK = qw< is_32bit compare_times generate_times_and_compare is_true is_false >;
use Carp;
use Test::More;
use Test::Builder;
# Hopefully tells us whether we're running on a 32-bit machine or not.  No arguments, returns true
# or false.  Technically speaking, this checks the size of pointers, which I suppose might not be
# the same as the size of a time_t.  But hopefully this is close enough.
# Idea stolen from PerlMonks (thanks Tux (H.Merijn)!):
# http://www.perlmonks.org/?node_id=1054237
sub is_32bit
{
        require Config;
        return $Config::Config{ptrsize} == 4;
}
# Two functions to compare times.  See below for full details.
my %LOCAL_FLAG = ( local => 1, UTC => 0, GMT => 0 );
my %TIME_FMT   = ( 'Date::Easy::Date' => '%Y-%m-%d', 'Date::Easy::Datetime' => '%Y-%m-%d %H:%M:%S.000 %Z', );
sub _fmt_time
{
        my ($obj, $fmt) = @_;
        my $formatted = $obj->strftime($fmt);
        if (my $subsecond = $obj->epoch - int($obj->epoch))
        {
                $formatted =~ s/\.000/sprintf(".%3.3f", $subsecond)/e;
        }
        return $formatted;
}
sub _render_times
{
        my $obj = shift;
        my $fmt = $TIME_FMT{ ref $obj };
        my $err_tag = pop;
        my $expected;
        if (@_ == 1)
        {
                $expected = shift;
                $expected = _fmt_time($expected, $fmt) if ref $expected;
        }
        elsif (@_ == 2)
        {
                my ($zone, $epoch) = @_;
                # `scalar` below required because _mktime in list context returns list of time components
                $expected = _fmt_time(scalar Time::Piece->_mktime($epoch, $LOCAL_FLAG{$zone}), $fmt);
        }
        else
        {
                croak("illegal number of arguments $err_tag\n    (2nd time seems to consist of " . scalar @_ . " args)");
        }
        my $got = _fmt_time($obj, $fmt);
        return ($got, $expected);
}
# compare_times
#
# Call in one of two ways:
#
#               compare_times( $date_or_datetime, $date_or_datetime_or_time_piece, $test_name );
#               compare_times( $date_or_datetime, $zone_spec => $epoch_seconds,    $test_name );
#
# This will convert both date(time)s to strings, using a format based on the type (Date::Easy::Date
# or Date::Easy::Datetime) of the first argument.  Comparisons are done with `is` and reported from
# the persepctive of the caller.
sub compare_times
{
        my $testname = pop;
        my $caller = (caller(0))[3];
        my ($got, $expected) = _render_times(@_, "to $caller");
        local $Test::Builder::Level = $Test::Builder::Level + 1;
        is $got, $expected, $testname;
}
# generate_times_and_compare
#
# Call like so:
#
#               generate_times_and_compare { $obj, $other_obj      } $test_name;
#               generate_times_and_compare { $obj, $spec => $epoch } $test_name;
#
# except you probably want your code block to generate at least one of the date(times)s on the fly.
# If not, you could just call `compare_times` (above).  But if there's any chance that the system
# clock rolling over to a new second between assigning the two objects would cause them not to
# match, use this function and allow the code block to generate the objects.  The code block will be
# called up to 10 times: if the two objects match at any point, it bails out and records it as a
# passing test.  If, after 10 tries, they never match, that is recorded as a failing test, and
# reported from the perspective of the caller.
sub generate_times_and_compare (&$)
{
        my ($sub, $testname) = @_;
        # Try to generate and compare up to 10 times.  We're bound to manage to get both times within
        # the same second at least once after that many tries.
        my ($got, $expected);
        my $caller = (caller(0))[3];
        for (1..10)
        {
                ($got, $expected) = _render_times($sub->(), "back from coderef in $caller");
                last if $got eq $expected;
        }
        local $Test::Builder::Level = $Test::Builder::Level + 1;
        is $got, $expected, $testname;
}
# These are my handy-dandy `is_true` and `is_false` functions that I wrote several years back,
# because `ok` doesn't give me enough info on failure, and `is` can't distinguish Perl's several
# false values or its infinitude of true values.  Maybe I will see if I can get these accepted into
# Test::More (or Test::Most, perhaps) one day.
sub is_true ($;$)
{
        my ($value, $testname) = @_;
        local $Test::Builder::Level = $Test::Builder::Level + 1;
        ok $value, $testname or diag("         got: $value\n    expected: something true\n");
}
sub is_false ($;$)
{
        my ($value, $testname) = @_;
        local $Test::Builder::Level = $Test::Builder::Level + 1;
        ok !$value, $testname or diag("         got: $value\n    expected: something false\n");
}