view release on metacpan or  search on metacpan

tools/make-regression  view on Meta::CPAN

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' );