Please don't laugh at my original test program, tsanta.pl, written over three years ago. I decided to leave it alone in Perl 5 for now, just making the minor adjustment of running each golf hole with pugs rather than perl and changing the names of the programs from head.pl to head.p6 and so on. Maybe I'll try rewriting this test program in Perl 6 later. Update: The p6 rewrite, tsanta.p6, was done in Pugs Baby Steps; for latest versions of tsanta.p6 and rg0now's excellent solutions below see examples/golf in the Pugs distribution. Here is the updated tsanta.pl:

# 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 = "pugs $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.p6';
my $tail = 'tail.p6';
my $rev  = 'rev.p6';
my $mid  = 'mid.p6';
my $wc   = 'wc.p6';
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";
[download]

With that ugly chore out of the way, time to set about writing Perl 6 versions of each hole.

I started with Eugene's winning Perl 5 solutions from 2001, namely:

*** Eugene van der Pijll: 89 (11 19 13 25 21) ***
--- 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",$.,<>
[download]

Now this is where I hit a bit of trouble as it dawned on me I had no idea how to write Perl 6 code. I further had no clue what parts of Perl 6 the scintillating autrijus had got around to implementing yet. Never fear, browse around the Pugs test suite a bit (while singing a song in praise of test-driven development) and grep for favourite functions, such as substr (nuts, not there), join (yep), elems (nuts again), reverse (oh dear), ...

Anyway, after a few hours of random hackery, I am the proud owner of five Pugs Perl 6 programs that pass the tsanta.pl test program. Here they are:

--- head.p6 ---------------------------------------------
my$h=open@ARGS[0];print(($h.readline())[0..9])
--- tail.p6 ---------------------------------------------
my$h=open@ARGS[0];my@l=$h.readline();
my$i;for(@l){++$i}
$i=$i-10;$i=0 if$i<0;
print@l[$i..Inf]
--- rev.p6  ---------------------------------------------
my$h=open@ARGS[0];my@l=$h.readline();
my$x;for(@l){$x=$_~$x}
print$x;
--- mid.p6  ---------------------------------------------
# Note: works for Pugs 6.0.10 but will require removal
# of -0.1 below for Pugs 6.0.11.
my$h=open@ARGS[0];my@l=$h.readline();
my$i;for(@l){++$i}
print@l[int(($i-1)/2-0.1)..int($i/2-0.1)]
--- wc.p6   ---------------------------------------------
my$h=open@ARGS[0];my@l=$h.readline();
my$i;for(@l){++$i}
say join"",(split"",int(7e10+$i))[1..Inf];
[download]

Please note that these are not examples of good Perl 6 style -- quite the reverse actually, since I have no clue what I'm doing. Perl 6 experts, therefore, are invited to write much improved versions. In writing mid.p6, I noticed that int truncates in Perl 5 yet rounds in Pugs. Bug or feature? Update: It's a fixed bug (see autrijus journal) -- I was using Pugs 6.0.10 and version 6.0.11, due out in a couple of days, will include this truncate fix, which in turn will require a minor adjustment to mid.p6 (remove the silly -0.1 I think). Oh, and the lack of printf made wc.p6 a real pest to write.

Running: perl tsanta.pl produced:

You shot a round of 398 strokes.
file1: running: 'pugs head.p6 in.tmp'...done (rc=0).
file2: running: 'pugs head.p6 in.tmp'...done (rc=0).
file3: running: 'pugs head.p6 in.tmp'...done (rc=0).
file12: running: 'pugs head.p6 in.tmp'...done (rc=0).
file1: running: 'pugs tail.p6 in.tmp'...done (rc=0).
file2: running: 'pugs tail.p6 in.tmp'...done (rc=0).
file3: running: 'pugs tail.p6 in.tmp'...done (rc=0).
file12: running: 'pugs tail.p6 in.tmp'...done (rc=0).
file21: running: 'pugs tail.p6 in.tmp'...done (rc=0).
file1: running: 'pugs rev.p6 in.tmp'...done (rc=0).
file2: running: 'pugs rev.p6 in.tmp'...done (rc=0).
file3: running: 'pugs rev.p6 in.tmp'...done (rc=0).
file21: running: 'pugs rev.p6 in.tmp'...done (rc=0).
file1: running: 'pugs mid.p6 in.tmp'...done (rc=0).
file2: running: 'pugs mid.p6 in.tmp'...done (rc=0).
file3: running: 'pugs mid.p6 in.tmp'...done (rc=0).
file4: running: 'pugs mid.p6 in.tmp'...done (rc=0).
file12: running: 'pugs mid.p6 in.tmp'...done (rc=0).
file21: running: 'pugs mid.p6 in.tmp'...done (rc=0).
file1: running: 'pugs wc.p6 in.tmp'...done (rc=0).
file2: running: 'pugs wc.p6 in.tmp'...done (rc=0).
file3: running: 'pugs wc.p6 in.tmp'...done (rc=0).
file4: running: 'pugs wc.p6 in.tmp'...done (rc=0).
file12: running: 'pugs wc.p6 in.tmp'...done (rc=0).
file21: running: 'pugs wc.p6 in.tmp'...done (rc=0).
You shot a round of 398 strokes.
Hooray, you passed.
[download]

Of course, everyone is invited to beat my pathetic score of 398 strokes and there are two ways to do this: download Pugs and write versions that pass the probing tsanta.pl test program; and (for Perl 6 gurus only) devise theoretically correct Perl 6 solutions that are not yet implemented in Pugs. Enjoy!