#!/usr/bin/perl -w

use strict;  # A little anal retention :-)


# Change this if your scripts are at another location.
# Remember that your scripts when tested by the referees
# will be named cantor.pl and kola.pl
my @scripts = qw/cantor.pl kola.pl/;


#----------------------------------------------------------#
#          You should not modify after this line.          #
#----------------------------------------------------------#

# Check solution.
select(STDERR);$|=1; select(STDOUT);$|=1; # auto-flush

my ($total_score, $not_found);
foreach my $script (@scripts) {
    if (!-e $script) {
        printf "  %12s: not found\n", $script;
        $not_found++;
        next;
    }
    my $score = get_golf_score($script);
    printf "  %12s: %5.2f\n", $script, $score;
    $total_score += $score;
}
$total_score = sprintf "%.02f", $total_score;
print "You shot a round of $total_score strokes.\n" unless $not_found;

# Make tests.
my %tests = ( 
    'cantor.pl' => [ [0,"-\n"], [1,"- -\n"], [2,"- -   - -\n"],
[3,"- -   - -         - -   - -\n"],
[4,"- -   - -         - -   - -                           - -   - -         - -   - -\n"],
[5,"- -   - -         - -   - -                           - -   - -         - -   - -                                                                                 - -   - -         - -   - -                           - -   - -         - -   - -\n"]],

    'kola.pl' => [
[ "2 3 20", "22332223332233223332\n" ],
[ "2 3 21", "223322233322332233322\n" ],
[ "2 3 22", "2233222333223322333222\n" ],
[ "2 3 23", "22332223332233223332223\n" ],
[ "3 2 23", "33322233322332233322233\n" ],
[ "4 5 25", "4444555544445555444445555\n" ],
[ "9 8 50", "99999999988888888899999999988888888899999999988888\n" ],
[ "2 3 1", "2\n" ],         # short lengths
[ "2 3 2", "22\n" ],        # short lengths
[ "2 3 3", "223\n" ],
[ "1 2 20", "12211212212211211221\n"],  # first argument = 1
[ "1 5 20", "15555511111555551111\n"],
[ "1 2 1", "1\n" ],
[ "2 1 300", "221121221221121122121121221121121221221121221211211221221121221221121121221211221221121221221121122121121221221121121221121122121121122122112122121122122121121122122112122121121122121121221121121221211221221121221221121121221121122122121121221121122121121122122121121221121121221221121221211211221221\n" ]]
);

# Catching STDERR.
my $ERR = "err.tmp";

my (@skipped, @failed);
HOLE:
foreach my $script ( @scripts ) {
    if (!-e $script) {
        print "Skipped $script\n";
        push @skipped, $script;
        next;
    }
    foreach my $test ( @{$tests{$script}} ) {
        # Prepare command.
        my $cmd = qq("$^X" $script $test->[0] 2>$ERR);
        print "Running '$cmd':\t";
        my $out = `$cmd`;

        # Check STDERR.
        if ( -s $ERR ) {
            print "oops, you wrote to stderr.\n";
            open ERR, "<$ERR" or die $!;
            local $/;               # slurp mode
            my $err = <ERR>;        # dump error output.
            close ERR;
            unlink $ERR;
            print "STDERR output:\n";
            print  "--\n".$err."--\n";
            print "Failed.\n";
            push @failed, $script;
            next HOLE;
        }

        # Check STDOUT.
        if ( $out ne $test->[1] ) {
            print "oops, wrong output.\n";
            print "Expected:\n";
            print "--\n".$test->[1]."--\n";
            print "Got:\n";
            print "--\n".$out."--\n";
            unlink $ERR;
            print "Failed.\n";
            push @failed, $script;
            next HOLE;
        }
        print "done.\n";
    }
}
unlink $ERR;

print "Skipped: @skipped\n" if @skipped;
exit if @failed;
print "Hooray, you passed.\n" unless @skipped;
print "You shot a round of $total_score strokes.\n";
print "(The decimal part is your tie break score.)\n";
print "You can submit your solution at: http://perlgolf.sourceforge.net/cgi-bin/PGAS/leader.cgi?course=3\n" unless @skipped;
exit;

#
# Compute golf score.
sub get_golf_score {
    my $script = shift;

    my $code;
    open F, "<$script" or die $!;
    {
        local $/;
        $code = <F>;
    }
    close F;
    
    $code =~ s/\r/\n/g;
    $code =~ s/\n+/\n/g;
    $code =~ s/\n+$//;           # Free last newline.
    $code =~ s/^#!\S*perl//;     # Shebang.
    $code =~ s/\n//;             # Free first newline.
    my $score = length $code;

    # Compute tie-breaker.
    my $tie  = ( () = $code =~ /\w+|\W+/g ) / (2*length $code);
    $tie    = .49 if $tie > 0.49;
    $score  += $tie;
    return sprintf "%0.2f", $score;
}

__END__