The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
use strict;
use warnings;


package base_test_input;
use Moose;
use Carp;
with 'Project::Euler::Problem::Base';
sub _build_problem_number { return 1                 }
sub _build_problem_name   { return q{test input}  }
sub _build_problem_date   { return q{2012-12-21}     }
sub _build_problem_desc   { return q{Blah blah blah} }
sub _build_default_input  { return q{42}             }
sub _build_default_answer { return '21'              }
sub _build_help_message   { return q{Help me}        }
sub _check_input          {
    my ($blah, $self, $new) = @_;
    if ($new =~ /\D/) {
        croak q{Input must be all digits};
    }
}
#has '+has_input' => (default => 0);

sub _solve_problem {
    my ($self, $arg) = @_;
    $self->_set_more_info( $self->problem_name );

    if ($self->use_defaults) {
        return $self->default_input / 2;
    }
    else {
        return $arg / 2;
    }
}
no Moose;
__PACKAGE__->meta->make_immutable;



package base_test_noinput;
use Moose;
with 'Project::Euler::Problem::Base';
sub _build_problem_number { return 1                 }
sub _build_problem_name   { return q{test noinput}  }
sub _build_problem_date   { return q{2012-12-21}     }
sub _build_problem_desc   { return q{Blah blah blah} }
sub _build_default_input  { return q{}               }
sub _build_default_answer { return '42'              }
sub _build_help_message   { return q{Help me}        }
sub _check_input          { return 1                 }
has '+has_input' => (default => 0);

sub _solve_problem {
    my ($self, $arg) = @_;
    $self->_set_more_info( $self->problem_name );
    return $self->default_answer;
}
no Moose;
__PACKAGE__->meta->make_immutable;



package base_test_bad;
use Moose;
with 'Project::Euler::Problem::Base';
sub _build_problem_number { return 'a'               }
sub _build_problem_name   { return q{123456789}      }
sub _build_problem_date   { return q{2001-23-43}     }
sub _build_problem_desc   { return undef             }
sub _build_default_input  { return undef             }
sub _build_default_answer { return undef             }
sub _build_help_message   { return undef             }
sub _check_input          { return 0                 }

sub _solve_problem {
    return 1;
}
no Moose;
__PACKAGE__->meta->make_immutable;




package test;

use strict;
use warnings;
use Test::Most;
use Test::Exception;

use Readonly;

Readonly::Scalar my $BASE_URL => q{http://projecteuler.net/index.php?section=problems&id=};
Readonly::Scalar my $CUSTOM_INPUT  => 54;
Readonly::Scalar my $CUSTOM_ANSWER => $CUSTOM_INPUT / 2;


plan tests => 7 + (7 * 2) + (3 * 7) + 2 + 5;

die_on_fail;

# TESTS -> 7
my $t_in  = new_ok( 'base_test_input'   );
my $t_nin = new_ok( 'base_test_noinput' );
my $t_inc = new_ok( 'base_test_input'   );
my $t_bad = new_ok( 'base_test_bad'     );

dies_ok{ $t_inc->custom_input( '1a' ) } 'Only accept digits as custom input';
ok( $t_inc->custom_input(  $CUSTOM_INPUT  ), 'Assign custom input'  );
ok( $t_inc->custom_answer( $CUSTOM_ANSWER ), 'Assign custom answer' );

 $t_in->use_defaults( 1 );
$t_inc->use_defaults( 0 );
$t_nin->use_defaults( 1 );


# TESTS -> 7
is( $t_in->problem_name     , q{test input}    , 'problem_name is set correctly'   );
is( $t_in->problem_date->ymd, q{2012-12-21}    , 'problem_date is set correctly'   );
is( $t_in->problem_desc     , q{Blah blah blah}, 'problem_desc is set correctly'   );
is( $t_in->problem_link     , $BASE_URL . '1'  , 'problem_link is set correctly'   );
is( $t_in->default_input    , q{42}            , 'default_input is set correctly'  );
is( $t_in->default_answer   , q{21}            , 'default_answer is set correctly' );
is( $t_in->help_message     , q{Help me}       , 'help_message is set correctly'   );

# TESTS -> 7
dies_ok { $t_bad->problem_name   }  'problem_name is set correctly';
dies_ok { $t_bad->problem_date   }  'problem_date is set correctly';
dies_ok { $t_bad->problem_desc   }  'problem_desc is set correctly';
dies_ok { $t_bad->problem_link   }  'problem_link is set correctly';
dies_ok { $t_bad->default_input  }  'default_input is set correctly';
dies_ok { $t_bad->default_answer }  'default_answer is set correctly';
dies_ok { $t_bad->help_message   }  'help_message is set correctly';

# TESTS -> *3
for  my $module  ($t_in, $t_inc, $t_nin) {
    my ($status, $answer, $wanted) = $module->solve;
    my $short_answer               = $module->solve;

    my $last_answer = $module->solved_answer;
    my $last_wanted = $module->solved_wanted;
    my $last_status = $module->solved_status;
    my $more_info   = $module->more_info;

    # TESTS -> 7
    is( $status   , $last_status         , 'Status returned and object status should be equal'            );
    is( $wanted   , $last_wanted         , 'Status returned and object status should be equal'            );
    is( $answer   , $last_answer         , 'Answer returned and object answer should be equal'            );
    is( $answer   , $short_answer        , 'The answer returned in scalar and array context should match' );
    is( $answer   , $wanted              , 'Answer returned and required answer should be equal'          );
    is( $more_info, $module->problem_name, 'Correct "more_info" text'                                     );
    ok( $status   ,                        'The status should be true'                                    );
}


# TESTS -> 2
{
    my ($status, $answer, $wanted) = $t_inc->solve;

    isnt( $answer, $t_inc->default_answer, 'Answer and required should not be equal for the custom input' );
    is  ( $wanted, $CUSTOM_ANSWER,         'The wanted and CUSTOM_ANSWER should be the same'              );
}


# TESTS -> 5
{
    $t_inc->custom_answer( $CUSTOM_INPUT );

    my ($status, $answer, $wanted) = $t_inc->solve;

    my $last_answer = $t_inc->solved_answer;
    my $last_wanted = $t_inc->solved_wanted;
    my $last_status = $t_inc->solved_status;

    is  ( $status, $last_status,  'Status returned and object status should be equal'       );
    is  ( $wanted, $last_wanted,  'Status returned and object status should be equal'       );
    is  ( $answer, $last_answer,  'Answer returned and object answer should be equal'       );
    isnt( $answer, $wanted,       'Answer returned and required answer should not be equal' );
    ok  ( !$status,               'The status should not be true'                           );
}