L1: added entering() leaving() whenever() and POD.

Also some cleanup.

Author: Chris White

lib/XML/Axk/Core.pm

@@ -322,19 +322,21 @@ sub run {
         #say "Processing $infn";
 
         # Clear the SPs before each file for consistency.
+        # TODO remove $C and @F from the codebase and samples.  They are
+        # leftovers from before the split of the languages into Ln modules.
         $self->{sp}->{'$C'} = undef;
         @{$self->{sp}->{'@F'}} = ();
 
         # For now, just process lines rather than XML nodes.
         if($infn eq '-') {  # stdin
-            open($fh, '<-') or croak "Can't open stdin!??!!";
+            open($fh, '<-') or croak "Can't open stdin: $!";
         } else {            # disk file
             open($fh, "<", $infn) or croak "Can't open $infn: $!";
                 # if $infn is a reference, its contents will be used -
                 # http://www.perlmonks.org/?node_id=745018
         }
 
-        $self->run_sax_fh($fh, $infn);
+        $self->run_sax_fh($fh, $infn);  # TODO permit selecting DOM mode
 
         close($fh) or warn "close failed: $!";
 
@@ -369,13 +371,6 @@ sub new {
         options => $hrOpts,
 
         # Load these in the order they are defined in the scripts.
-        #our @pre_all = ();
-        #our @pre_file = ();
-        #our @worklist = ();
-        #
-        #our @post_file = ();
-        #our @post_all = ();
-
         pre_all => [],      # List of \& to run before reading the first file
         pre_file => [],     # List of \& to run before reading each file
         worklist => [],     # List of [$refCondition, \&action, $when] to be run against each node.

lib/XML/Axk/L1.pm

@@ -21,9 +21,11 @@ use Scalar::Util qw(reftype);
 # Packages we invoke by hand
 require XML::Axk::Language;
 require Exporter;
+
+# Names the axk script will have access to
 our @EXPORT = qw(
     pre_all pre_file post_file post_all perform
-    always never xpath sel on run);
+    always never xpath sel on run entering leaving whenever);
 our @EXPORT_OK = qw( @SP_names );
 
 # Helpers ======================================================== {{{1
@@ -64,36 +66,36 @@ sub post_all :prototype(&) {
 # }}}1
 # Definers for node actions ====================================== {{{1
 
-## @function public perform (&action[, pattern[, when]])
+## @function private add_to_worklist (&action, matcher[, when])
 ## The main way to define pattern/action pairs.  This takes the action first
 ## since that's how Perl's prototypes are set up the cleanest (block first).
 ## @params required &action     A block to execute when the pattern matches
-## @params required pattern     The pattern
+## @params required matcher     An object that defines test(%CPs) to determine
+##                              whether the element described in
+##                              core-parameter hash %CPs matches.
+## @params optional when        If provided, when to run the action:
+##                              HI, BYE, or CIAO.  Default is HI.
 sub add_to_worklist {
+    my $sandbox = _sandbox or croak "Can't find sandbox";
     #say "add_to_worklist args: ", Dumper(\@_);
     my ($drAction, $refPattern, $when) = @_;
-    #say "perform(): ", Dumper(\@_);
     $when = $when // HI;    # only on entry, by default
-
     $refPattern = \( my $temp = $refPattern ) unless ref($refPattern);
 
-    # TODO? support Regexp, scalar patterns in some sensible way
-
-    my $sandbox = _sandbox or croak("Can't find sandbox in perform");
     push @{$sandbox->worklist}, [$refPattern, $drAction, $when];
-} #perform()
+} #add_to_worklist()
 
 # User-facing alias for add_to_worklist
 sub perform :prototype(&@) {
     goto &add_to_worklist;  # Need goto so that _sandbox() can use caller(1)
 }
 
-# run { action } [optional <when>] - syntactic sugar for sub {}, when
+# run { action } [optional <when>] - syntactic sugar for `sub {}, when`
 sub run :prototype(&;$) {
     return @_;
 } #run()
 
-# pattern-first style - on {} run {} [when];
+# pattern-first style - on {} run {} [when (default HI)];
 sub on :prototype(&@) {
     my ($drMakeMatcher, $drAction, $when) = @_;
 
@@ -105,6 +107,32 @@ sub on :prototype(&@) {
     goto &add_to_worklist;
 } # on()
 
+# pattern-first style, sugar for symmetry with whenever() and leaving()
+sub entering :prototype(&@) {
+    goto &on
+} #entering()
+
+# pattern-first style, common implementation for BYE and CIAO
+sub _leaving_whenever_impl {
+    croak "Too many arguments" if $#_>2;
+    my ($when, $drMakeMatcher, $drAction) = @_;
+    my $matcher = &$drMakeMatcher;
+    @_=($drAction, $matcher, $when);
+    goto &add_to_worklist;
+} #_leaving_whenever_impl()
+
+# pattern-first style, specific to leaving nodes (BYE) - leaving {} run {};
+sub leaving :prototype(&@) {
+    unshift @_, BYE;
+    goto &_leaving_whenever_impl;
+} # leaving()
+
+# pattern-first style, specific to hitting nodes (CIAO) - whenever {} run {};
+sub whenever :prototype(&@) {
+    unshift @_, CIAO;
+    goto &_leaving_whenever_impl;
+} # whenever()
+
 # }}}1
 # Definers for matchers ========================================== {{{1
 
@@ -158,14 +186,13 @@ our @SP_names = qw($C @F $D $E $NOW);
 
 sub update {
     #say "L1::update: ", Dumper(\@_);
-    my $hrSP = shift or croak("No hrSP");
-    my %opts = @_;
-
-    $hrSP->{'$D'} = $opts{document} or croak("No document");
-    $hrSP->{'$E'} = $opts{record} or croak("No record");
-    croak("You are in a timeless maze") unless defined $opts{NOW};
-    $hrSP->{'$NOW'} = now_names $opts{NOW};
-    #while (my ($key, $value) = each %new_sps) { }
+    my $hrSP = shift or croak("Invalid call - No hrSP");
+    my %CPs = @_;
+
+    $hrSP->{'$D'} = $CPs{document} or croak("No document");
+    $hrSP->{'$E'} = $CPs{record} or croak("No record");
+    croak("You are in a timeless maze") unless defined $CPs{NOW};
+    $hrSP->{'$NOW'} = now_names $CPs{NOW};
 } #update()
 
 # }}}1
@@ -174,19 +201,157 @@ sub update {
 
 sub import {
     #say "update: ",ref \&update, Dumper(\&update);
-    my $target = caller;
     #say "XAL1 run from $target:\n", Devel::StackTrace->new->as_string;
     XML::Axk::Language->import(
-        target => $target,
+        target => caller,
         sp => \@SP_names,
         updater => \&update
     );
         # By doing this here rather than in the `use` statement,
-        # we get $target and don't have to walk the stack to find the
+        # we get `caller` and don't have to walk the stack to find the
         # axk script.
     goto &Exporter::import;     # for @EXPORT &c.  @_ is what it was on entry.
 } #import()
 
 #}}}1
 1;
+# === Documentation ===================================================== {{{1
+
+=pod
+
+=encoding UTF-8
+
+=head1 NAME
+
+XML::Axk::Core::L1 - ack-like XML processor, language 1
+
+=head1 EXAMPLE
+
+    L1
+    on { xpath(q<//item>) } run {say "$NOW: " . $E->getTagName}, CIAO
+        # "CIAO" can also be "HI" or "BYE" (default HI).
+        # "entering" is a synonym for "on" with no HI/BYE/CIAO.
+    whenever { xpath(q<//item>) } run {say "$NOW: " . $E->getTagName};
+        # the same as the "on ... CIAO" line
+    leaving { xpath(q<//item>) } run {say "$NOW: " . $E->getTagName};
+
+=head1 PATTERNS AND ACTIONS
+
+=head2 C<< on {<matcher>} run {<action>} [, <when>] >>
+
+Whenever C<< <matcher> >> says that a node matches, run C<< <action> >>.
+The optional C<< <when> >> parameter says when in the course of processing to
+run C<< <action> >>:
+
+=over
+
+=item C<HI>
+
+When the node is first reached, before any of its children are processed
+
+=item C<BYE>
+
+After all of the node's children have been processed.
+
+=item C<CIAO>
+
+Both C<HI> and C<BYE>.  Suggestions for alternative terminology are welcome.
+
+=back
+
+=head2 C<entering>, C<whenever> C<leaving>
+
+    entering {<matcher>} run {<action>}
+    whenever {<matcher>} run {<action>}
+    leaving {<matcher>} run {<action>}
+
+The same as C<on {} run {}>, with C<when> set to C<HI>, C<CIAO>, or C<BYE>
+respectively.
+
+=head2 C<< perform { <action> } <matcher> [, <when>] >>
+
+If you prefer RPN, or you want to save some characters, you can put the
+C<< <matcher> >> after the C<< <action> >> using C<perform>.  For example,
+the following two lines have exactly the same effect:
+
+    on { xpath(q<//item>) } run {say "$NOW: " . $E->getTagName}, CIAO
+    perform {say "$NOW: " . $E->getTagName} xpath(q<//item>), CIAO
+
+=head1 VARIABLES
+
+When an C<< <action> >> is running, it has access to predefined variables
+that hold the state of the element being matched.  This is similar to C<$0>,
+C<$1>, ... in awk.
+
+=over
+
+=item B<$D>
+
+The current XML document
+
+=item B<$E>
+
+The XML element that was matched
+
+=item B<$NOW>
+
+The current phase, as a human-readable string: C<entering> for C<HI>,
+C<leaving> for C<BYE>, and C<BOTH> for C<CIAO>.
+
+=back
+
+=head1 MATCHERS
+
+=head2 C<< xpath('xpath expression') >>
+
+Match nodes that match the given XPath expression.  Remember that Perl will
+interpolate C<@name> in double-quotes, so single-quote or C<q{}> your XPath
+expressions.
+
+=head2 C<< sel('selector') >>
+
+Match nodes that match the given selector.
+
+=head2 C<always>, C<never>
+
+Always or never match, respectively.
+
+=head1 SPECIAL ACTIONS
+
+=head2 C<< pre_all {<block>} >>
+
+Run C<< <block> >> before any file is processed.
+
+=head2 C<< pre_file {<block>} >>
+
+Run C<< <block>($filename) >> before each file is processed.
+
+=head2 C<< post_file {<block>} >>
+
+Run C<< <block>($filename) >> after each file is processed.
+
+=head2 C<< post_all {<block>} >>
+
+Run C<< <block> >> after all files have been processed.
+
+=head1 AUTHOR
+
+Christopher White, C<cxwembedded at gmail.com>
+
+=head1 CONTACT
+
+For any bug reports, feature requests, or questions, please see the
+information in L<XML::Axk>.
+
+=head1 LICENSE AND COPYRIGHT
+
+Copyright (c) 2018 Christopher White.  All rights reserved.
+
+This program is free software; you can redistribute it and/or modify it
+under the terms of the the Artistic License (2.0). Details are in the LICENSE
+file accompanying this distribution.
+
+=cut
+
+# }}}1
 # vi: set ts=4 sts=4 sw=4 et ai fo-=ro foldmethod=marker: #

run

@@ -1,6 +1,6 @@
 #!/bin/sh
 if [[ $# -eq 0 ]]; then
-    args=(-f t/ex/xml1.axk t/ex1.xml)
+    args=(-f t/ex/xml1.axk t/ex/ex1.xml)
 else
     args=("$@")
 fi

t/ex/xml1.axk

@@ -1,6 +1,11 @@
 L1
 
-perform { say "** This shouldn't have happened" } never;
+pre_all { say "pre_all" };
+pre_file { say "pre_file" };
+post_all { say "post_all" };
+post_file { say "post_file" };
+
+perform { die "** This shouldn't have happened" } never;
 
 perform { say "hi  ", $E->getTagName if $E->can("getTagName"); } always, HI;
 perform { say "bye ", $E->getTagName if $E->can("getTagName"); } always, BYE;