mkaptsrc: Perl's scoping for named subroutines is bobbins.

Nested named subroutines don't capture their lexical environment
properly on subsequent calls to the enclosing subroutine.  This is
obviously a bug.

diff --git a/mkaptsrc b/mkaptsrc
index b8da270..4d32d95 100755 (executable)
--- a/mkaptsrc
+++ b/mkaptsrc
@@ -164,14 +164,14 @@ sub parse ($) {
   my $ln = 0;
 
   ## Report a syntax error, citing the offending file and line.
-  sub syntax { fail "$fn:$ln: $_[0]"; }
+  my $syntax = sub { fail "$fn:$ln: $_[0]" };
 
   ## Report an error about an indented line with no stanza header.
-  sub nomode { syntax "missing stanza header" };
-  my $mode = \&nomode;
+  my $nomode = sub { $syntax->("missing stanza header") };
+  my $mode = $nomode;
 
   ## Parse an assignment LINE and store it in CSET.
-  sub assign {
+  my $assign = sub {
     my ($cset, $line) = @_;
     $line =~ m{
       ^ \s*
@@ -180,19 +180,19 @@ sub parse ($) {
       \s* = \s*
       (?P<VALUE> | \S | \S.*\S)
       \s* $
-    }x or syntax "invalid assignment";
+    }x or $syntax->("invalid assignment");
     cset_store $cset, $+{TAG}, $+{IX} // "*", $+{VALUE};
-  }
+  };
 
   ## Parse a subscription LINE and store it in @SUB.
-  sub subscribe {
+  my $subscribe = sub {
     my ($line) = @_;
     my @w = shellwords $line;
     my @dist = ();
     while (my $w = shift @w) { last if $w eq ":"; push @dist, $w; }
-    @w and @dist or syntax "empty distribution or release list";
+    @w and @dist or $syntax->("empty distribution or release list");
     push @SUB, [\@dist, \@w];
-  }
+  };
 
   for (;;) {
 
@@ -212,19 +212,19 @@ sub parse ($) {
 
     ## Split the header line into tokens and determine an action.
     my @w = shellwords $line;
-    $mode = \&nomode;
+    $mode = $nomode;
     if ($w[0] eq "distribution") {
-      @w == 2 or syntax "usage: distribution NAME";
+      @w == 2 or $syntax->("usage: distribution NAME");
       my $cset = $CSET{$w[1]} //= cset_new;
-      $mode = sub { assign $cset, @_ };
+      $mode = sub { $assign->($cset, @_) };
     } elsif ($w[0] eq "default") {
-      @w == 1 or syntax "usage: default";
-      $mode = sub { assign \%DEFAULT, @_ };
+      @w == 1 or $syntax->("usage: default");
+      $mode = sub { $assign->(\%DEFAULT, @_) };
     } elsif ($w[0] eq "subscribe") {
-      @w == 1 or syntax "usage: subscribe";
-      $mode = \&subscribe;
+      @w == 1 or $syntax->("usage: subscribe");
+      $mode = $subscribe;
     } else {
-      syntax "unknown toplevel directive `$w[0]'";
+      $syntax->("unknown toplevel directive `$w[0]'");
     }
   }