#!/usr/bin/perl

use warnings;
use strict;

use File::Spec;
use File::Basename;

use lib qw/tests lib/;

use Config;
use Tools;             # test tools
use Mail::Reporter;    # to avoid 'too late for INIT'

use IO::Dir;
use TAP::Harness  ();

# we use Test::More without a plan here, but we don't want
# Test::Builder to mess with the exit code
Test::More->builder->no_ending(1);

chdir 'tests'    ##### CHANGE DIR TO tests
   or die "Cannot go to test scripts directory: $!\n";

my $verbose = 0;
if(@ARGV && $ARGV[0] eq '-v')
{   $verbose = 1;
    shift @ARGV;
}

my $select_tests;
if(@ARGV)
{   my $pat = join '|', @ARGV;
    $select_tests   = qr/$pat/o;
}

# The versions of the following packages are reported to help understanding
# the environment in which the tests are run.  This is certainly not a
# full list of all installed modules.
my @show_versions = defined $select_tests ? ()
 : qw/Mail::Box Mail::Box::Parser::C
      User::Identity Object::Realize::Later MIME::Types
      TAP::Harness Encode MIME::Entity Mail::Internet HTML::FormatText
     /;

my $skip_tests = ($ENV{MAILBOX_RUN_TESTS} || 'yes') eq 'no'
              || -f 'skiptests' || -f '../skiptests';

sub package_of($);
sub testnames($);
sub run_in_harness(@);
sub report();
sub dl_format($@);

warn <<'WARN' unless $select_tests;

*
* Testing MailBox
WARN

if($skip_tests)
{   warn <<'WARN';
* Tests are disabled, because you said so when the Makefile was created.
* remove the file "skiptests" if you want to run them and/or clear
* environment variable MAILBOX_RUN_TESTS
*
WARN
    exit 0;
}

warn <<'WARN' unless $select_tests;
*
* Sometimes installing MailBox breaks because of the huge size
* of the whole package. Simply restarting the installation is in
* most cases enough to solve the problems.  You may require a new
* version of ExtUtils::MakeMaker.
*
* On *Windows* you will get a large number of failing tests, but they
* are usually harmless.  Please help me to get rit of them.
*

WARN

warn "Running on $^O ($Config{archname} $Config{osvers}), with Perl $]\n";

foreach my $package (@show_versions)
{   eval "require $package";

    my $report
      = !$@                    ? "version ". ($package->VERSION || 'unknown')
      : $@ =~ m/^Can't locate/ ? "not installed"
      : "reports error";

    warn "$package $report\n";
}
warn "\n";

#
# Get all the test-sets.
#

my $testdir = '.';
my $setdir  = IO::Dir->new($testdir);
die "Cannot open directory $testdir: $!"
     unless $setdir;

my @sets = sort grep { /^\d/ && -d File::Spec->catfile($testdir, $_) } 
                  $setdir->read;

$setdir->close;

my (%success, %skipped);
my $tests_run = 0;

foreach my $set (@sets)
{
    my $script = File::Spec->catfile($testdir, $set, 'Definition.pm');

    eval "require '$script'";
    if($@)
    {   warn "Errors while requiring $script:\n$@";
        next;
    }

    my $package  = package_of $set;

    if(my $reason = $package->skip)
    {   $skipped{$set} = $reason;
        printf "%-15s -- %s\n", $set, $reason;
        next;
    }

    my @tests = testnames $set;
    @tests    = grep { $_ =~ $select_tests } @tests
       if defined $select_tests;

    if(@tests)
    {   printf "%-15.15s -- %d %s %s\n", $set, scalar @tests,
           (@tests==1 ? "script; " : "scripts;"), $package->name;
    }
    elsif(defined $select_tests)  { ; }  # silence
    else
    {   printf "%-15.15s -- skip all tests for %s\n", $set, $package->name;
    }

    next unless @tests;

    $success{$set} = run_in_harness @tests;
    $tests_run += @tests;
}

my $critical = $tests_run ? report : 0;
exit $critical;

#
# PACKAGE_OF SET
# Returns the name of the package which contains details about the test-set.
#

sub package_of($) { "MailBox::Test::$_[0]::Definition" }

#
# TESTNAMES SET
# Returns a list of all the test for a certain test-set.
#

sub testnames($)
{   my $set = shift;
    my $dirname = File::Spec->catdir($testdir, $set);

    my $dir = IO::Dir->new($dirname)
        or return ();

    sort
        map { File::Spec->catfile($dirname, $_) }
            grep /\.t$/, $dir->read;
}

#
# RUN_IN_HARNESS @files
# Run the specified test files in a harness, but then the MailBox
# way doing things.
#

sub run_in_harness(@)
{   my @files = @_;
    return 1 unless @files;

    # cannot use $harness->runtests() because it always shows summary
    my $harness   = TAP::Harness->new( {verbosity => ($verbose ? 1 : 0)} );
    my $aggregate = TAP::Parser::Aggregator->new;
    $harness->aggregate_tests($aggregate, @files);
    not $aggregate->has_problems;
}

#
# PRINT_REPORT
#

sub report()
{
    print "--- Test report\n";

    my @success = sort grep {$success{$_}} keys %success;

    local $"    = ', ';
    dl_format(Success => @success) if @success;

    my @failed;
    my $critical = 0;

    foreach my $set (sort grep {not $success{$_}} keys %success)
    {   push @failed, $set;

        my $package = package_of $set;
        if($package->critical)
        {   $failed[-1] .= '(*)';
            $critical++;
        }
    }

    dl_format(Failure => @failed) if @failed;
    print "    Marked (*) are critical errors.\n" if $critical;

    my @skipped = sort keys %skipped;
    dl_format(Skipped => @skipped)     if @skipped;

    $critical;
}

#
# DL_FORMAT DT, DD-LIST
# Print in an HTML description-list fashion, with $" between the elements.
#

sub dl_format($@)
{   my $line = (shift) . ': ';
    my $elem = shift;

    while(defined $elem)
    {   $elem .= $" if @_;
        if(length($line) + length($elem) > 72)
        {   print "$line\n";
            $line = "    ";
        }
        $line .= $elem;
        $elem  = shift;
    }

    print "$line\n" if $line =~ /[^ ]/;
}