The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!perl
use strict;
BEGIN{ if (not $] < 5.006) { require warnings; warnings->import } }

select(STDERR); $|=1;
select(STDOUT); $|=1;

use Test::More;
use t::MockCPANDist;
use t::Helper;
use t::Frontend;
use Config;

my @prereq_cases = (
      #module               #need       #have   #ok?
    [ 'Bogus::Found',       1.23,                   3.14,       1 ],
    [ 'Bogus::Shadow',      3.14,                   3.14,       1 ],
    [ 'Bogus::NotFound',    1.49,                   "n/a",      0 ],
    [ 'Bogus::TooOld',      2.72,                   0.01,       0 ],
    [ 'Bogus::NoVersion',   0,                      0,          1 ],
    [ 'Bogus::GTE',         '>= 3.14',              3.14,       1 ],
    [ 'Bogus::GT',          '>3.14',                3.14,       0 ],
    [ 'Bogus::LTE',         '<= 3.15',              3.14,       1 ],
    [ 'Bogus::LT',          '<3.14',                3.14,       0 ],
    [ 'Bogus::Conflict',    '!= 3.14',              3.14,       0 ],
    [ 'Bogus::Complex',     '>= 3, !=3.14, < 4',    3.14,       0 ],
    [ 'Bogus::Broken',      '0',                    'broken',   0 ],
    [ 'perl',               5.00,                   $],         1 ],   
);

my @scenarios = (
    #[ "old CPAN-style", undef ], # undef is signal and helps keep count
    [ "only one", qw/requires/ ],
    [ "only one", qw/build_requires/ ],
    [ "both types", qw/requires build_requires/ ],
);

my $scenario_count;
$scenario_count += @$_ - 1 for @scenarios;

plan tests => 2 + test_fake_config_plan() + 
              $scenario_count * ( 1 + 4 * @prereq_cases );

#--------------------------------------------------------------------------#
# Fixtures
#--------------------------------------------------------------------------#

my %prereq_pm = map { @{$_}[0,1] } @prereq_cases;

my ($module_width, $prereq_width) = (0,0);
for my $case ( @prereq_cases ) {
    $module_width = length $case->[0] if length $case->[0] > $module_width;
    $prereq_width = length $case->[1] if length $case->[1] > $prereq_width;
}

my $expect_regex = '\s+(!|\s)\s' .
                   '(.{' . $module_width . '})\s' .
                   '(.{' . $prereq_width . '})\s(\S+)';
# \s+         leading spaces
# (!|\s)      capture bang or space
# \s         separator space
# (.{N})       module name
# \s         separator space
# (.{N})       module version needed
# \s         separator space
# (\S+)       module version found


my @mock_defaults = (
    pretty_id => "JOHNQP/Bogus-Module-1.23.tar.gz",
    author_id       => "JOHNQP",
    author_fullname => "John Q. Public",
);

my ($got, @got, $expect);

#--------------------------------------------------------------------------#
# Begin tests
#--------------------------------------------------------------------------#

my $perl5lib = File::Spec->rel2abs( File::Spec->catdir( qw/ t perl5lib / ) );
my $shadowlib = File::Spec->rel2abs( 
    File::Spec->catdir( qw/ t perl5lib-shadow / ) );
local $ENV{PERL5LIB} = join $Config{path_sep}, 
                            $perl5lib, $shadowlib, $ENV{PERL5LIB};

require_ok('CPAN::Reporter');

test_fake_config();

#--------------------------------------------------------------------------#
# Test no prereq
#--------------------------------------------------------------------------#

{
    my $mock_dist = t::MockCPANDist->new( 
        @mock_defaults,
        prereq_pm => { },
    );

    $got = CPAN::Reporter::_prereq_report( $mock_dist );
    like( $got, '/^\s*No requirements found\s*$/ms',
            "No requirements specified message correct"
    );
}

#--------------------------------------------------------------------------#
# Scenario testing
#--------------------------------------------------------------------------#

for my $scene ( @scenarios ) {
    
    my ($label, @keys ) = @$scene;
    
    # initialize -- we need to have both keys for CPAN::Reporter
    # to detect new CPAN style
    my %scenario_prereq = (
        requires => undef,
        build_requires => undef,
    );

    # load up prereqs into one or more keys (new style) or replace
    # %scenario_prereq if old, flat style
    if ( @keys ) {
        if ( defined $keys[0] ) {
            $scenario_prereq{$_} = { %prereq_pm } for @keys;
        }
        else {
            # do it old style, but set up $keys[0] to act like "requires"
            # for analysis of output
            %scenario_prereq = %prereq_pm;
            $keys[0] = 'requires';
        }
    }
    
    my $mock_dist = t::MockCPANDist->new( 
        @mock_defaults,
        prereq_pm => { %scenario_prereq },
    );

    $got = CPAN::Reporter::_prereq_report( $mock_dist );
#    diag $got;
    @got = split /\n+/ms, $got;

    for my $prereq_type ( @keys ) {
        like( shift( @got), '/^' . $prereq_type . ':\s*$/ms',
            "$label: '$prereq_type' header"
        );

        # Dump header lines
        splice( @got, 0, 2 );

        for my $case ( sort { lc $a->[0] cmp lc $b->[0] } @prereq_cases ) {
            my ($exp_module, $exp_need, $exp_have, $exp_ok) = @$case;
            my $line = shift(@got);
            my ($bang, $module, $need, $have) = 
                ( $line =~ /^$expect_regex\s*$/ms );
            # trim trailing spaces from fixed-width captures
            $module =~ s/\s*$//;
            $need =~ s/\s*$//;
            is( $module, $exp_module,
                "$label ($prereq_type): found '$exp_module' in report"
            );
            is( $bang, ($exp_ok ? ' ' : '!'),
                "$label ($prereq_type): '$exp_module' flag correct"
            ) or diag "LINE: $line";
            is( $exp_need, $need,
                "$label ($prereq_type): '$exp_module' needed version correct"
            ) or diag "LINE: $line";
            # Check numerically, too, since version.pm/bleadperl will make 
            # 1.2 into 1.200
            ok( $exp_have eq $have || $exp_have == $have,
                "$label ($prereq_type): '$exp_module' installed version correct"
            ) or diag "LINE: $line";
        }
    }
}