say "Hello World!";

##</code><code>##

pugs hello.p6

##</code><code>##

Hello World!

##</code><code>##

# 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";

##</code><code>##

*** 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",$.,<>

##</code><code>##

--- 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];

##</code><code>##

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.