From: Robin Edwards <robin.ge@gmail.com>
Date: Fri, 18 Dec 2009 16:15:10 +0000 (+0000)
Subject: flakey blockless support
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=3bfd3b90c381e15a5b4c3f946fd8bade4fe2b15b;p=p5sagit%2FDevel-Declare-Keyword.git

flakey blockless support
---

diff --git a/README b/README
index e2aab40..36c79ec 100644
--- a/README
+++ b/README
@@ -2,6 +2,7 @@ ABOUT
 This module aims to provide an easy interface to Devel::Declare. 
 
 PLAN
+* STOP BLOCKLESS BEING EXECUTED AT COMPILE TIME
 * find usescases from: http://cpants.perl.org/dist/used_by/Devel-Declare
 * and go through perl's -existing- keywords print $fh "sddfsd". $f, $c etc
 * look at ... metalua ... and common lisp reader macros.
diff --git a/lib/Keyword.pm b/lib/Keyword.pm
index 29004f6..c117a79 100644
--- a/lib/Keyword.pm
+++ b/lib/Keyword.pm
@@ -46,16 +46,17 @@ sub keyword_parser {
 
 	#strip out the name of new keyword
 	my $keyword = parse_ident($kd) or
-	croak "expecting identifier for keyword near:\n".$kd->line;
+	confess "expecting identifier for keyword near:\n".$kd->line;
 
 	$kd->skip_ws;
 
 	#extract the prototype
 	my $proto = parse_proto($kd)	or
-	croak "expecting prototype for keyword at:\n".$kd->line;
+	confess "expecting prototype for keyword at:\n".$kd->line;
 
 	my $b = 1 if $proto =~ /block/i;
-	my $parser = Keyword::Parser->new({proto=>$proto, module=>$KW_MODULE, noblock=>$b});
+	my $parser = Keyword::Parser->new({proto=>$proto, 
+			module=>$KW_MODULE, noblock=>$b, keyword=>$keyword});
 
 	no strict 'refs';
 	*{$KW_MODULE."::import"} = mk_import($parser->build, $keyword, $b);
@@ -78,11 +79,11 @@ sub parse_parser {
 
 	#strip out the name of parse routine
 	my $name = parse_ident($kd) or
-	croak "expecting identifier for parse near:\n".$kd->line;
+	confess "expecting identifier for parse near:\n".$kd->line;
 
 	$kd->skip_ws;
 	my $proto = parse_proto($kd)	or
-	croak "expecting prototype for parse at:\n".$kd->line;
+	confess "expecting prototype for parse at:\n".$kd->line;
 
 	$kd->skip_ws;
 	my $l = $kd->line;
@@ -105,11 +106,11 @@ sub action_parser {
 
 	#strip out the name of action
 	my $name = parse_ident($kd) or
-	croak "expecting identifier for action near:\n".$kd->line;
+	confess "expecting identifier for action near:\n".$kd->line;
 
 	$kd->skip_ws;
 	my $proto = parse_proto($kd)	or
-	croak "expecting prototype for action at:\n".$kd->line;
+	confess "expecting prototype for action at:\n".$kd->line;
 
 	$kd->skip_ws;
 	my $l = $kd->line;
@@ -173,7 +174,8 @@ sub mk_import {
 			};
 		}
 		else {
-			*{$module_user."::$keyword"} = sub { };
+			*{$module_user."::$keyword"} = sub { 
+				$Keyword::__keyword_block_ret; }; 
 		}
 	};
 }
diff --git a/lib/Keyword/Declare.pm b/lib/Keyword/Declare.pm
index 7dc1593..beb206d 100644
--- a/lib/Keyword/Declare.pm
+++ b/lib/Keyword/Declare.pm
@@ -1,6 +1,7 @@
 package Keyword::Declare;
 use strict;
 use warnings;
+use Carp;
 use Devel::Declare;
 
 # maybe subclass Devel::Declare::Context::Simple?
