Mercurial > hg > monetdb-perl

comparison DBD/monetdb.pm @ 54:b0ac51c36919

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
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
comparison
equal deleted inserted replaced
53:a2a23aa2bf8e 54:b0ac51c36919
116 } 116 }
117 return $prefix . $value . $suffix; 117 return $prefix . $value . $suffix;
118 } 118 }
119 119
120 120
121 sub _count_param { 121 sub _split_query_params {
122 my $statement = shift; 122 my $query = shift;
123 my $num = 0; 123
124 124 # print STDERR "QUERY «$query»\n";
125 $statement =~ s{ 125
126 ' (?: \\. | [^\\']++ )*+ ' | 126 my @parts;
127 " (?: \\. | [^\\"]++ )*+ ' 127 my $expect_placeholder = 0;
128 }{}gx; 128 while ($query =~ m {(
129 129 [?]
130 return $statement =~ tr/?/?/; 130 | (?:
131 -- [^\n]*
132 | [^?'eErR"]
133 | [eE]? ' (?: \\. | [^\\']++ )*+ '
134 | [rR] ' (?: '' | [^']++ )*+ '
135 | " (?: "" | [^"]++ )*+ "
136 | [eE]? ' (?: \\. | [^\\']++ )*+ $
137 | [rR] ' (?: '' | [^']++ )*+ $
138 | " (?: "" | [^"]++ )*+ $
139 | \w+
140 )++
141 )}gsx) {
142 # print STDERR " $expect_placeholder TOK «$1»\n";
143 if ($1 eq '?') {
144 push @parts, '' unless $expect_placeholder;
145 $expect_placeholder = 0;
146 } else {
147 die "internal error: expecting placeholder" if $expect_placeholder;
148 push @parts, $1;
149 $expect_placeholder = 1;
150 }
151 }
152
153 my $tail;
154 if ($expect_placeholder) {
155 $tail = pop @parts;
156 } else {
157 $tail = '';
158 }
159
160 # for (@parts) {
161 # print STDERR " PART «$_»\n";
162 # }
163 # print STDERR " TAIL «$tail»\n";
164 return \@parts, $tail;
131 } 165 }
132 166
133 167
134 sub prepare { 168 sub prepare {
135 my ($dbh, $statement, $attr) = @_; 169 my ($dbh, $statement, $attr) = @_;
138 my $hdl = eval { $cxn->new_handle }; 172 my $hdl = eval { $cxn->new_handle };
139 return $dbh->set_err(-1, $@) if $@; 173 return $dbh->set_err(-1, $@) if $@;
140 174
141 my ($outer, $sth) = DBI::_new_sth($dbh, { Statement => $statement }); 175 my ($outer, $sth) = DBI::_new_sth($dbh, { Statement => $statement });
142 176
143 $sth->STORE('NUM_OF_PARAMS', _count_param($statement)); 177 my ($parts, $tail) = _split_query_params($statement);
178
179 $sth->STORE('NUM_OF_PARAMS', scalar(@{$parts}));
144 180
145 $sth->{monetdb_hdl} = $hdl; 181 $sth->{monetdb_hdl} = $hdl;
146 $sth->{monetdb_params} = []; 182 $sth->{monetdb_params} = [];
147 $sth->{monetdb_types} = []; 183 $sth->{monetdb_types} = [];
148 $sth->{monetdb_rows} = -1; 184 $sth->{monetdb_rows} = -1;
185 $sth->{monetdb_parts} = $parts;
186 $sth->{monetdb_tail} = $tail;
149 187
150 return $outer; 188 return $outer;
151 } 189 }
152 190
153 191
539 } 577 }
540 578
541 579
542 sub execute { 580 sub execute {
543 my($sth, @bind_values) = @_; 581 my($sth, @bind_values) = @_;
544 my $statement = $sth->{Statement};
545 my $dbh = $sth->{Database}; 582 my $dbh = $sth->{Database};
546 583
547 $sth->STORE('Active', 0 ); # we don't need to call $sth->finish because 584 $sth->STORE('Active', 0 ); # we don't need to call $sth->finish because
548 # mapi_query_handle() calls finish_handle() 585 # mapi_query_handle() calls finish_handle()
549 586
550 $sth->bind_param($_, $bind_values[$_-1]) or return for 1 .. @bind_values; 587 $sth->bind_param($_, $bind_values[$_-1]) or return for 1 .. @bind_values;
551 588
589 my $parts = $sth->{monetdb_parts};
590 my $nparts = @$parts;
591 my $tail = $sth->{monetdb_tail};
592
552 my $params = $sth->{monetdb_params}; 593 my $params = $sth->{monetdb_params};
553 my $num_of_params = $sth->FETCH('NUM_OF_PARAMS'); 594 my $nparams = @$params;
554 return $sth->set_err(-1, @$params ." values bound when $num_of_params expected") 595 if ($nparams != $nparts) {
555 unless @$params == $num_of_params; 596 return $sth->set_err(-1, "$nparams value bound while $nparts expected");
556 597 }
557 for ( 1 .. $num_of_params ) { 598
558 my $quoted_param = $dbh->quote($params->[$_-1], $sth->{monetdb_types}[$_-1]); 599 my $statement;
559 $statement =~ s/\?/$quoted_param/; # TODO: '?' inside quotes/comments 600 if ($nparts > 0) {
560 } 601 my @stmt = ();
602 for (1 .. $nparts) {
603 my $quoted_param = $dbh->quote($params->[$_-1], $sth->{monetdb_types}[$_-1]);
604 push @stmt, $parts->[$_ - 1], $quoted_param;
605 }
606 push @stmt, $tail;
607 $statement = join('', @stmt);
608 } else {
609 $statement = $tail;
610 }
611
612 # print STDERR "# $statement\n";
561 $sth->trace_msg(" -- Statement: $statement\n", 5); 613 $sth->trace_msg(" -- Statement: $statement\n", 5);
562 614
563 my $hdl = $sth->{monetdb_hdl}; 615 my $hdl = $sth->{monetdb_hdl};
564 eval{ $hdl->query($statement) }; 616 eval{ $hdl->query($statement) };
565 return $sth->set_err(-1, $@) if $@; 617 return $sth->set_err(-1, $@) if $@;