Beefy Boxes and Bandwidth Generously Provided by pair Networks
Syntactic Confectionery Delight
 
PerlMonks  

Re: What does your old Perl code look like?

by eyepopslikeamosquito (Archbishop)
on Jun 18, 2019 at 11:57 UTC ( [id://11101513]=note: print w/replies, xml ) Need Help??


in reply to What does your old Perl code look like?

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.

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: note [id://11101513]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others making s'mores by the fire in the courtyard of the Monastery: (5)
As of 2024-03-29 06:42 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found