#!/usr/bin/perl
#
# by Erik Osheim
use warnings FATAL => 'all';
use strict;
use File::Basename qw(dirname basename);
use File::Spec::Functions qw(rel2abs);
use List::Util qw(first max);
use Getopt::Long qw(:config bundling no_ignore_case);

# some nice global variables
my $quiet     = 0;
my $verbose   = $ENV{VERBOSE};
my $forcepath = $ENV{FORCE_PATH};
my $usecolor  = 1;

sub usage {
    my $prog = basename($0);
    print <<USAGE;
Usage: $prog [options]

Options:
    -h,--help          show this message
    -c,--color         use ANSI colors (default)
    -C,--no-color      don't use ANSI colors
    -q,--quiet         only show summary output
    -v,--verbose       show all test output
    -f,--forcepath     force test cases to use the game's data file paths
    -F,--no-forcepath  test cases use alternate data file paths (default)

Runs all the unit tests and reports the results.
USAGE
    exit(@_);
}

# print strings with (optional) ANSI color
sub red    { $usecolor ? ("\033[01;31m", @_, "\033[0m") : (@_) }
sub green  { $usecolor ? ("\033[01;32m", @_, "\033[0m") : (@_) }
sub yellow { $usecolor ? ("\033[01;33m", @_, "\033[0m") : (@_) }
sub blue   { $usecolor ? ("\033[01;34m", @_, "\033[0m") : (@_) }

# determine which color to use: green == 100% > yellow >= 90% > red
sub getcolor {
    my ($pass, $total) = @_;
    my $perc = $total ? ($pass * 100) / $total : 100;
    return $pass == $total ? \&green : $perc >= 90 ? \&yellow : \&red;
}

sub main {
    GetOptions(
        'help|h'         => sub { usage(0) },
        'color|c'        => sub { $usecolor = 1 },
        'no-color|C'     => sub { $usecolor = 0 },
        'verbose|v'      => sub { $verbose = 1; $quiet = 0 },
        'quiet|q'        => sub { $quiet = 1; $verbose = 0 },
        'forcepath|f'    => sub { $forcepath = 1 },
        'no-forcepath|F' => sub { $forcepath = 0 },
    ) || usage(1);

    # Want the absolute path so that changing directories before running the
    # test does not invalidate the results from find.
    my $dir     = rel2abs(dirname($0));
    my @paths   = `find $dir -mindepth 2 -maxdepth 2 -type f -perm -u+x`;
    my $pass    = 0;
    my $total   = 0;
    my $maxpath = (max map { length($_) } @paths) - 3;
    my $len     = $maxpath - length($dir) + 3 + 7;
    my $workdir = $ENV{TEST_WORKING_DIRECTORY};
    my $exitcode = 0;
    
    if (length($workdir)) {
        chdir $workdir;
    }
    print "Running ", scalar(@paths), " suites:\n" unless $quiet;
    foreach my $path (sort @paths) {
        chomp $path;

        # actually run the test program here, getting the lines of output
        my @lines = ($verbose and $forcepath) ? `$path -vf` :
                    $verbose ? `$path -v` :
                    $forcepath ? `$path -f` : `$path`;

        if ($? != 0) {
            print red("$path: Suite died"), "\n";
            $exitcode = $?;

            # We don't know how many tests the suite had,
            # but at least one failed
            $total += 1; 
            next;
        }
        unless ($lines[-1] =~ m#^([^:]+) finished: (\d+)/(\d+) passed\r?$#) {
            print red("$path: Malformed output"), "\n";
            $exitcode = 1;
            next;
        }

        # tally the results
        $pass  += $2;
        $total += $3;
    
        next if $quiet;

        # print a one-line summary of what happened
        my $ns    = "$2/$3";
        my $pad   = $len - length($1) - length($ns);
        my $color = getcolor($2, $3);
        if ($verbose) {
            print '  ', $_ for @lines[0..$#lines - 1];
            print '    ', $1, ' finished: ', &$color($ns), " passed\n";
        } else {
            print '    ', $1, ' ' x $pad, &$color($ns), " passed\n";
        }
    }

    # print a summary of all the test results
    my $color = getcolor($pass, $total);
    my $ns    = join('', &$color("$pass/$total"));
    my $ps    = join('', &$color(sprintf("%.1f%%", ($total ? ($pass * 100) / $total : 100))));
    
    printf("Total: %s passed (%s)\n", $ns, $ps);

    if ($exitcode != 0 && $pass != $total) {
        $exitcode = 2;
    }
    exit($exitcode);
}

main();
