#!/usr/bin/perl -w

use strict;  # A little anal retention :-)
use Getopt::Long;


# Change this if your script is at another location.
# Remember that your script when tested by the referees
# will be named secret.pl
my $script = "secret.pl";


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

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

print "You shot a round of ", get_golf_score($script), ".\n";

# Make tests.
my @tests = ([ 100, "100\n10\n1\n" ],
	     [ 101, "101\n11\n2\n" ],
	     [ 102, "102\n12\n3\n" ],
	     [ 103, "103\n13\n4\n" ],
	     [ 104, "104\n14\n5\n" ],
	     [ 105, "105\n15\n6\n" ],
	     [ 106, "106\n16\n7\n" ],
	     [ 107, "107\n17\n8\n" ],
	     [ 108, "108\n18\n9\n" ],
	     [ 109, "109\n19\n1\n" ],
	     [ 110, "110\n21\n3\n" ],
	     [ 111, "111\n22\n4\n" ],
	     [ 112, "112\n23\n5\n" ],
	     [ 113, "113\n24\n6\n" ],
	     [ 114, "114\n25\n7\n" ],
	     [ 115, "115\n26\n8\n" ],
	     [ 116, "116\n27\n9\n" ],
	     [ 117, "117\n28\n1\n" ],
	     [ 118, "118\n29\n2\n" ],
	     [ 119, "119\n21\n3\n" ],
	     [ 120, "120\n32\n5\n" ],
	     [ 121, "121\n33\n6\n" ],
	     [ 122, "122\n34\n7\n" ],
	     [ 123, "123\n35\n8\n" ],
	     [ 124, "124\n36\n9\n" ],
	     [ 125, "125\n37\n1\n" ],
	     [ 126, "126\n38\n2\n" ],
	     [ 127, "127\n39\n3\n" ],
	     [ 128, "128\n31\n4\n" ],
	     [ 129, "129\n32\n5\n" ],
	     [ 130, "130\n43\n7\n" ],
	     [ 131, "131\n44\n8\n" ],
	     [ 132, "132\n45\n9\n" ],
	     [ 133, "133\n46\n1\n" ],
	     [ 134, "134\n47\n2\n" ],
	     [ 135, "135\n48\n3\n" ],
	     [ 136, "136\n49\n4\n" ],
	     [ 137, "137\n41\n5\n" ],
	     [ 138, "138\n42\n6\n" ],
	     [ 139, "139\n43\n7\n" ],
	     [ 140, "140\n54\n9\n" ],
	     [ 141, "141\n55\n1\n" ],
	     [ 142, "142\n56\n2\n" ],
	     [ 143, "143\n57\n3\n" ],
	     [ 144, "144\n58\n4\n" ],
	     [ 145, "145\n59\n5\n" ],
	     [ 146, "146\n51\n6\n" ],
	     [ 147, "147\n52\n7\n" ],
	     [ 148, "148\n53\n8\n" ],
	     [ 149, "149\n54\n9\n" ],
	     [ 150, "150\n65\n2\n" ],
	     [ 151, "151\n66\n3\n" ],
	     [ 152, "152\n67\n4\n" ],
	     [ 153, "153\n68\n5\n" ],
	     [ 154, "154\n69\n6\n" ],
	     [ 155, "155\n61\n7\n" ],
	     [ 156, "156\n62\n8\n" ],
	     [ 157, "157\n63\n9\n" ],
	     [ 158, "158\n64\n1\n" ],
	     [ 159, "159\n65\n2\n" ],
	     [ 160, "160\n76\n4\n" ],
	     [ 161, "161\n77\n5\n" ],
	     [ 162, "162\n78\n6\n" ],
	     [ 163, "163\n79\n7\n" ],
	     [ 164, "164\n71\n8\n" ],
	     [ 165, "165\n72\n9\n" ],
	     [ 166, "166\n73\n1\n" ],
	     [ 167, "167\n74\n2\n" ],
	     [ 168, "168\n75\n3\n" ],
	     [ 169, "169\n76\n4\n" ],
	     [ 170, "170\n87\n6\n" ],
	     [ 171, "171\n88\n7\n" ],
	     [ 172, "172\n89\n8\n" ],
	     [ 173, "173\n81\n9\n" ],
	     [ 174, "174\n82\n1\n" ],
	     [ 175, "175\n83\n2\n" ],
	     [ 176, "176\n84\n3\n" ],
	     [ 177, "177\n85\n4\n" ],
	     [ 178, "178\n86\n5\n" ],
	     [ 179, "179\n87\n6\n" ],
	     [ 180, "180\n98\n8\n" ],
	     [ 181, "181\n99\n9\n" ],
	     [ 182, "182\n91\n1\n" ],
	     [ 183, "183\n92\n2\n" ],
	     [ 184, "184\n93\n3\n" ],
	     [ 185, "185\n94\n4\n" ],
	     [ 186, "186\n95\n5\n" ],
	     [ 187, "187\n96\n6\n" ],
	     [ 188, "188\n97\n7\n" ],
	     [ 189, "189\n98\n8\n" ],
	     [ 190, "190\n19\n1\n" ],
	     [ 191, "191\n11\n2\n" ],
	     [ 192, "192\n12\n3\n" ],
	     [ 193, "193\n13\n4\n" ],
	     [ 194, "194\n14\n5\n" ],
	     [ 195, "195\n15\n6\n" ],
	     [ 196, "196\n16\n7\n" ],
	     [ 197, "197\n17\n8\n" ],
	     [ 198, "198\n18\n9\n" ],
	     [ 199, "199\n19\n1\n" ],
	     [ 1000, "1000\n100\n10\n1\n" ],
	     [ 1010, "1010\n111\n22\n4\n" ],
	     [ 9090, "9090\n999\n99\n9\n" ],
	     [ 7777, "7777\n555\n11\n2\n" ],
	     [ 8169, "8169\n976\n74\n2\n" ],
	     [ 4294967296, "4294967296\n624464926\n86811428\n5592561\n".
	       "152727\n67999\n4799\n279\n97\n7\n" ] );
		  
foreach my $nb ( reverse 0..9 ) {
    unshift @tests, [ $nb, "$nb\n" ];
}


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

foreach my $test ( @tests ) {
    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;
	warn "STDERR output:\n";
	warn  "--\n".$err."--\n";
	die "Failed.\n";
    }

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

# All test successful.
print "Hooray, you passed.\n";
print "You shot a round of ", get_golf_score($script), ".\n";
unlink $ERR;
print "You can submit your solution at: http://perlgolf.sourceforge.net/cgi-bin/PGAS/leader.cgi?course=1\n";
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/\n$//;            # Free last newline.
    $code =~ s/^#!\S*perl//;     # Shebang.
    my $score = length($code)-1; # Free first newline.
    $code =~ s/[\w\s]//g;
    
    return "$score strokes (matched ".length($code)." [^\\w\\s])";
}

__END__