I wanted to ask for named-placeholders in DBI, so that all DBD_*s could get them for free.
But since a half baked patch is better than a half-assed question, Ive included one.(of each. ;-)
heres the pith of the idea:
$sql = "SELECT fpath, cksum FROM filedata WHERE fsize = ?size and not inode = ?inode";
$sth = $dbh->prepare($sql);
$sth->execute({ size => 1, inode => 1000});
The above extends placeholder syntax from a single question-mark to ?(\w+) In effect, its a new new kind of SIGIL, but only for DBI.
?NAME seemed both obvious to someone who's familiar with tradtional placeholders,
and not ripe for confusion with ':1', ':2' forms of DBD-specific placeholders
(as in DBD::Oracle, IIRC).
After thrashing a bit trying to step thru DBI, DBD, perl, XS code, I got smart and simplified the experiment using PurePerl, DBD::CSV, and SQL::Statement.
Its not robust, complete, or fully thought out, but it at least has a bulls-eye
painted on it.
wrt the public API:
bind_param ( "NAME_A", $bind_val); # could work, since its currently disallowed.
execute ({%named_vals1});
is also easily differentiable by looking at each arg, ie ref $_ eq 'HASH'
(I lean against allowing blessed refs there, but theyre also currently meaningless, unless
theyre stringified - (or hash-ified - but htats a whole nuther can of worms))
execute ({%named_params1}, {%named_Vals2});
This also makes some sense, and doesnt interfere with current semantics.
Interestingly, it can reflect the logical structure of a 2 table join, and/or the later
hashrefs could contain default values for otherwize non-existent keys.
execute ( $param1, $param2, {%namedParams}, $param3);
mixing named and positional placeholders is probably too clever and not smart,
but it certainly is possible. My patch makes no attempt to detect/handle this,
I think it would be false-laziness to try to use such a feature, never mind coding it.
I am unready to say how well this might play with perl6 parameter passing, or whether such a comparison is critical (its always nice to fit in).
wrt the DBI <-> DBD interface.
I started looking here, at layers of _new_sth, _do_handle, etc.. and decided I
didnt want to dig that deeply, esp with prospect of doing so for every DBD
to determine differences and variations. I suspect that this will be the hard
part - distilling current practice out to a common implementation..
Only in SQL-Statement-1.005-mod/: Makefile
Only in SQL-Statement-1.005-mod/: blib
diff -ru SQL-Statement-1.005/lib/SQL/Parser.pm
SQL-Statement-1.005-mod/lib/SQL/Parser.pm
--- SQL-Statement-1.005/lib/SQL/Parser.pm Sat Oct 26 10:58:27 2002
+++ SQL-Statement-1.005-mod/lib/SQL/Parser.pm Fri Oct 17 22:51:42 2003
@@ -1084,13 +1084,19 @@
###################################################################
# LITERAL ::= <quoted_string> | <question mark> | <number> | NULL
+# | <question mark><\w+>
###################################################################
sub LITERAL {
my $self = shift;
my $str = shift;
return 'null' if $str =~ /^NULL$/i; # NULL
# return 'empty_string' if $str =~ /^~E~$/i; # NULL
- if ($str eq '?') {
+ if ($str =~ /^\?(\w+)$/) {
+ my $place = $self->{struct}->{num_placeholders}++;
+ $self->{struct}->{named_placeholders}{$1} = $place;
+ return 'named_placeholder';
+ }
+ elsif ($str eq '?') {
$self->{struct}->{num_placeholders}++;
return 'placeholder';
}
Only in SQL-Statement-1.005-mod/lib/SQL: Parser.pm~
diff -ru SQL-Statement-1.005/lib/SQL/Statement.pm
SQL-Statement-1.005-mod/lib/SQL/Statement.pm
--- SQL-Statement-1.005/lib/SQL/Statement.pm Sat Oct 26 10:30:38 2002
+++ SQL-Statement-1.005-mod/lib/SQL/Statement.pm Mon Oct 20 11:40:17 2003
@@ -1421,22 +1421,50 @@
}
return $rowhash->{"$val"};
};
- /placeholder/ &&do {
- my $val;
- if ($self->{"join"}) {
- $val = $self->params($arg_num);
- }
- else {
- $val = $eval->param($arg_num);
- }
-
- #my @params = $self->params;
- #die "@params";
- #print "$val ~ $arg_num\n";
+ /^placeholder/ &&
+ do {
+ my $val;
+ if ($self->{"join"}) {
+ $val = $self->params($arg_num);
+ }
+ else {
+ $val = $eval->param($arg_num);
+ }
+
+ #my @params = $self->params;
+ #die "@params";
+ #print "$val ~ $arg_num\n";
+ $arg_num++;
+ #print "<$arg_num>";
+ return $val;
+ };
+ /named_placeholder/ &&
+ do {
+ my $val;
+ if ($self->{"join"}) {
+ $val = $self->params($arg_num);
+ }
+ else {
+ if (ref $eval->{params}[0] eq 'HASH') {
+ my $pname = $structure->{value};
+ $pname =~ s/^\?//;
+ $val = $eval->{params}[0]{$pname};
+ }
+ else {
+ use Data::Dumper;
+ print Dumper $structure;
+ $DB::single = 1;
+ return $self->do_err("bad handling of named_placeholder");
+ }
+ }
+
+ #my @params = $self->params;
+ #die "@params";
+ #print "$val ~ $arg_num\n";
$arg_num++;
-#print "<$arg_num>";
+ #print "<$arg_num>";
return $val;
- };
+ };
/str_concat/ &&do {
my $valstr ='';
for (@{ $structure->{"value"} }) {
Only in SQL-Statement-1.005-mod/lib/SQL: Statement.pm~
Only in SQL-Statement-1.005-mod/: pm_to_blib
#!/usr/local/bin/perl -w
BEGIN { $ENV{DBI_PUREPERL} = 2 }
use lib 'SQL-Statement-1.005/lib';
use DBI;
use Data::Dumper;
$connstr = 'dbi:mysql:database=test;user=test';
$connstr = 'dbi:CSV:f_dir=csv';
my $dbh = DBI->connect($connstr, '', '',
{RaiseError => 0, PrintError=>1});
#DBI->trace(2);
my $sql;
if (0) {
$rc = $dbh->do
(qq{ CREATE TABLE filedata (
fsize INTEGER not null,
fdate INTEGER not null,
inode INTEGER not null,
fpath VARCHAR(250) primary key,
cksum TEXT
)
});
warn "table create failed: $rc, $@", $DBI::errstr
unless $DBI::errstr =~ /Already exists/;
}
if (0) {
$rc = $dbh->do
(qq{ insert into filedata (1, 2345, 2134, '/home/nill', 'erawasd')});
warn "table create failed: $rc, $@", $DBI::errstr
unless $DBI::errstr =~ /Already exists/;
}
$sql = "SELECT fpath, cksum FROM filedata WHERE fsize = ? and not inode = ?";
$sql = "SELECT fpath, cksum FROM filedata WHERE fsize=?size and not inode = ?inode";
my $msql = $sql; # copy sql for 2 separate modifications
# 1. capture name for use in fancy bind
$msql =~ s/\?(\w+)/push @params, $1/ge;
#$sql =~ s/\?(\w+)/?/g;
print "named placeholders: ", Dumper [EMAIL PROTECTED] if @params;
my $sth;
# wrap prepare/execute in redo loop
# execute gets the error from bad placeholders (at least for mysql
while (1) {
$sth = $dbh->prepare($sql);
eval { $sth->execute({ size => 1, inode => 1000}) };
if ($@) {
print "Execute failed: [EMAIL PROTECTED]";
$sql =~ s/\?(\w+)/?/g;
undef $@;
next;
}
print "Execute failed on $sql: [EMAIL PROTECTED]" if $@;
last;
}
while ($r = $sth->fetch()) {
print Dumper $r;
}
__END__
DB<27> L
/usr/local/lib/perl5/site_perl/5.8.1/SQL/Parser.pm:
120: my $self = shift;
break if (1)
802: my $self = shift;
break if (1)
816: my $pred = $open_parens
break if (1)
1563: return $self->do_err( $err );
break if (1)
DB<41> T
. = SQL::Eval::params(ref(SQL::Eval), ref(ARRAY)) called from file
`SQL-Statement-1.005/lib/SQL/Statement.pm' line 669
@ = SQL::Statement::SELECT(ref(DBD::CSV::Statement), ref(DBI::st), ref(ARRAY)) called
from file `SQL-Statement-1.005/lib/SQL/Statement.pm' line 165
$ = SQL::Statement::execute(ref(DBD::CSV::Statement), ref(DBI::st), ref(ARRAY)) called
from file `/usr/local/lib/perl5/site_perl/5.8.1/DBD/File.pm' line 381
$ = eval {...} called from file `/usr/local/lib/perl5/site_perl/5.8.1/DBD/File.pm'
line 381
$ = DBD::File::st::execute(ref(DBI::st), ref(HASH)) called from file
`DBI::st::execute' line 41
. = __ANON__[DBI::st::execute:86](ref(DBI::st), ref(HASH)) called from file `useit.t'
line 53
. = eval {...} called from file `useit.t' line 53
DB<41> x $array
0 ARRAY(0x8bf6dbc)
0 HASH(0x8bbce74)
'inode' => 1000
'size' => 1
DB<64> L
SQL-Statement-1.005/lib/SQL/Statement.pm:
973: my $self = shift;
break if (1)
999: my($self,$pred,$eval,$rowhash) = @_;
break if (1)
1373: my $self = shift;
break if (1)
1405: my($self,$structure,$eval,$rowhash) = @_;
break if (1)
1407: $type = $structure->{"name"} if $type and $type eq 'function';
break if ($type =~ /placeholder/)
1430: $val = $eval->param($arg_num);
break if (1)
DB<64>
