#! /usr/bin/perl -w
use strict;
my $tmp   = "in.tmp";
my $error = "err.tmp";

$|=1;

my $file1 = <<'EOF';
amstelveen
Amsterdam
Amsterdam5
Amsterdam40
Amsterdamned
EOF
    ;
my $file2 = <<'EOF';
Amsterdamned
Amsterdam40
Amsterdam5
Amsterdam
amstelveen
EOF
    ;

my $file3 =<<'EOF';
6
40
a5
a1234567890de
aa  bb
ab123cd1348764379425765984276598428976457gh3z123235q
ab123cd1348764379425765984276598428976458gh3z123235q
ab123cd1348764379425765984276598428976459gh3z123235p
ab123cd1348764379425765984276598428976459gh3z123235q
ab123cd1348764379425765984276598428976459gh20z123235q
ab123cd1348764379425765984276598428976459gh20z123235r
ab123cd9999999999999999999999999999999999gh20z123235r
ab123cd10000000000000000000000000000000000gh20z123235r
EOF
    ;

my $file4 =<<'EOF';
ab123cd1348764379425765984276598428976459gh20z123235r
ab123cd10000000000000000000000000000000000gh20z123235r
6
ab123cd1348764379425765984276598428976457gh3z123235q
aa  bb
ab123cd9999999999999999999999999999999999gh20z123235r
ab123cd1348764379425765984276598428976459gh3z123235q
a5
ab123cd1348764379425765984276598428976459gh20z123235q
a1234567890de
ab123cd1348764379425765984276598428976459gh3z123235p
ab123cd1348764379425765984276598428976458gh3z123235q
40
EOF
    ;

my $file5 =<<'EOF';
1
1
a
B
c
EOF
    ;

my $file6 =<<'EOF';
c
B
1
a
1
EOF
    ;

my $file7 =<<'EOF';
a4502
a45001
EOF
    ;

my $file8 =<<'EOF';
a45001
a4502
EOF
    ;

sub GolfScore {
   my $script = shift;
   local ($_, *FF);
   open(FF, "< $script") or die "could not open $script: $!";
   my $golf = -1;	# your free last newline
   while (<FF>) {
       s/\n?$/\n/;
       $golf-- if $. == 1 && s/^#!.*perl//;
       $golf += length;
   }
   return $golf;
}

sub PrintGolfScore {
   my $tot = 0;
   my (@check, @incomplete);
   while (my $name = shift) {
       my $checker = shift;
       if (-e $name) {
           my $score = GolfScore($name);
           printf("%-12s %3d strokes\n", "$name:", $score);
           $tot += $score;
           push(@check, [$name, $checker]);
       } else {
           printf("%-12s --- missing\n", $name.":");
           push(@incomplete, $name);
       }
   }
   print "-"x(12+1+3+8), "\n";
   printf("%-12s %3d strokes\n", "total:", $tot);
   print "\n";
   for (@check) {
       my ($name, $checker) = @$_;
       $checker->($name);
   }
   die "you still have to write @incomplete.\n" if @incomplete;
   print "\nHooray, you passed. Submit your solution if you didn't already\n";
}

sub BuildFile {
   my ($fname, $data) = @_;
   local (*FF);
   open(FF, "> $fname") or die "could not open $fname: $!";
   print FF $data;
}

sub CheckError {
    return unless -s STDERR;
    local (*FILE);
    open(FILE, "< $error") || die "could not open $error: $!";
    die "output on STDERR:\n", <FILE>;
}

sub CheckOne {
    my ($prog, $file, $expect) = @_;
    my $cmd = qq("$^X" $prog $tmp);
    BuildFile($tmp, $file);
    my $out = `$cmd`;
    die "$prog dumped core.\n" if $? & 0xff;
    CheckError;
    if ($out ne $expect) {
        print "Expected:\n$expect\nGot:\n$out\n";
        die "you failed.\n";
    }
}

sub CheckOneSort {
    my ($prog, $file, $expect) = @_;
    my $cmd = qq("$^X" $prog $tmp);
    BuildFile($tmp, $file);
    my $out = join("", sort `$cmd`);
    die "$prog dumped core.\n" if $? & 0xff;
    CheckError;
    $expect = join("", sort $expect =~ /(.*\n)/g);
    if ($out ne $expect) {
        print "Expected:\n$expect\nGot:\n$out\n";
        die "you failed.\n";
    }
}

sub CheckOneSelect2 {
    my ($prog, $file, $expect) = @_;
    my $cmd = qq("$^X" $prog $tmp);
    BuildFile($tmp, $file);
    for (1..5) {
        my @out = sort `$cmd`;
        die "$prog dumped core.\n" if $? & 0xff;
        CheckError;
        my @expect = sort $expect =~ /(.*\n)/g;
        my $failed = 0;
        for my $i (@out) {
            $failed = 1 unless grep {$i eq $_ } @expect;
        }
        if ($failed || @out != 2 || $out[0] eq $out[1]) {
            print "Expected 2 from:\n$expect\nGot:\n", @out, "\n";
            die "you failed.\n";
        }
    }
}

sub CheckProgram {
    my $fun  = shift;
    my $prog = shift;
    my $str = sprintf("Checking %-12s ", $prog);
    $str =~ s/( *)$/"."x length($1)/e;
    print $str;
    for (@_) {
        CheckError;	# pick up errors in the scoring program itself
        $fun->($prog, @$_);
        CheckError;
    }
    print "(provisionally) Ok\n";
}

sub CheckHuman {
    my ($prog) = @_;
    CheckProgram(\&CheckOne, $prog, 
                 [$file1, $file1],
                 [$file2, $file1],
                 [$file3, $file3],
                 [$file4, $file3],
                 [$file5, $file5],
                 [$file6, $file5],
                 [$file7, $file7],
                 [$file8, $file7],
                 );
}

sub CheckShuffle {
    my ($prog) = @_;
    
    CheckProgram(\&CheckOneSort, $prog, 
                 [$file2, $file2],
                 [$file4, $file4],
                 [$file6, $file6],
                 [$file8, $file8],
                 );
}

sub CheckSelect2 {
    my ($prog) = @_;
    CheckProgram(\&CheckOneSelect2, $prog,
                 [$file2, $file2],
                 [$file4, $file4],
                 [$file8, $file8],
                );
}

eval {    
    open(STDERR, "> $error") || die "could not create $error: $!";
    my $fh = select(STDERR);
    $| = 1;
    select($fh);
    PrintGolfScore("human.pl"	=> \&CheckHuman,
                   "shuffle.pl"	=> \&CheckShuffle,
                   "select.pl"	=> \&CheckSelect2);
    CheckError;	# pick up errors in the scoring program itself
};
print "Oops, $@" if $@;

END {
    close STDERR;
    unlink($tmp, $error);
}