#!/usr/bin/env perl

use 5.008004;

use strict;
use warnings;

use lib qw{ tools/lib };

use Data::Dumper;
use DateTime;
use DateTime::Fiction::JRRTolkien::Shire;
use Getopt::Long 2.33 qw{ :config auto_version };
use Pod::Usage;
use Time::Local;

our $VERSION = '0.908_01';

my %opt = (
    output	=> 'xt/author/regression.t',
);

GetOptions( \%opt,
    qw{ idempotent! output=s },
    help => sub { pod2usage( { -verbose => 2 } ) },
) or pod2usage( { -verbose => 0 } );

unless ( '-' eq $opt{output} ) {
    $opt{idempotent}
	and -f $opt{output}
	and exit;
    open my $fh, '>', $opt{output}
	or die "Unable to open $opt{output}: $!\n";
    select $fh;
}

my @test_years = (	# [ start, finish ] with interval open on right
    [ 1999, 2003 ],	# January 1 1999 through December 31 2002
    [ 2035, 2039 ],	# January 1 2035 through December 31 2038
);

my $count = 0;
foreach my $interval ( @test_years ) {
    $count += test_years( @{ $interval } );
}

my $dts_version = DateTime::Fiction::JRRTolkien::Shire->VERSION();

print <<"EOD";
package main;

use 5.006002;

use strict;
use warnings;

use DateTime;
use DateTime::Fiction::JRRTolkien::Shire;
use Test::More 0.47;	# The best we can do with 5.6.2.
use Time::Local;

plan tests => $count;

print <<'EOT';
# Created @{[ scalar gmtime ]} UT
# using Date::Tolkien::Shire $dts_version
EOT

my ( \$dts, \$epoch );
EOD

foreach my $interval ( @test_years ) {
    test_years( @{ $interval }, 1 );
}

print <<'EOD';

1;

# ex: set textwidth=72 :
EOD

sub test_years {
    my ( $start_year, $finish_year, $emit ) = @_;

    my $count = 0;

    my $epoch = timelocal( 0, 0, 12, 1, 0, $start_year );
    my $last = timelocal( 0, 0, 12, 1, 0, $finish_year );

    $emit
	or return ( $last - $epoch ) / 86400 * 24;

    while ( $epoch < $last ) {
	my ( undef, undef, undef, $day, $mon, $yr ) = localtime $epoch;
	$yr += 1900;
	$mon++;

	my $date = sprintf '%04d-%02d-%02d Gregorian', $yr, $mon, $day;

	my $dts = DateTime::Fiction::JRRTolkien::Shire->from_object(
	    object	=> DateTime->new(
		year	=> $yr,
		month	=> $mon,
		day	=> $day,
	    ),
	);

	print <<"EOD";

\$epoch = timegm( 0, 0, 0, $day, $mon - 1, $yr );
\$dts = DateTime::Fiction::JRRTolkien::Shire->from_object(
    object	=> DateTime->new(
	year	=> $yr,
	month	=> $mon,
	day	=> $day,
    ),
);
EOD

	no warnings qw{ qw };
	foreach my $method ( qw{
	    #calendar_name
	    #clone
	    day
	    day_name
	    day_name_trad
	    day_of_month
	    day_of_week
	    day_of_year
	    dow
	    doy
	    epoch
	    #from_day_of_year
	    #from_epoch
	    #from_object
	    hires_epoch
	    holiday
	    holiday_name
	    is_leap_year
	    #last_day_of_month
	    mday
	    month
	    month_name
	    #new
	    #now
	    on_date
	    #set
	    #set_time_zone
	    #time_zone
	    #time_zone_long_name
	    #time_zone_short_name
	    #today
	    #truncate
	    utc_rd_as_seconds
	    utc_rd_values
	    wday
	    week
	    week_number
	    week_year
	    year
	} ) {
	    $method =~ m/ \A [#] /smx
		and next;
	    my $title = "$method() on $date";
	    my @r = $dts->$method();
	    my ( $rslt, $call );
	    if ( @r > 1 ) {
		$call = "[ \$dts->$method() ]";
		$rslt = \@r;
	    } else {
		$call = "\$dts->$method()";
		$rslt = $r[0];
	    }
	    if ( ! defined $rslt ) {
		print <<"EOD";
is( $call, undef, '$title' );
EOD
	    } elsif ( ref $rslt ) {
		local $Data::Dumper::Terse = 1;
		my $dump = Dumper( $rslt );
		print <<"EOD";
is_deeply( $call, $dump, '$title' );
EOD
	    } elsif ( $rslt =~ m/ \A [0-9]+ \z /smx ) {
		$method =~ m/ epoch /smx
		    and $rslt = '$epoch';
		print <<"EOD";
cmp_ok( $call, '==', $rslt, '$title' );
EOD
	    } elsif ( $rslt =~ s/ \n \z //smx ) {
		print <<"EOD";
cmp_ok( $call, 'eq', <<'EOT', '$title' );
$rslt
EOT
EOD
	    } else {
		$rslt =~ s/ (?= ['] ) /\\/smxg;
		print <<"EOD";
cmp_ok( $call, 'eq', '$rslt', '$title' );
EOD
	    }
	}

	$epoch += 86400;
	$count++;
    }

    return $count;
}

__END__

=head1 TITLE

make-regression - Generate a regression test

=head1 SYNOPSIS

 make-regression
 make-regression -output xt/author/regression.new
 make-regression -help
 make-regression -version

=head1 OPTIONS

=head2 -help

This option displays the documentation for this script. The script then
exits.

=head2 -idempotent

If this Boolean option is asserted and the output file exists, it is not
overwritten. This option is ignored if the output is F<->.

The default is C<-noidempotent>.

=head2 -output

 -output xt/author/regression.t

This option specifies the output file. A single dash (F<->) is
understood as specifying standard output.

The default is F<xt/author/regression.t>.

=head2 -version

This option displays the version of this script. The script then exits.

=head1 DETAILS

This Perl script generates a regression test to detect any change in
behaviour of the L<Date::Tolkien::Shire|Date::Tolkien::Shire> module.
This test consists of calling each method for each day in the intervals
1999-01-01 to 2002-12-31 inclusive, and 2035-01-01 to 2038-12-31
inclusive, and verifying that all calls produce the same results as when
the regression test was generated.

=head1 AUTHOR

Thomas R. Wyant, III F<harryfmudd at comcast dot net>

=head1 COPYRIGHT AND LICENSE

Copyright (C) 2017-2022, 2025-2026 by Thomas R. Wyant, III

This program is free software; you can redistribute it and/or modify it
under the same terms as Perl 5.10.0. For more details, see the full text
of the licenses in the files F<LICENSE-Artistic> and F<LICENSE-GPL>.

This program is distributed in the hope that it will be useful, but
without any warranty; without even the implied warranty of
merchantability or fitness for a particular purpose.

=cut

# ex: set textwidth=72 :
