L1: added on{}run{}, $NOW

Author: Chris White

lib/XML/Axk/Base.pm

@@ -26,11 +26,11 @@ use constant {
     # When to run an action --- pre, post, or both (CIAO).
     HI => 2,
     BYE => 1,
-    CIAO => 0,
+    CIAO => 0,  # the only falsy one
 };
 
 our @EXPORT = qw(true false HI BYE CIAO);
-our @EXPORT_OK = qw(any SCRIPT_PKG_PREFIX);
+our @EXPORT_OK = qw(any SCRIPT_PKG_PREFIX now_names);
 our %EXPORT_TAGS = (
     default => [@EXPORT],
     all => [@EXPORT, @EXPORT_OK]
@@ -79,5 +79,11 @@ sub any (&@)
     return 0;
 }
 
+# Names of NOW constants, for debugging
+sub now_names {
+    my %names=(HI,"entering", BYE,"leaving", CIAO,"both");
+    return $names{+shift} || "unknown";
+} # now_names
+
 1;
 # vi: set ts=4 sts=4 sw=4 et ai fo-=ro foldmethod=marker ft=perl: #

lib/XML/Axk/Core.pm

@@ -260,7 +260,10 @@ sub _run_worklist {
     my $self = shift;
     my $now = shift;        # $now = HI, BYE, or CIAO
 
-    my %CPs = (@_);         # Core parameters
+    my %CPs = (             # Core parameters
+        NOW => $now,
+        @_
+    );
 
     # Assign the SPs from the CPs --
 
@@ -275,13 +278,13 @@ sub _run_worklist {
         my ($refPattern, $refAction, $when) = @$lrItem;
         #say "At time $now: running ", Dumper($lrItem);
 
-        next if $when && ($now != $when);
+        next if $when && ($now != $when);   # CIAO is the only falsy one
 
         next unless $refPattern->test(\%CPs);
             # Matchers use CPs so they are independent of language.
 
         eval { &$refAction };   # which context are they evaluated in?
-        croak "action: $@" if $@;
+        die "action: $@" if $@;
     } #foreach worklist item
 } #_run_worklist
 

lib/XML/Axk/L1.pm

@@ -10,7 +10,7 @@
 #   `axk_script_*` is used by only one Core instance.
 
 package XML::Axk::L1;
-use XML::Axk::Base;
+use XML::Axk::Base qw(:default now_names);
 
 use XML::Axk::Matcher::XPath;
 use XML::Axk::Matcher::Always;
@@ -23,7 +23,7 @@ require XML::Axk::Language;
 require Exporter;
 our @EXPORT = qw(
     pre_all pre_file post_file post_all perform
-    always never xpath sel);
+    always never xpath sel on run);
 our @EXPORT_OK = qw( @SP_names );
 
 # Helpers ======================================================== {{{1
@@ -69,8 +69,8 @@ sub post_all :prototype(&) {
 ## 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
-sub perform :prototype(&@) {
-    #say Dumper(\@_);
+sub add_to_worklist {
+    #say "add_to_worklist args: ", Dumper(\@_);
     my ($drAction, $refPattern, $when) = @_;
     #say "perform(): ", Dumper(\@_);
     $when = $when // HI;    # only on entry, by default
@@ -83,6 +83,28 @@ sub perform :prototype(&@) {
     push @{$sandbox->worklist}, [$refPattern, $drAction, $when];
 } #perform()
 
+# 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
+sub run :prototype(&;$) {
+    return @_;
+} #run()
+
+# pattern-first style - on {} run {} [when];
+sub on :prototype(&@) {
+    my ($drMakeMatcher, $drAction, $when) = @_;
+
+    #say "MakeMatcher: ", Dumper($drMakeMatcher);
+    my $matcher = &$drMakeMatcher;
+    #say "Matcher: ", Dumper($matcher);
+
+    @_=($drAction, $matcher, $when);
+    goto &add_to_worklist;
+} # on()
+
 # }}}1
 # Definers for matchers ========================================== {{{1
 
@@ -101,7 +123,7 @@ sub never :prototype() {
 } #never()
 
 # Make an XPath matcher
-sub xpath :prototype(@) {
+sub xpath {
     my $path = shift or croak("No expression provided!");
     $path = $$path if ref $path;
 
@@ -114,7 +136,7 @@ sub xpath :prototype(@) {
 } #xpath()
 
 # Make a selector matcher
-sub sel :prototype(@) {
+sub sel {
     my $path = shift or croak("No expression provided!");
     $path = $$path if ref $path;
 
@@ -132,7 +154,7 @@ sub sel :prototype(@) {
 # Script parameters ============================================== {{{1
 
 # Script-parameter names
-our @SP_names = qw($C @F $D $E);
+our @SP_names = qw($C @F $D $E $NOW);
 
 sub update {
     #say "L1::update: ", Dumper(\@_);
@@ -141,6 +163,8 @@ sub update {
 
     $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) { }
 } #update()