diff DBD/monetdb.pm @ 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 91ec04bb88c6
children cbac6d996b87
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};