blockless support and test with SQL

diff --git a/examples/SQL.pm b/examples/SQL.pm
new file mode 100644 (file)
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 (file)
--- 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 (file)
--- 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 (file)
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;