add action keyword

diff --git a/lib/Keyword.pm b/lib/Keyword.pm
index 7fbb907..0d1edc1 100644 (file)
--- a/lib/Keyword.pm
+++ b/lib/Keyword.pm
@@ -18,16 +18,17 @@ sub import {
        Devel::Declare->setup_for(
                $KW_MODULE,
                {       keyword => { const => \&keyword_parser },
-                       parse => { const => \&parse_parser }
+                       parse => { const => \&parse_parser },
+                       action => { const => \&action_parser }
                }
        );
 
        no strict 'refs';
        *{$KW_MODULE.'::keyword'} = sub (&) { 
-               no strict 'refs';
                $Keyword::__keyword_block = shift; 
        };
        *{$KW_MODULE.'::parse'} = sub (&) { };
+       *{$KW_MODULE.'::action'} = sub (&) { };
 
        strict->import;
        warnings->import;
@@ -96,6 +97,34 @@ sub parse_parser {
        };
 }
 
+# parses the action keyword
+sub action_parser {
+       my $parser = Keyword::Parser->new;
+       $parser->next_token;
+       $parser->skip_ws;
+
+       #strip out the name of action
+       my $name = Keyword::Parse::Ident::match($parser) or
+       die "expecting identifier for action near:\n".$parser->line;
+
+       $parser->skip_ws;
+       my $proto = Keyword::Parse::Proto::match($parser)       or
+       die "expecting prototype for action at:\n".$parser->line;
+
+       $parser->skip_ws;
+       my $l = $parser->line;
+       my $code =  "BEGIN { Keyword::eos()}; my ($proto) = \@_;";
+
+       substr($l, $parser->offset+1, 0) = $code;
+       $parser->line($l);
+
+       no strict 'refs';
+       no warnings 'redefine';
+       *{$KW_MODULE.'::action'} = sub (&) { 
+               *{$parser->package."::action_$name"} =  shift; 
+       };
+}
+
 sub eos {
        on_scope_end {
                my $parser = new Keyword::Parser;

diff --git a/t/02-syntax.t b/t/02-syntax.t
index b96e218..f9b7c33 100644 (file)
--- a/t/02-syntax.t
+++ b/t/02-syntax.t
@@ -12,6 +12,11 @@ parse thing ($parser) {
        ok 1 if !defined $parser;
 }
 
+action thing ($match) {
+       ok 1;
+       ok 1 if !defined $match;
+}
+
 parse_thing();
 
 ok 1;