From: Robin Edwards <robin.ge@gmail.com>
Date: Fri, 18 Dec 2009 18:25:04 +0000 (+0000)
Subject: blockless support and test with SQL
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=4bc243cde65e0c0e89bf30d13136e971e3db631a;p=p5sagit%2FDevel-Declare-Keyword.git

blockless support and test with SQL
---

diff --git a/examples/SQL.pm b/examples/SQL.pm
new file mode 100644
index 0000000..bc772cc
--- /dev/null
+++ b/examples/SQL.pm
@@ -0,0 +1,29 @@
+package SQL;
+use lib 'lib/';
+use Keyword qw/debug/;
+use DBI;
+use Carp;
+use Data::Dumper;
+
+our $DBH;
+
+keyword SELECT (sql) {
+	confess "no database connection set" unless $DBH;
+	return $DBH->selectrow_hashref($sql);
+}
+
+parse sql($kd) {
+	my $sql = $kd->strip_to_char(';');
+	$kd->terminate;
+	return $sql;
+}
+
+action sql ($sql) { 
+	return "SELECT $sql"; 
+}
+
+sub CONNECT {
+	$DBH = DBI->connect(@_);
+};
+
+1;
diff --git a/lib/Keyword.pm b/lib/Keyword.pm
index c117a79..b8df1ee 100644
--- a/lib/Keyword.pm
+++ b/lib/Keyword.pm
@@ -56,7 +56,7 @@ sub keyword_parser {
 
 	my $b = 1 if $proto =~ /block/i;
 	my $parser = Keyword::Parser->new({proto=>$proto, 
-			module=>$KW_MODULE, noblock=>$b, keyword=>$keyword});
+			module=>$KW_MODULE, block=>$b, keyword=>$keyword});
 
 	no strict 'refs';
 	*{$KW_MODULE."::import"} = mk_import($parser->build, $keyword, $b);
@@ -174,8 +174,10 @@ sub mk_import {
 			};
 		}
 		else {
+			no strict 'refs';
 			*{$module_user."::$keyword"} = sub { 
-				$Keyword::__keyword_block_ret; }; 
+				&$Keyword::__keyword_block(@Keyword::__keyword_block_arg); 
+			};
 		}
 	};
 }
diff --git a/lib/Keyword/Parser.pm b/lib/Keyword/Parser.pm
index 668175e..d2cb840 100644
--- a/lib/Keyword/Parser.pm
+++ b/lib/Keyword/Parser.pm
@@ -33,8 +33,14 @@ sub build {
 		for my $pa (@{$self->{plist}}) {
 			push @arg, $self->exec($pa);	
 		}
-		
-		&{$Keyword::__keyword_block}(@arg);
+
+		# if it has a block execute keyword block at compile
+		if($self->{block}) { 
+			&{$Keyword::__keyword_block}(@arg);
+		}
+		else { # no block execute at runtime, save arg
+			@Keyword::__keyword_block_arg = @arg;
+		}
 	};
 }
 
diff --git a/t/04-sql.t b/t/04-sql.t
new file mode 100644
index 0000000..371b5b0
--- /dev/null
+++ b/t/04-sql.t
@@ -0,0 +1,17 @@
+use Test::More qw/no_plan/;
+use strict;
+use warnings;
+use lib 'examples/';
+use SQL;
+use Data::Dumper;
+
+ok 1;
+
+SQL::CONNECT("dbi:Pg:dbname=humus;host=localhost;port=5432");
+
+my $r = SELECT * FROM TRACK;
+
+diag Dumper $r;
+#ok ($r);
+
+ok 1;