From: Robin Edwards <robin.ge@gmail.com>
Date: Fri, 11 Dec 2009 19:53:25 +0000 (+0000)
Subject: add action keyword
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=59db504a337b079cb49b88746b8d627e8c2426e9;p=p5sagit%2FDevel-Declare-Keyword.git

add action keyword
---

diff --git a/lib/Keyword.pm b/lib/Keyword.pm
index 7fbb907..0d1edc1 100644
--- 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
--- 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;