block naming now works
Robin Edwards [Thu, 10 Dec 2009 16:25:32 +0000 (16:25 +0000)]
examples/Method2.pm
lib/Keyword.pm
lib/Keyword/Parse/Block.pm
lib/Keyword/Parser.pm

index bf61989..183575f 100644 (file)
@@ -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);
 };
index ec0fefa..86eb77c 100644 (file)
@@ -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;
+               };
        };
 }
 
index 353c609..b4c8114 100644 (file)
@@ -29,6 +29,7 @@ sub begin {
 
 sub name {
        my ($self, $name) = @_;
+       no strict 'refs';
        $self->{parser}->shadow($name);
 }
 
index 5796c1e..6d5cdbb 100644 (file)
@@ -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);