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

use Test::More;
use Config;
use File::Copy::Recursive qw/fcopy/;
use File::Path qw/mkpath/;
use File::Spec::Functions qw/catdir catfile rel2abs/;
use File::Temp qw/tempdir/;
use t::Frontend;
use t::MockHomeDir;

#plan 'no_plan';
plan tests => 21;

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

my $config_dir = catdir( t::MockHomeDir::home_dir, ".cpanreporter" );
my $config_file = catfile( $config_dir, "config.ini" );

my $history_file = catfile( $config_dir, "reports-sent.db" );
my $sample_history_file = catfile(qw/t history reports-sent-longer.db/); 

my @fake_results = (
    { dist_name => 'Baz-Bam-3.14', phase => 'test',  grade => 'pass' },
    { dist_name => 'Foo-Bar-1.23', phase => 'PL',    grade => 'fail' },
    { dist_name => 'Foo-Bar-1.23', phase => 'test',  grade => 'fail' },
    { dist_name => 'Foo-Bar-1.23', phase => 'test',  grade => 'pass' },
    { dist_name => 'Wibble-42',    phase => 'test',  grade => 'pass' },
    { dist_name => 'Wobble-23',    phase => 'PL',    grade => 'na'   },
    { dist_name => 'Inline-0.44',  phase => 'test',  grade => 'pass' },
    { dist_name => 'Crappy-0.01',  phase => 'PL',    grade => 'discard' },
);

#--------------------------------------------------------------------------##
# begin testing
#--------------------------------------------------------------------------#
my @aoh;

mkpath( $config_dir );
ok( -d $config_dir, "temporary config dir created" );

# If old history exists, convert it
fcopy( $sample_history_file, $history_file);
ok( -f $history_file, "copied sample old history file to config directory");

# make it writeable
chmod 0644, $history_file;
ok( -w $history_file, "history file is writeable" );

# load CPAN::Reporter::History and import have_tested for convenience
require_ok( 'CPAN::Reporter::History' );
CPAN::Reporter::History->import( 'have_tested' );

# put in some data for current perl/arch/osname
CPAN::Reporter::History::_record_history($_) for @fake_results;

# one parameter should die
eval { have_tested( 'Wibble-42' ) };
ok ( $@, "have_tested() dies with odd number of arguments" );

# unknown parameter shoudl die
eval { have_tested( distname => 'Wibble-42' ) };
ok ( $@, "have_tested() dies with unknown parameter" );

# have_tested without any parameters should return everything on this platform
@aoh = have_tested();
is( scalar @aoh, scalar @fake_results, 
    "have_tested() with no args gives everything on this platform"
);

# have_tested a dist that was only tested once - return AoH with only one hash
@aoh = have_tested( dist => 'Wibble-42');

is( scalar @aoh, 1, 
    "asking for a unique dist"
);
is( ref $aoh[0], 'HASH',
    "returned an AoH"
);

is_deeply( $aoh[0], 
    {
        phase => 'test',
        grade => 'PASS',
        dist => 'Wibble-42', 
        perl => CPAN::Reporter::History::_format_perl_version(),
        archname => $Config{archname},
        osvers => $Config{osvers},
    },
    "hash fields as expected"
);

# just dist returns all reports for that dist on current platform
@aoh = have_tested( dist => 'Foo-Bar-1.23' );
is( scalar @aoh, 3, 
    "asking for multiple dist reports (only on this platform)"
);

# just dist doesn't return reports from other platforms
@aoh = have_tested( dist => 'ExtUtils-ParseXS-2.18' );
is( scalar @aoh, 0, 
    "asking for multiple dist reports (with none on this platform)"
);

# just phase returns all reports for that dist on current platform
@aoh = have_tested( phase => 'test' );
is( scalar @aoh, 5, 
    "asking for all test phase reports (defaults to this platform)"
);

# just grade returns all reports of that grade on current platform
@aoh = have_tested( grade => 'na' );
is( scalar @aoh, 1, 
    "asking for all na grade reports (defaults to this platform)"
);

# just grade returns all reports of that grade on current platform
@aoh = have_tested( grade => 'NA' );
is( scalar @aoh, 1, 
    "asking for all NA grade reports (defaults to this platform)"
);

# just grade returns all reports of that grade on current platform
@aoh = have_tested( grade => 'DISCARD' );
is( scalar @aoh, 1, 
    "asking for all DISCARD grade reports (defaults to this platform)"
);

# restrict to just a particular dist and phase
@aoh = have_tested( dist => 'Foo-Bar-1.23', phase => 'test' );
is( scalar @aoh, 2, 
    "asking for dist in test phase (defaults to this platform)"
);

# dist reports on any platform
@aoh = have_tested( 
    dist => 'Inline-0.44', perl => q{}, archname => q{}, osvers => q{} 
);
is( scalar @aoh, 2, 
    "asking for dist across any perl/archname/osvers"
);

# restrict to a platform
@aoh = have_tested( 
    archname => 'not-a-real-archname', perl => q{}, osvers => q{} 
);
is( scalar @aoh, 12, 
    "asking for all results from an archname"
);

# restrict to a perl
@aoh = have_tested( 
    perl => '9.10.0', archname => q{}, osvers => q{} 
);
is( scalar @aoh, 9, 
    "asking for all results from a perl version"
);

# restrict to an osver
@aoh = have_tested( 
    perl => q{}, archname => q{}, osvers => q{another-fake-version} 
);
is( scalar @aoh, 3, 
    "asking for all results from an OS version"
);