Christmas 2001 saw
The Santa Claus Golf Apocalypse
(the first ever code golf tournament played with a test program that all entries must pass before being accepted)
launched to the once thriving, now dormant, "fun with perl" (fwp) mailing list.
I wrote this historic test program in 2001, tsanta.pl, six months before joining Perl monks.
# tsanta.pl. Santa Claus golf game test program.
use strict;
sub GolfScore {
my $script = shift;
open(FF, $script) or die "error: open '$script'";
my $golf = 0;
while (<FF>) {
chomp; next unless length;
s/^#!.*?perl// if $. == 1;
$golf += length;
}
close(FF);
return $golf;
}
sub PrintGolfScore {
my @scr = @_;
my $tot = 0;
for my $s (@scr) { $tot += GolfScore($s) }
print "You shot a round of $tot strokes.\n";
}
sub BuildFile {
my ($fname, $data) = @_;
open(FF, '>'.$fname) or die "error: open '$fname'";
print FF $data;
close(FF);
}
sub CheckOne {
my ($scr, $label, $data, $exp) = @_;
my $intmp = 'in.tmp';
BuildFile($intmp, $data);
my $cmd = "perl $scr $intmp";
print "$label: running: '$cmd'...";
my $out = `$cmd`; my $rc = $? >> 8;
print "done (rc=$rc).\n";
if ($out ne $exp) {
warn "Expected:\n"; print STDERR $exp;
warn "Got:\n"; print STDERR $out;
die "Oops, you failed.\n";
}
}
# -----------------------------------------------------
my $file1 = <<'GROK';
1st line
GROK
my $file2 = <<'GROK';
1st line
2nd line
GROK
my $file3 = <<'GROK';
1st line
2nd line
3rd line
GROK
my $file4 = <<'GROK';
1st line
2nd line
3rd line
4th line
GROK
my $file12 = <<'GROK';
1st line
2nd line
3rd line
4th line
5th line
6th line
7th line
8th line
9th line
10th line
11th line
12th line
GROK
my $file21 = <<'GROK';
1st line
2nd line
3rd line
4th line
5th line
6th line
7th line
8th line
9th line
10th line
11th line
12th line
GROK
# -----------------------------------------------------
sub CheckHead {
my ($scr) = @_;
my @tt = (
[ 'file1', $file1, "1st line\n" ],
[ 'file2', $file2, "1st line\n2nd line\n" ],
[ 'file3', $file3, "1st line\n2nd line\n3rd line\n" ],
[ 'file12', $file12,
"1st line\n2nd line\n3rd line\n4th line\n5th line\n".
"6th line\n7th line\n8th line\n9th line\n10th line\n" ],
);
for my $r (@tt) { CheckOne($scr, $r->[0], $r->[1], $r->[2]) }
}
sub CheckTail {
my ($scr) = @_;
my @tt = (
[ 'file1', $file1, "1st line\n" ],
[ 'file2', $file2, "1st line\n2nd line\n" ],
[ 'file3', $file3, "1st line\n2nd line\n3rd line\n" ],
[ 'file12', $file12,
"3rd line\n4th line\n5th line\n6th line\n7th line\n".
"8th line\n9th line\n10th line\n11th line\n12th line\n" ],
[ 'file21', $file21, "12th line\n\n\n\n\n\n\n\n\n\n" ],
);
for my $r (@tt) { CheckOne($scr, $r->[0], $r->[1], $r->[2]) }
}
sub CheckRev {
my ($scr) = @_;
my @tt = (
[ 'file1', $file1, "1st line\n" ],
[ 'file2', $file2, "2nd line\n1st line\n" ],
[ 'file3', $file3, "3rd line\n2nd line\n1st line\n" ],
[ 'file21', $file21,
"\n\n\n\n\n\n\n\n\n12th line\n11th line\n10th line\n".
"9th line\n8th line\n7th line\n6th line\n5th line\n".
"4th line\n3rd line\n2nd line\n1st line\n" ],
);
for my $r (@tt) { CheckOne($scr, $r->[0], $r->[1], $r->[2]) }
}
sub CheckMid {
my ($scr) = @_;
my @tt = (
[ 'file1', $file1, "1st line\n" ],
[ 'file2', $file2, "1st line\n2nd line\n" ],
[ 'file3', $file3, "2nd line\n" ],
[ 'file4', $file4, "2nd line\n3rd line\n" ],
[ 'file12', $file12, "6th line\n7th line\n" ],
[ 'file21', $file21, "11th line\n" ],
);
for my $r (@tt) { CheckOne($scr, $r->[0], $r->[1], $r->[2]) }
}
sub CheckWc {
my ($scr) = @_;
my @tt = (
[ 'file1', $file1, "0000000001\n" ],
[ 'file2', $file2, "0000000002\n" ],
[ 'file3', $file3, "0000000003\n" ],
[ 'file4', $file4, "0000000004\n" ],
[ 'file12', $file12, "0000000012\n" ],
[ 'file21', $file21, "0000000021\n" ],
);
for my $r (@tt) { CheckOne($scr, $r->[0], $r->[1], $r->[2]) }
}
# -----------------------------------------------------
my $head = 'head.pl';
my $tail = 'tail.pl';
my $rev = 'rev.pl';
my $mid = 'mid.pl';
my $wc = 'wc.pl';
select(STDERR);$|=1;select(STDOUT);$|=1; # auto-flush
-f $head or die "error: file '$head' not found.\n";
-f $tail or die "error: file '$tail' not found.\n";
-f $rev or die "error: file '$rev' not found.\n";
-f $mid or die "error: file '$mid' not found.\n";
-f $wc or die "error: file '$wc' not found.\n";
PrintGolfScore($head, $tail, $rev, $mid, $wc);
CheckHead($head);
CheckTail($tail);
CheckRev($rev);
CheckMid($mid);
CheckWc($wc);
PrintGolfScore($head, $tail, $rev, $mid, $wc);
print "Hooray, you passed.\n";
The tournament was won by a Dutch PhD student, Eugene van der Pijll.
His five brilliant solutions, shown below, still run fine from tsanta.pl with the latest perl today.
It was Eugene's code to reverse the lines in a file (rev.pl) that caused a sensation, with everyone else
in the field certain that it was obviously impossible to improve on the prosaic:
print reverse<>
... until Eugene finally revealed his astonishing solution at game end:
-p $\=$_.$\}{
which is two strokes shorter (the golf score counted only the
-p command line option, not the
#!/usr/bin/perl).
Eugene's five winning solutions are shown below.
head.pl
#!/usr/bin/perl -p
11..exit
tail.pl
print+(<>)[-10..-1]
rev.pl
#!/usr/bin/perl -p
$\=$_.$\}{
mid.pl
#!/usr/bin/perl -p0
$_=$1while/.^(.+)^/ms
wc.pl
printf"%010d\n",$.,<>
After lying dormant for eighteen years, and despite all the golfic trickery, I was delighted to see that tsanta.pl
and all five of Eugene's winning solutions, still run fine today with the latest Perl
on both Unix and Windows.
I think this little example shows how seriously P5P takes backwards compatibility.