| Subject: | Fix marshalling of arrays containing ', ", and/or \ |
Versions 2.14.0 and 2.15.0 included some fixes for arrays and ->quote,
but there
a few more holes to plug. Try:
use DBI;
$dbh = DBI->connect(undef, undef, undef, {RaiseError => 1, PrintError =>
0, AutoCommit => 1});
for ('a\\b', 'a\'b') {
print "$_ => ", ($dbh->selectrow_array('SELECT ?::text[]', {},
[$_]))[0]->[0], "\n";
print "$_ => ", ($dbh->selectrow_array('SELECT ' .
$dbh->quote([$_]). '::text[]'))[0]->[0], "\n";
}
pg_stringify_array is doing some of the jobs of quote_string (prepend/append
single-quotes, double backslashes) but missing others (double single-quotes,
possibly add the escape string prefix). The attached patch changes
`quote' to
pass the product of pg_stringify_array through the standard quoting
mechanism,
and it changes pg_stringify_array to only format the string for the needs of
anyarray_in, removing it from the quoted string business.
The relevant test group, 09arrays.t, checks an expected value for the
server's
raw array output by storing and retrieving the array under
pg_expand_array=0.
It checks an expected output of $dbh->quote directly and by converting
it to a
Perl array for comparison to a value retrieved under pg_expand_array=1. The
tests passed because those expectations were incorrect. This patch
keeps the
first test (with corrected expectations) and discards the second. In
its place,
I attempt a dynamic INSERT based on $dbh->quote output, and I directly
compare
the Perl array provided to $sth->execute or $dbh->quote to the retrieved
value.
For some reason, the code in that area was checking each expected error
message
twice; I changed it to check only once, but perhaps I missed something in so
doing. Since this change removes escape_string_warning damage from the
array
tests, I also remove the code disabling that. Applying just the 09arrays.t
changes will illustrate the failure points in the current implementation.
Unfortunately, this is another compatibility break. However, I inasmuch
as it
breaks compatibility, it brings $sth->bind_param and $dbh->quote closer
to their
contracts for the affected data.
Thanks,
nm
| Subject: | dbdpg-array-backslash.patch |
Index: dbdimp.c
===================================================================
--- dbdimp.c (revision 14181)
+++ dbdimp.c (working copy)
@@ -2259,7 +2259,7 @@
}
else if (SvTYPE(SvRV(newvalue)) == SVt_PVAV) {
SV * quotedval;
- quotedval = pg_stringify_array(newvalue,",",imp_dbh->pg_server_version, 0);
+ quotedval = pg_stringify_array(newvalue,",",imp_dbh->pg_server_version);
currph->valuelen = sv_len(quotedval);
Renew(currph->value, currph->valuelen+1, char); /* freed in dbd_st_destroy */
currph->value = SvUTF8(quotedval) ? SvPVutf8_nolen(quotedval) : SvPV_nolen(quotedval);
@@ -2393,7 +2393,7 @@
/* ================================================================== */
-SV * pg_stringify_array(SV *input, const char * array_delim, int server_version, int extraquotes) {
+SV * pg_stringify_array(SV *input, const char * array_delim, int server_version) {
dTHX;
AV * toparr;
@@ -2412,14 +2412,12 @@
if (TSTART) TRC(DBILOGFP, "%sBegin pg_stringify_array\n", THEADER);
toparr = (AV *) SvRV(input);
- value = extraquotes ? newSVpv("'{", 2) : newSVpv("{", 1);
+ value = newSVpv("{", 1);
/* Empty arrays are easy */
if (av_len(toparr) < 0) {
av_clear(toparr);
sv_catpv(value, "}");
- if (extraquotes)
- sv_catpv(value, "'");
if (TEND) TRC(DBILOGFP, "%sEnd pg_stringify_array (empty)\n", THEADER);
return value;
}
@@ -2489,14 +2487,9 @@
SvUTF8_on(value);
string = SvPV(svitem, svlen);
while (svlen--) {
-
- /* If an embedded quote, throw a backslash before it */
- if ('\"' == *string)
+ /* Escape backslashes and double-quotes. */
+ if ('\"' == *string || '\\' == *string)
sv_catpvn(value, "\\", 1);
- /* If a backslash, double it up */
- if ('\\' == *string) {
- sv_catpvn(value, "\\\\\\", 3);
- }
sv_catpvn(value, string, 1);
string++;
}
@@ -2521,8 +2514,6 @@
for (xy=0; xy<array_depth; xy++) {
sv_catpv(value, "}");
}
- if (extraquotes)
- sv_catpv(value, "'");
if (TEND) TRC(DBILOGFP, "%sEnd pg_stringify_array (string: %s)\n", THEADER, neatsvpv(value,0));
return value;
Index: dbdimp.h
===================================================================
--- dbdimp.h (revision 14181)
+++ dbdimp.h (working copy)
@@ -187,7 +187,7 @@
SV * pg_db_pg_notifies (SV *dbh, imp_dbh_t *imp_dbh);
-SV * pg_stringify_array(SV * input, const char * array_delim, int server_version, int extraquotes);
+SV * pg_stringify_array(SV * input, const char * array_delim, int server_version);
int pg_quickexec (SV *dbh, const char *sql, const int asyncflag);
Index: Pg.xs
===================================================================
--- Pg.xs (revision 14181)
+++ Pg.xs (working copy)
@@ -198,15 +198,18 @@
SvGETMAGIC(to_quote_sv);
+ /* Reject references other than overloaded objects (presumed
+ stringifiable) and arrays (will make a PostgreSQL array). */
+ if (SvROK(to_quote_sv) && !SvAMAGIC(to_quote_sv)) {
+ if (SvTYPE(SvRV(to_quote_sv)) != SVt_PVAV)
+ croak("Cannot quote a reference");
+ to_quote_sv = pg_stringify_array(to_quote_sv, ",", imp_dbh->pg_server_version);
+ }
+
/* Null is always returned as "NULL", so we can ignore any type given */
if (!SvOK(to_quote_sv)) {
RETVAL = newSVpvn("NULL", 4);
}
- else if (SvROK(to_quote_sv) && !SvAMAGIC(to_quote_sv)) {
- if (SvTYPE(SvRV(to_quote_sv)) != SVt_PVAV)
- croak("Cannot quote a reference");
- RETVAL = pg_stringify_array(to_quote_sv, ",", imp_dbh->pg_server_version, 1);
- }
else {
sql_type_info_t *type_info;
char *quoted;
Index: t/09arrays.t
===================================================================
--- t/09arrays.t (revision 14181)
+++ t/09arrays.t (working copy)
@@ -18,7 +18,7 @@
if (! defined $dbh) {
plan skip_all => 'Connection to database failed, cannot continue testing';
}
-plan tests => 257;
+plan tests => 200;
isnt ($dbh, undef, 'Connect to database for array testing');
@@ -26,10 +26,6 @@
my $pgversion = $dbh->{pg_server_version};
-if ($pgversion >= 80100) {
- $dbh->do('SET escape_string_warning = false');
-}
-
my $SQL = q{DELETE FROM dbd_pg_test WHERE pname = 'Array Testing'};
my $cleararray = $dbh->prepare($SQL);
@@ -62,8 +58,8 @@
is ($@, q{}, $t);
$dbh->rollback();
-## Input
-## Expected
+## Input (eval-able Perl)
+## Expected (ERROR or raw PostgreSQL output)
## Name of test
my $array_tests =
@@ -120,51 +116,51 @@
Unbalanced array
[123]
-{123} quote: {"123"}
+{123}
Simple 1-D numeric array
['abc']
-{abc} quote: {"abc"}
+{abc}
Simple 1-D text array
['a','b,c']
-{a,"b,c"} quote: {"a","b,c"}
+{a,"b,c"}
Text array with commas and quotes
['a','b,}']
-{a,"b,}"} quote: {"a","b,}"}
+{a,"b,}"}
Text array with commas, escaped closing brace
['a','b,]']
-{a,"b,]"} quote: {"a","b,]"}
+{a,"b,]"}
Text array with commas, escaped closing bracket
[1,2]
-{1,2} quote: {"1","2"}
+{1,2}
Simple 1-D numeric array
[[1]]
-{{1}} quote: {{"1"}}
+{{1}}
Simple 2-D numeric array
[[1,2]]
-{{1,2}} quote: {{"1","2"}}
+{{1,2}}
Simple 2-D numeric array
[[[1]]]
-{{{1}}} quote: {{{"1"}}}
+{{{1}}}
Simple 3-D numeric array
[[["alpha",2],[23,"pop"]]]
-{{{alpha,2},{23,pop}}} quote: {{{"alpha","2"},{"23","pop"}}}
+{{{alpha,2},{23,pop}}}
3-D mixed array
[[[1,2,3],[4,5,"6"],["seven","8","9"]]]
-{{{1,2,3},{4,5,6},{seven,8,9}}} quote: {{{"1","2","3"},{"4","5","6"},{"seven","8","9"}}}
+{{{1,2,3},{4,5,6},{seven,8,9}}}
3-D mixed array
[q{O'RLY?}]
-{O'RLY?} quote: {"O'RLY?"}
+{O'RLY?}
Simple single quote
[q{O"RLY?}]
@@ -172,19 +168,19 @@
Simple double quote
[[q{O"RLY?}],[q|'Ya' - "really"|],[123]]
-{{"O\"RLY?"},{"'Ya' - \"really\""},{123}} quote: {{"O\"RLY?"},{"'Ya' - \"really\""},{"123"}}
+{{"O\"RLY?"},{"'Ya' - \"really\""},{123}}
Many quotes
["Single\\\\Backslash"]
-{"Single\\\\\\\\Backslash"} quote: {"Single\\\\\\\\Backslash"}
+{"Single\\\\Backslash"}
Single backslash testing
["Double\\\\\\\\Backslash"]
-{"Double\\\\\\\\\\\\\\\\Backslash"} quote: {"Double\\\\\\\\\\\\\\\\Backslash"}
+{"Double\\\\\\\\Backslash"}
Double backslash testing
[["Test\\\nRun","Quite \"so\""],["back\\\\\\\\slashes are a \"pa\\\\in\"",123] ]
-{{"Test\\\\\\\\nRun","Quite \"so\""},{"back\\\\\\\\\\\\\\\\slashes are a \"pa\\\\\\\\in\"",123}} quote: {{"Test\\\\\\\nRun","Quite \"so\""},{"back\\\\\\\\\\\\\\\\slashes are a \"pa\\\\\\\\in\"","123"}}
+{{"Test\\\nRun","Quite \"so\""},{"back\\\\\\\\slashes are a \"pa\\\\in\"",123}}
Escape party - backslash+newline, two + one
[undef]
@@ -196,25 +192,25 @@
NEED 80200: Simple undef test
[[1,2],[undef,3],["four",undef],[undef,undef]]
-{{1,2},{NULL,3},{four,NULL},{NULL,NULL}} quote: {{"1","2"},{NULL,"3"},{"four",NULL},{NULL,NULL}}
+{{1,2},{NULL,3},{four,NULL},{NULL,NULL}}
NEED 80200: Multiple undef test
!;
## Note: We silently allow things like this: [[[]],[]]
-$dbh->{pg_expand_array} = 0;
+sub safe_getarray {
+ my $ret = eval {
+ $getarray->execute();
+ $getarray->fetchall_arrayref()->[0][0];
+ };
+ $@ || $ret
+}
for my $test (split /\n\n/ => $array_tests) {
next unless $test =~ /\w/;
my ($input,$expected,$msg) = split /\n/ => $test;
- my $qexpected = $expected;
- if ($expected =~ s/\s*quote:\s*(.+)//) {
- $qexpected = $1;
- }
- if ($qexpected !~ /^ERROR/) {
- $qexpected = qq{'$qexpected'};
- }
+ my $perl_input = eval $input;
if ($msg =~ s/NEED (\d+):\s*//) {
my $ver = $1;
@@ -226,88 +222,47 @@
}
}
- $t="Correct array inserted: $msg : $input";
- $cleararray->execute();
+ # INSERT via bind values
+ $dbh->rollback;
eval {
- $addarray->execute(eval $input);
+ $addarray->execute($perl_input);
};
if ($expected =~ /error:\s+(.+)/i) {
- like ($@, qr{$1}, "Array failed : $msg : $input");
- like ($@, qr{$1}, "Array failed : $msg : $input");
+ like ($@, qr{$1}, "[bind] Array insert error : $msg : $input");
}
else {
- is ($@, q{}, "Array worked : $msg : $input");
- $getarray->execute();
- $result = $getarray->fetchall_arrayref()->[0][0];
- is ($result, $expected, $t);
+ is ($@, q{}, "[bind] Array insert success : $msg : $input");
+
+ $t="[bind][!expand] Correct array inserted: $msg : $input";
+ $dbh->{pg_expand_array} = 0;
+ is (safe_getarray, $expected, $t);
+
+ $t="[bind][expand] Correct array inserted: $msg : $input";
+ $dbh->{pg_expand_array} = 1;
+ is_deeply (safe_getarray, $perl_input, $t);
}
- $t="Array quote worked : $msg : $input";
+ # INSERT via `quote' and dynamic SQL
+ $dbh->rollback;
eval {
- $result = $dbh->quote(eval $input );
+ $quotearr = $dbh->quote($perl_input);
+ $SQL = qq{INSERT INTO dbd_pg_test(id,pname,testarray) VALUES (99,'Array Testing',$quotearr)};
+ $dbh->do($SQL);
};
- if ($qexpected =~ /error:\s+(.+)/i) {
+ if ($expected =~ /error:\s+(.+)/i) {
my $errmsg = $1;
$errmsg =~ s/bind/quote/;
- like ($@, qr{$errmsg}, "Array quote failed : $msg : $input");
- like ($@, qr{$errmsg}, "Array quote failed : $msg : $input");
+ like ($@, qr{$errmsg}, "[quote] Array insert error : $msg : $input");
}
else {
- is ($@, q{}, $t);
+ is ($@, q{}, "[quote] Array insert success : $msg : $input");
- $t="Correct array quote: $msg : $input";
- is ($result, $qexpected, $t);
- }
+ # No need to recheck !expand case.
-}
-
-
-## Same thing, but expand the arrays
-$dbh->{pg_expand_array} = 1;
-
-for my $test (split /\n\n/ => $array_tests) {
- next unless $test =~ /\w/;
- my ($input,$expected,$msg) = split /\n/ => $test;
- my $qexpected = $expected;
- if ($expected =~ s/\s*quote:\s*(.+)//) {
- $qexpected = $1;
+ $t="[quote][expand] Correct array inserted: $msg : $input";
+ is_deeply (safe_getarray, $perl_input, $t);
}
- if ($msg =~ s/NEED (\d+):\s*//) {
- my $ver = $1;
- if ($pgversion < $ver) {
- SKIP: {
- skip ('Cannot test NULL arrays unless version 8.2 or better', 2);
- }
- next;
- }
- }
-
- $t="Array worked : $msg : $input";
- $cleararray->execute();
- eval {
- $addarray->execute(eval $input);
- };
- if ($expected =~ /error:\s+(.+)/i) {
- like ($@, qr{$1}, "Array failed : $msg : $input");
- like ($@, qr{$1}, "Array failed : $msg : $input");
- }
- else {
- is ($@, q{}, $t);
-
- $t="Correct array inserted: $msg : $input";
- $getarray->execute();
- $result = $getarray->fetchall_arrayref()->[0][0];
- $qexpected =~ s/{}/{''}/;
- $qexpected =~ y/{}/[]/;
- $qexpected =~ s/NULL/undef/g;
- if ($msg =~ /closing brace/) {
- $qexpected =~ s/]"/}"/;
- }
- $expected = eval $qexpected;
- is_deeply ($result, $expected, $t);
- }
-
if ($msg =~ /STOP/) {
warn "Exiting for DEBUGGING. Result is:\n";
warn Dumper $result;
@@ -315,7 +270,6 @@
$dbh->disconnect;
exit;
}
-
}