From: Robin Edwards <robin.ge@gmail.com>
Date: Thu, 10 Dec 2009 16:25:32 +0000 (+0000)
Subject: block naming now works
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=9927c9930aac6adbd7d7a5f0d9743421dbd8ad7a;p=p5sagit%2FDevel-Declare-Keyword.git

block naming now works
---

diff --git a/examples/Method2.pm b/examples/Method2.pm
index bf61989..183575f 100644
--- a/examples/Method2.pm
+++ b/examples/Method2.pm
@@ -4,7 +4,6 @@ use Keyword;
 use Data::Dumper;
 
 keyword method (ident?, proto?, block) {
-	warn "method params: ".Dumper @_;
 #	$block->begin("warn 'hello from me';");
 	$block->name($ident);
 };
diff --git a/lib/Keyword.pm b/lib/Keyword.pm
index ec0fefa..86eb77c 100644
--- a/lib/Keyword.pm
+++ b/lib/Keyword.pm
@@ -19,6 +19,7 @@ sub import {
 		$KW_MODULE,
 		{ keyword => { const => \&sig_parser } }
 	);
+
 	no strict 'refs';
 	*{$KW_MODULE.'::keyword'} = sub (&) { 
 		no strict 'refs';
@@ -31,6 +32,8 @@ sub import {
 
 #parses keyword signature
 sub sig_parser {
+
+
 	my $parser = Keyword::Parser->new;
 	$parser->next_token;
 	$parser->skip_ws;
@@ -59,11 +62,8 @@ sub sig_parser {
 	substr($l, $parser->offset+1, 0) = proto_to_code($proto);
 	$parser->line($l);
 
-	#construct shadow sub
-	my $shadow = sub (&) { no strict 'refs';  *{$KW_MODULE."::$keyword"} = shift }; 
-
 	#install shadow for keyword routine
-	$parser->shadow($keyword, $shadow);
+	$parser->shadow($keyword);
 }
 
 sub proto_to_code {
@@ -161,8 +161,9 @@ sub mk_import {
 	my ($pb, $keyword) = @_;
 
 	return sub {
-		# module_user is the user of your Keyword based module
 		my $module_user = caller();
+	
+		# module_user is the user of your Keyword based module
 		Devel::Declare->setup_for(
 			$module_user,
 			{ $keyword => { const => $pb } }
@@ -170,7 +171,12 @@ sub mk_import {
 
 		# setup prototype for there keyword into modules namespace
 		no strict 'refs';
-		*{$module_user."::$keyword"} = sub (&) {};
+		*{$module_user."::$keyword"} = sub (&) { 
+			no strict 'refs';
+			my $name =  ${$module_user."::__block_name"};
+			*{$name} = shift; #store block 
+			${$module_user."::__block_name"} = undef;
+		};
 	};
 }
 
diff --git a/lib/Keyword/Parse/Block.pm b/lib/Keyword/Parse/Block.pm
index 353c609..b4c8114 100644
--- a/lib/Keyword/Parse/Block.pm
+++ b/lib/Keyword/Parse/Block.pm
@@ -29,6 +29,7 @@ sub begin {
 
 sub name {
 	my ($self, $name) = @_;
+	no strict 'refs';
 	$self->{parser}->shadow($name);
 }
 
diff --git a/lib/Keyword/Parser.pm b/lib/Keyword/Parser.pm
index 5796c1e..6d5cdbb 100644
--- a/lib/Keyword/Parser.pm
+++ b/lib/Keyword/Parser.pm
@@ -67,19 +67,20 @@ sub line_offset {
 sub shadow {
 	my ($self, $name) = @_;
 	$name = $self->package()."::$name" if $name;
-
 	my $sub;
 
+	#set name as global for import;
+	no strict 'refs'; 
+	${$self->package."::__block_name"} = $name;
+	
 	if($name) {
-
-			warn "$name: ".Dumper @_;
 		$sub = sub (&) {
 			no strict 'refs'; 
 			*{$name} = shift;
 		};
 	}
 	else {
-		$sub = sub (&) { shift; };
+		$sub = sub (&) { ${$self->package."::__tmp_block"}; };
 	}
 
 	Devel::Declare::shadow_sub("$name", $sub);