@@ -20,14 +21,57 @@ sub offset {
 	return ${$self->{offset}};
 }
 
+sub inc_offset {
+	my ($self, $offset) = @_;
+	if($offset) {
+		${$self->{offset}} += $offset;
+	}
+	else {
+		${$self->{offset}}++;
+	}
+	return ${$self->{offset}};
+}
 sub next_token {
 	my ($self) = @_;
 	${$self->{offset}} += Devel::Declare::toke_move_past_token($self->offset);
 }
 
+sub skip_to {
+	my ($self, $name) = @_;
+	my $toke = "";
+	while ($toke ne $name) {
+		my $len = $self->scan_word(1);
+		my $l = $self->line;
+		$toke = substr($l, $self->offset, $len);
+		$self->offset($len + $self->offset);
+		$self->inc_offset;
+		confess "couldn't find '$name' on this line" if $toke and $toke =~ /\n/;
+	}
+	return $toke;
+}
+
+sub strip_to_char {
+	my ($self, $char) = @_;
+	my $str = "";
+	while ($str !~ /$char/) {
+		my $l = $self->line;
+		$str .= substr($l, $self->offset, 1);
+		substr($l, $self->offset, 1) = '';
+		$self->line($l);
+	}
+	return $str;
+}
+
+sub terminate {
+	my ($self) = shift;
+	my $l = $self->line;
+	substr($l, $self->offset, 1) = ';';
+	$self->line($l);
+}
+
 sub skip_ws {
 	my ($self) = @_;
-	${$self->{offset}} += Devel::Declare::toke_skipspace($self->offset);
+	${$self->{offset}} += 	Devel::Declare::toke_skipspace($self->offset);
 }
 
 sub scan_word {
diff --git a/lib/Keyword/Parser.pm b/lib/Keyword/Parser.pm
index b76ff69..668175e 100644
--- a/lib/Keyword/Parser.pm
+++ b/lib/Keyword/Parser.pm
@@ -3,6 +3,7 @@ use strict;
 use warnings;
 use Carp;
 use Keyword::Declare;
+use Data::Dumper;
 
 our %BUILTIN = (
 	proto => 'Keyword::Parse::Proto::parse_proto',
@@ -12,8 +13,9 @@ our %BUILTIN = (
 
 sub new {
 	my ($class, $self) = @_;
-	$self->{proto} or croak 'no proto provided';
-	$self->{module} or croak 'no module provided';
+	$self->{proto} or confess 'no proto provided';
+	$self->{module} or confess 'no module provided';
+	$self->{keyword} or confess 'no keyword provided';
 	bless($self,$class);	
 }
 
@@ -25,14 +27,13 @@ sub build {
 	
 	return sub {
 		my @arg;
-		$self->declare->next_token;
-		$self->declare->skip_ws;
+		$self->declare->skip_to($self->{keyword});
 
 		#call each parse routine and action
 		for my $pa (@{$self->{plist}}) {
 			push @arg, $self->exec($pa);	
 		}
-
+		
 		&{$Keyword::__keyword_block}(@arg);
 	};
 }
@@ -48,7 +49,7 @@ sub exec {
 	my ($self, $pa) = @_;
 	my $match = &{$pa->{parse}}($self->declare); 
 	$self->declare->skip_ws;
-	croak "failed to parse $pa->{name}" unless $match or $pa->{opt};
+	confess "failed to parse $pa->{name}" unless $match or $pa->{opt};
 	return &{$pa->{action}}($match);
 }
 
@@ -58,7 +59,7 @@ sub _build_ident_list {
 	my @i = split /\,/, $self->{proto};
 	for my $ident (@i){
 		$ident =~ /^[a-z]{1}\w+[\?]?$/i or 
-		croak "bad identifier '$ident' in prototype.";
+		confess "bad identifier '$ident' in prototype.";
 		my $opt;
 		$ident =~ s/\?//g and $opt = 1 if $ident =~ /\?$/;
 		push @{$self->{plist}}, {name=>lc($ident),optional=>$opt};