changeset 54:b0ac51c36919

Properly handle bound parameters with question marks in them
author Joeri van Ruth <joeri.van.ruth@monetdbsolutions.com>
date Fri, 14 Oct 2022 17:24:58 +0200 (2022-10-14)
parents a2a23aa2bf8e
children 94f4232ebfcb
files DBD/monetdb.pm DBD/t/12bind.t DBD/t/12bindplaceholder.t
diffstat 3 files changed, 179 insertions(+), 18 deletions(-) [+]
line wrap: on
line diff
--- 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};
--- 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;
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');