Changeset: b0ac51c36919 for monetdb-perl
URL: https://dev.monetdb.org/hg/monetdb-perl/rev/b0ac51c36919
Added Files:
DBD/t/12bindplaceholder.t
Modified Files:
DBD/monetdb.pm
DBD/t/12bind.t
Branch: default
Log Message:
Properly handle bound parameters with question marks in them
diffs (266 lines):
diff --git a/DBD/monetdb.pm b/DBD/monetdb.pm
--- a/DBD/monetdb.pm
+++ b/DBD/monetdb.pm
@@ -118,16 +118,50 @@ sub quote {
}
-sub _count_param {
- my $statement = shift;
- my $num = 0;
+sub _split_query_params {
+ my $query = shift;
+
+ # print STDERR "QUERY «$query»\n";
- $statement =~ s{
- ' (?: \\. | [^\\']++ )*+ ' |
- " (?: \\. | [^\\"]++ )*+ '
- }{}gx;
+ my @parts;
+ my $expect_placeholder = 0;
+ while ($query =~ m {(
+ [?]
+ | (?:
+ -- [^\n]*
+ | [^?'eErR"]
+ | [eE]? ' (?: \\. | [^\\']++ )*+ '
+ | [rR] ' (?: '' | [^']++ )*+ '
+ | " (?: "" | [^"]++ )*+ "
+ | [eE]? ' (?: \\. | [^\\']++ )*+ $
+ | [rR] ' (?: '' | [^']++ )*+ $
+ | " (?: "" | [^"]++ )*+ $
+ | \w+
+ )++
+ )}gsx) {
+ # print STDERR " $expect_placeholder TOK «$1»\n";
+ if ($1 eq '?') {
+ push @parts, '' unless $expect_placeholder;
+ $expect_placeholder = 0;
+ } else {
+ die "internal error: expecting placeholder" if
$expect_placeholder;
+ push @parts, $1;
+ $expect_placeholder = 1;
+ }
+ }
- return $statement =~ tr/?/?/;
+ my $tail;
+ if ($expect_placeholder) {
+ $tail = pop @parts;
+ } else {
+ $tail = '';
+ }
+
+ # for (@parts) {
+ # print STDERR " PART «$_»\n";
+ # }
+ # print STDERR " TAIL «$tail»\n";
+ return \@parts, $tail;
}
@@ -140,12 +174,16 @@ sub prepare {
my ($outer, $sth) = DBI::_new_sth($dbh, { Statement => $statement });
- $sth->STORE('NUM_OF_PARAMS', _count_param($statement));
+ my ($parts, $tail) = _split_query_params($statement);
+
+ $sth->STORE('NUM_OF_PARAMS', scalar(@{$parts}));
$sth->{monetdb_hdl} = $hdl;
$sth->{monetdb_params} = [];
$sth->{monetdb_types} = [];
$sth->{monetdb_rows} = -1;
+ $sth->{monetdb_parts} = $parts;
+ $sth->{monetdb_tail} = $tail;
return $outer;
}
@@ -541,7 +579,6 @@ sub bind_param {
sub execute {
my($sth, @bind_values) = @_;
- my $statement = $sth->{Statement};
my $dbh = $sth->{Database};
$sth->STORE('Active', 0 ); # we don't need to call $sth->finish because
@@ -549,15 +586,30 @@ sub execute {
$sth->bind_param($_, $bind_values[$_-1]) or return for 1 .. @bind_values;
+ my $parts = $sth->{monetdb_parts};
+ my $nparts = @$parts;
+ my $tail = $sth->{monetdb_tail};
+
my $params = $sth->{monetdb_params};
- my $num_of_params = $sth->FETCH('NUM_OF_PARAMS');
- return $sth->set_err(-1, @$params ." values bound when $num_of_params
expected")
- unless @$params == $num_of_params;
+ my $nparams = @$params;
+ if ($nparams != $nparts) {
+ return $sth->set_err(-1, "$nparams value bound while $nparts
expected");
+ }
- for ( 1 .. $num_of_params ) {
- my $quoted_param = $dbh->quote($params->[$_-1],
$sth->{monetdb_types}[$_-1]);
- $statement =~ s/\?/$quoted_param/; # TODO: '?' inside quotes/comments
- }
+ my $statement;
+ if ($nparts > 0) {
+ my @stmt = ();
+ for (1 .. $nparts) {
+ my $quoted_param = $dbh->quote($params->[$_-1],
$sth->{monetdb_types}[$_-1]);
+ push @stmt, $parts->[$_ - 1], $quoted_param;
+ }
+ push @stmt, $tail;
+ $statement = join('', @stmt);
+ } else {
+ $statement = $tail;
+ }
+
+ # print STDERR "# $statement\n";
$sth->trace_msg(" -- Statement: $statement\n", 5);
my $hdl = $sth->{monetdb_hdl};
diff --git a/DBD/t/12bind.t b/DBD/t/12bind.t
--- a/DBD/t/12bind.t
+++ b/DBD/t/12bind.t
@@ -16,7 +16,7 @@ use DBD_TEST();
use Test::More;
if (defined $ENV{DBI_DSN}) {
- plan tests => 6;
+ plan tests => 7;
} else {
plan skip_all => 'Cannot test without DB info';
}
@@ -38,6 +38,8 @@ ok( tab_insert( $dbh, $data ),'Insert te
ok( tab_select( $dbh ),'Select test data');
+ok( tab_bind_question_marks( $dbh ), 'Bind data with question marks');
+
ok( DBD_TEST::tab_delete( $dbh ),'Drop test table');
ok( $dbh->disconnect,'Disconnect');
@@ -64,6 +66,43 @@ sub tab_select
return 1;
}
+sub tab_bind_question_marks
+{
+ my $dbh = shift;
+
+ my $sth = $dbh->prepare("SELECT ? AS x, ? AS y");
+ unless ( $sth ) {
+ print $DBI::errstr;
+ return 0;
+ }
+
+ # without question marks
+ $sth->execute("foo", "bar");
+ my($x, $y) = $sth->fetchrow_array;
+ if ($x ne "foo") {
+ print "# when binding foo and bar, expected foo, got '$x'";
+ return undef;
+ }
+ if ($y ne "bar") {
+ print "# when binding foo and bar, expected bar, got '$y'";
+ return undef;
+ }
+
+ # with question marks
+ $sth->execute("foo?", "bar?");
+ ($x, $y) = $sth->fetchrow_array;
+ if ($x ne "foo?") {
+ print "# when binding foo? and bar?, expected foo?, got '$x'";
+ return undef;
+ }
+ if ($y ne "bar?") {
+ print "# when binding foo? and bar?, expected bar?, got '$y'";
+ return undef;
+ }
+
+ return 1;
+}
+
sub tab_insert
{
my $dbh = shift;
diff --git a/DBD/t/12bindplaceholder.t b/DBD/t/12bindplaceholder.t
new file mode 100644
--- /dev/null
+++ b/DBD/t/12bindplaceholder.t
@@ -0,0 +1,70 @@
+#!perl -I./t
+
+# This Source Code Form is subject to the terms of the Mozilla Public
+# License, v. 2.0. If a copy of the MPL was not distributed with this
+# file, You can obtain one at http://mozilla.org/MPL/2.0/.
+#
+# Copyright 1997 - July 2008 CWI, August 2008 - 2019 MonetDB B.V.
+
+$| = 1;
+
+use strict;
+use warnings;
+use DBI();
+use DBD_TEST();
+
+use Test::More;
+
+if (defined $ENV{DBI_DSN}) {
+ plan tests => 9;
+} else {
+ plan skip_all => 'Cannot test without DB info';
+}
+
+my $dbh = DBI->connect or die "Connect failed: $DBI::errstr\n";
+ok ( defined $dbh, 'Connection');
+
+my $do_execute = 0;
+
+sub process
+{
+ my $query = shift;
+ my $sth = $dbh->prepare($query);
+
+ my $expected = $sth->{NUM_OF_PARAMS};
+ my @params = @_;
+ my $nparams = @params;
+ if ($nparams != $expected) {
+ print "# expected $expected parameters, got $nparams\n";
+ return undef;
+ }
+
+ return 1 unless $do_execute;
+
+ print("# EXECUTE $query");
+ print("# PARMS ", join('|', @params)) if @params;
+ $sth->execute(@params);
+ my @row;
+ while (@row = $sth->fetchrow_array()) {
+ print("# ROW ", join(' | ', @row), '\n');
+ }
+
+ return 1;
+}
+
+
+ok( process("SELECT 42"), 'no placeholders');
+
+ok( process("SELECT ?", 42), 'one placeholder');
+
+ok( process("-- '?\nSELECT 42"), 'not a real placeholder, is in a comment');
+
+ok( process("-- '?\nSELECT ?", 42), 'commented placeholder and real
placeholder');
+
+ok( process("SELECT 42 -- ?"), 'commented placeholder at end');
+
+ok( process("SELECT 42 --?\nWHERE TRUE"), 'commented placeholder, then more
query');
+
+ok( process("SELECT R'\\' ?", 'foo'), 'sdf');
+
+ok( process("SELECT '\\' ?'"), 'not fooled by the backslash escape');
_______________________________________________
checkin-list mailing list -- [email protected]
To unsubscribe send an email to [email protected]
