Author: timbo
Date: Mon Jun 2 04:48:13 2008
New Revision: 11372
Modified:
dbi/trunk/Changes
dbi/trunk/DBI.xs
dbi/trunk/lib/DBD/Gofer.pm
dbi/trunk/lib/DBI/PurePerl.pm
dbi/trunk/t/10examp.t
Log:
Use _join_hash_sorted for ParamValues in ShowErrorStatement.
Tidy up Changes file.
Modified: dbi/trunk/Changes
==============================================================================
--- dbi/trunk/Changes (original)
+++ dbi/trunk/Changes Mon Jun 2 04:48:13 2008
@@ -19,18 +19,19 @@
Or call _new_child and move to DBI::common?
Implement FETCH_many() in C
-Gofo TODOs:
+Gofer TODOs:
Add server-side caching.
combine these:
- my $request = $transport->thaw_request( $frozen_request );
+ my $request = $transport->thaw_request( $frozen_request, $serializer );
my $response = $executor->execute_request( $request );
- my $frozen_response = $transport->freeze_response($response);
- into single method that first checks the cache
- and updates it if appropriate
+ my $frozen_response = $transport->freeze_response($response,
$serializer);
+ into single method that first checks the cache and updates it if
appropriate.
+ Different serializations will have different caches
+
+Add DBI::Gofer::Serialiser::MIME / Base64
+Add DBI::Gofer::Serialiser::JSON
-Move post-request cleanup into separate method and enable hooks so
- it can be done after the response has been sent
Gofer - allow dbh attrib changes after connect?
note them and pass in request as STORE method calls
but then gofer server need to reset them to restore dbh to original state
@@ -51,16 +52,10 @@
Call method on transport failure so transport can cleanup/reset if it wants
Gofer: gearman - need to disable coallesing for non-idempotent requests
-
Add high-res time for windows - via Time::HiRes glob replace dbi_time().
=head2 Changes in DBI 1.605 XXX
-Add note about _concat_hash_sorted once integrated
-Use _concat_hash_sorted for *_cached() and ShowErrorStatement
-Add DBI::Gofer::Serialiser::MIME / Base64
-Add DBI::Gofer::Serialiser::JSON
-
Fixed problem with DBIS macro with threads on big-endian machines
with 64bit ints but 32bit pointers. Ticket #32309.
Fixed the selectall_arrayref, selectrow_arrayref, and selectrow_array
@@ -69,16 +64,16 @@
Drivers will need to be recompiled to pick up this change.
Fixed leak in neat() for some kinds of values thanks to Rudolf Lippan.
Fixed DBI::PurePerl neat() to behave more like XS neat().
- Fixed the placeholder values reported by ShowErrorStatement
- to be shown in sorted order.
+ Clarified docs re ":N" style placeholders.
Increased timeout on tests to accomodate very slow systems.
Removed the beeps "\a" from Makefile.PL warnings.
Removed check for PlRPC-modules from Makefile.PL
- Clarified docs re ":N" style placeholders.
Changed the format of the key used for $h->{CachedKids}
(which is undocumented so you shouldn't depend on it anyway)
+ Added sorting of ParamValues reported by ShowErrorStatement
+ thanks to to Rudolf Lippan.
Added cache miss trace message to DBD::Gofer transport class.
Added $drh->dbixs_revision method.
Added explicit LICENSE specification (perl) to META.yaml
Modified: dbi/trunk/DBI.xs
==============================================================================
--- dbi/trunk/DBI.xs (original)
+++ dbi/trunk/DBI.xs Mon Jun 2 04:48:13 2008
@@ -3538,19 +3538,10 @@
mg_get(*svp); /* XXX may recurse, may croak. could use
eval */
}
if (svp && SvRV(*svp) && SvTYPE(SvRV(*svp)) == SVt_PVHV &&
HvKEYS(SvRV(*svp))>0 ) {
- HV *bvhv = (HV*)SvRV(*svp);
- SV *sv;
- char *key;
- I32 keylen;
- I32 param_idx = 0;
- hv_iterinit(bvhv);
+ SV *param_values_sv =
sv_2mortal(_join_hash_sorted((HV*)SvRV(*svp), "=",1, ", ",2, 1, -1));
sv_catpv(msg, "\" with ParamValues: ");
- while ( (sv = hv_iternextsv(bvhv, &key, &keylen)) ) {
- sv_catpvf(msg, "%s%s=%s",
- (param_idx++==0 ? "" : ", "),
- key, neatsvpv(sv,0));
- }
- sv_catpv(msg, "]");
+ sv_catsv(msg, param_values_sv);
+ sv_catpvn(msg, "]", 1);
}
else {
sv_catpv(msg, "\"]");
Modified: dbi/trunk/lib/DBD/Gofer.pm
==============================================================================
--- dbi/trunk/lib/DBD/Gofer.pm (original)
+++ dbi/trunk/lib/DBD/Gofer.pm Mon Jun 2 04:48:13 2008
@@ -578,7 +578,7 @@
# but only works properly for params 1..9
# (reverse because of the unshift)
my @params = reverse sort keys %$ParamValues;
- if (@params > 9 && $sth->{Database}{go_dsn} =~ /dbi:Sybase/) {
+ if (@params > 9 && ($sth->{Database}{go_dsn}||'') =~ /dbi:Sybase/)
{
# if more than 9 then we need to do a proper numeric sort
# also warn to alert user of this issue
warn "Sybase param binding order hack in use";
Modified: dbi/trunk/lib/DBI/PurePerl.pm
==============================================================================
--- dbi/trunk/lib/DBI/PurePerl.pm (original)
+++ dbi/trunk/lib/DBI/PurePerl.pm Mon Jun 2 04:48:13 2008
@@ -361,15 +361,15 @@
($err eq "0") ? "warning" : "failed", $errstr;
if ($h->{'ShowErrorStatement'} and my $Statement =
$h->{Statement}) {
- $msg .= ' for [``' . $Statement . "''";
+ $msg .= ' [for Statement "' . $Statement;
if (my $ParamValues = $h->FETCH('ParamValues')) {
- my $pv_idx = 0;
- $msg .= " with params: ";
- while ( my($k,$v) = each %$ParamValues ) {
- $msg .= sprintf "%s%s=%s", ($pv_idx++==0) ? "" : ",
", $k, DBI::neat($v);
- }
+ $msg .= '" with ParamValues: ';
+ $msg .= DBI::_concat_hash_sorted($ParamValues, "=", ",
", 1, undef);
+ $msg .= "]";
}
- $msg .= "]";
+ else {
+ $msg .= '"]';
+ }
}
if ($err eq "0") { # is 'warning' (not info)
carp $msg if $pw;
Modified: dbi/trunk/t/10examp.t
==============================================================================
--- dbi/trunk/t/10examp.t (original)
+++ dbi/trunk/t/10examp.t Mon Jun 2 04:48:13 2008
@@ -12,7 +12,7 @@
my $haveFileSpec = eval { require File::Spec };
require VMS::Filespec if $^O eq 'VMS';
-use Test::More tests => 208;
+use Test::More tests => 210;
# "globals"
my ($r, $dbh);
@@ -329,14 +329,21 @@
ok(! eval { $csr_c = $dbh->prepare($error_sql); 1; });
#print "[EMAIL PROTECTED]";
-ok($@ =~ m/\Q$error_sql/, $@); # ShowErrorStatement
-ok($@ =~ m/.*Unknown field names: unknown_field_name2/, $@);
+like $@, qr/\Q$error_sql/; # ShowErrorStatement
+like $@, qr/Unknown field names: unknown_field_name2/;
+# check attributes are inherited
my $se_sth1 = $dbh->prepare("select mode from ?");
ok($se_sth1->{RaiseError});
ok($se_sth1->{ShowErrorStatement});
+# check ShowErrorStatement ParamValues are included and sorted
+$se_sth1->bind_param($_, "val$_") for (1..11);
+ok( !eval { $se_sth1->execute } );
+like $@, qr/\[for Statement "select mode from \?" with ParamValues: 1='val1',
2='val2', 3='val3', 4='val4', 5='val5', 6='val6', 7='val7', 8='val8', 9='val9',
10='val10', 11='val11'\]/;
+
# check that $dbh->{Statement} tracks last _executed_ sth
+$se_sth1 = $dbh->prepare("select mode from ?");
ok($se_sth1->{Statement} eq "select mode from ?");
ok($dbh->{Statement} eq "select mode from ?") or print "got:
$dbh->{Statement}\n";
my $se_sth2 = $dbh->prepare("select name from ?");
