Author: timbo
Date: Wed Feb 28 06:36:38 2007
New Revision: 9178
Modified:
dbi/trunk/Changes
dbi/trunk/DBI.pm
dbi/trunk/DBI.xs
dbi/trunk/lib/DBD/Gofer.pm
dbi/trunk/lib/DBI/Gofer/Execute.pm
Log:
Changed DBD::Gofer to work around a DBD::Sybase bind_param bug.
Changed _set_fbav to not croak when given a wrongly sized array,
it now warns and adjusts the row buffer to match.
Added support for install_methods to DBD::Gofer.
Modified: dbi/trunk/Changes
==============================================================================
--- dbi/trunk/Changes (original)
+++ dbi/trunk/Changes Wed Feb 28 06:36:38 2007
@@ -26,6 +26,12 @@
Fixed accuracy of profiling when perl configured to use long doubles.
Fixed compile error in DBD::Gofer::Transport::http.
+ Changed DBD::Gofer to work around a DBD::Sybase bind_param bug.
+ Changed _set_fbav to not croak when given a wrongly sized array,
+ it now warns and adjusts the row buffer to match.
+
+ Added support for install_methods to DBD::Gofer.
+
=head2 Changes in DBI 1.54 (svn rev 9157), 23rd February 2007
NOTE: This release includes the 'next big thing': DBD::Gofer.
Modified: dbi/trunk/DBI.pm
==============================================================================
--- dbi/trunk/DBI.pm (original)
+++ dbi/trunk/DBI.pm Wed Feb 28 06:36:38 2007
@@ -288,6 +288,8 @@
%DBI::installed_drh = (); # maps driver names to installed driver handles
sub installed_drivers { %DBI::installed_drh }
+%DBI::installed_methods = (); # XXX undocumented, may change
+sub installed_methods { %DBI::installed_methods }
# Setup special DBI dynamic variables. See DBI::var::FETCH for details.
# These are dynamically associated with the last handle used.
@@ -1357,9 +1359,13 @@
my $prefix = $1;
my $reg_info = $dbd_prefix_registry->{$prefix};
Carp::carp("method name prefix '$prefix' is not associated with a
registered driver") unless $reg_info;
- my %attr = %{$attr||{}}; # copy so we can edit
+
+ my $full_method = "DBI::${subtype}::$method";
+ $DBI::installed_methods{$full_method} = $attr;
+
+ my (undef, $filename, $line) = caller;
# XXX reformat $attr as needed for _install_method
- my ($caller_pkg, $filename, $line) = caller;
+ my %attr = %{$attr||{}}; # copy so we can edit
DBI->_install_method("DBI::${subtype}::$method", "$filename at line
$line", \%attr);
}
Modified: dbi/trunk/DBI.xs
==============================================================================
--- dbi/trunk/DBI.xs (original)
+++ dbi/trunk/DBI.xs Wed Feb 28 06:36:38 2007
@@ -4355,16 +4355,33 @@
int i;
AV *src_av;
AV *dst_av = dbih_get_fbav(imp_sth);
- const int num_fields = AvFILL(dst_av)+1;
+ int dst_fields = AvFILL(dst_av)+1;
+ int src_fields;
(void)cv;
if (!SvROK(src_rv) || SvTYPE(SvRV(src_rv)) != SVt_PVAV)
croak("_set_fbav(%s): not an array ref", neatsvpv(src_rv,0));
src_av = (AV*)SvRV(src_rv);
- if (AvFILL(src_av)+1 != num_fields)
- croak("_set_fbav(%s): array has %d elements, the statement handle
expects %d",
- neatsvpv(src_rv,0), (int)AvFILL(src_av)+1, num_fields);
- for(i=0; i < num_fields; ++i) { /* copy over the row */
+ src_fields = AvFILL(src_av)+1;
+ if (src_fields != dst_fields) {
+ warn("_set_fbav(%s): array has %d elements, the statement handle row
buffer has %d (and NUM_OF_FIELDS is %d)",
+ neatsvpv(src_rv,0), src_fields, dst_fields,
DBIc_NUM_FIELDS(imp_sth));
+ SvREADONLY_off(dst_av);
+ if (src_fields < dst_fields) {
+ /* shrink the array - sadly this looses column bindings for the
lost columns */
+ av_fill(dst_av, src_fields-1);
+ dst_fields = src_fields;
+ }
+ else {
+ av_fill(dst_av, src_fields-1);
+ /* av_fill pads with immutable undefs which we need to change */
+ for(i=dst_fields-1; i < src_fields; ++i) {
+ sv_setsv(AvARRAY(dst_av)[i], newSV(0));
+ }
+ }
+ SvREADONLY_on(dst_av);
+ }
+ for(i=0; i < dst_fields; ++i) { /* copy over the row */
/* If we're given the values, then taint them if required */
if (DBIc_is(imp_sth, DBIcf_TaintOut))
SvTAINT(AvARRAY(src_av)[i]);
Modified: dbi/trunk/lib/DBD/Gofer.pm
==============================================================================
--- dbi/trunk/lib/DBD/Gofer.pm (original)
+++ dbi/trunk/lib/DBD/Gofer.pm Wed Feb 28 06:36:38 2007
@@ -75,14 +75,41 @@
}
- sub set_err_from_response {
+ sub set_err_from_response { # set error/warn/info and propagate warnings
my ($h, $response) = @_;
- # set error/warn/info
- my $warnings = $response->warnings || [];
- warn $_ for @$warnings;
+ if (my $warnings = $response->warnings) {
+ warn $_ for @$warnings;
+ }
return $h->set_err($response->err, $response->errstr,
$response->state);
}
+
+ sub install_methods_proxy {
+ my ($installed_methods) = @_;
+ while ( my ($full_method, $attr) = each %$installed_methods ) {
+ # need to install both a DBI dispatch stub and a proxy stub
+ # (the dispatch stub may be already here due to local driver use)
+
+ DBI->_install_method($full_method, "", $attr||{})
+ unless defined &{$full_method};
+
+ # now install proxy stubs on the driver side
+ $full_method =~ m/^DBI::(\w\w)::(\w+)$/
+ or die "Invalid method name '$full_method' for install_method";
+ my ($type, $method) = ($1, $2);
+ my $driver_method = "DBD::Gofer::${type}::${method}";
+ next if defined &{$driver_method};
+ my $sub;
+ if ($type eq 'db') {
+ $sub = sub { return shift->go_dbh_method(undef, $method, @_) };
+ }
+ else {
+ $sub = sub { return shift->set_err(1, "Can't call
\$${type}h->$method when using DBD::Gofer") };
+ }
+ no strict 'refs';
+ *$driver_method = $sub;
+ }
+ }
}
@@ -225,6 +252,13 @@
$dbh->{go_response} = $response;
if (my $dbh_attributes = $response->dbh_attributes) {
+
+ # XXX installed_methods piggbacks on dbh_attributes for now
+ if (my $installed_methods = delete
$dbh_attributes->{dbi_installed_methods}) {
+ DBD::Gofer::install_methods_proxy($installed_methods)
+ if $dbh->{go_request_count}==1;
+ }
+
# XXX we don't STORE here, we just stuff the value into the
attribute cache
$dbh->{$_} = $dbh_attributes->{$_}
for keys %$dbh_attributes;
@@ -342,8 +376,8 @@
};
# dbh attributes are set at connect-time - see connect()
- carp("Can't alter \$dbh->{$attrib}") if $dbh->FETCH('Warn');
- return $dbh->set_err(1, "Can't alter \$dbh->{$attrib}");
+ carp("Can't alter \$dbh->{$attrib} after handle created with
DBD::Gofer") if $dbh->FETCH('Warn');
+ return $dbh->set_err(1, "Can't alter \$dbh->{$attrib} after handle
created with DBD::Gofer");
}
sub disconnect {
@@ -395,10 +429,13 @@
if (my $ParamValues = $sth->{ParamValues}) {
my $ParamAttr = $sth->{ParamAttr};
- while ( my ($p, $v) = each %$ParamValues) {
+ # XXX the sort here is a hack to work around a DBD::Sybase bug
+ # but only works properly for params 1..9
+ # (reverse because of the unshift)
+ for my $p (reverse sort keys %$ParamValues) {
# unshift to put binds before execute call
unshift @{ $sth->{go_method_calls} },
- [ 'bind_param', $p, $v, $ParamAttr->{$p} ];
+ [ 'bind_param', $p, $ParamValues->{$p}, $ParamAttr->{$p} ];
}
}
@@ -681,6 +718,12 @@
AutoCommit only. Transactions aren't supported.
+=head2 You can't use temporary tables or other per-connection persistent state
+
+Because the transport or server-side may execute your request via a different
+database connection, you can't rely on any per-connection persistent state,
+such as temporary tables, being available from one request to the next.
+
=head2 You need to use func() to call driver-private dbh methods
So instead of the new-style:
@@ -787,10 +830,15 @@
=head3 pipeone
The pipeone transport launches a subprocess for each request. It passes in the
-request and reads the response. The fact that a new subprocess is started for
-each request proves that the server side is truly stateless. It also makes
-this transport very slow. It's useful, however, both as a proof of concept and
-as a base class for the stream driver.
+request and reads the response.
+
+The fact that a new subprocess is started for each request ensures that the
+server side is truly stateless. While this does make the transport very slow it
+is useful as a way to test that your application doesn't depend on
+per-connection state, such as temporary tables, persisting between requests.
+
+It's also useful both as a proof of concept and as a base class for the stream
+driver.
This transport supports a timeout parameter in the dsn which specifies
the maximum time it can take to send a requestor receive a response.
@@ -916,4 +964,9 @@
Neat way for $h->trace to enable transport tracing.
+Rework handling of installed_methods.
+
+Perhaps support transactions for transports where it's possible (ie null and
stream)?
+Would make stream transport (ie ssh) more useful to more people.
+
=cut
Modified: dbi/trunk/lib/DBI/Gofer/Execute.pm
==============================================================================
--- dbi/trunk/lib/DBI/Gofer/Execute.pm (original)
+++ dbi/trunk/lib/DBI/Gofer/Execute.pm Wed Feb 28 06:36:38 2007
@@ -84,8 +84,9 @@
dbh => [qw(
syb_dynamic_supported syb_oc_version syb_server_version
syb_server_version_string
)],
+ # we don't include syb_result_type as that's a *per row* attribute
sth => [qw(
- syb_types syb_result_type syb_proc_status
+ syb_types syb_proc_status
)],
},
SQLite => {
@@ -252,6 +253,10 @@
}
my %dbh_attr_values;
$dbh_attr_values{$_} = $dbh->FETCH($_) for @req_attr_names;
+
+ # XXX piggyback installed_methods onto dbh_attributes for now
+ $dbh_attr_values{dbi_installed_methods} = { DBI->installed_methods };
+
$response->dbh_attributes(\%dbh_attr_values);
}
@@ -326,13 +331,18 @@
};
my $response = $self->new_response_with_err($rv, $@);
+ return $response if not $dbh;
+
$response->last_insert_id( $last_insert_id )
if defined $last_insert_id;
- # XXX would be nice to be able to support streaming of results
# even if the eval failed we still want to try to gather attribute values
- $response->sth_resultsets( $self->gather_sth_resultsets($sth, $request) )
- if $sth;
+ # (XXX would be nice to be able to support streaming of results.
+ # which would reduce memory usage and latency for large results)
+ if ($sth) {
+ $response->sth_resultsets( $self->gather_sth_resultsets($sth,
$request) );
+ $sth->finish;
+ }
if (my $dbh_attr = $extra_attr{$dbh->{Driver}{Name}}{dbh_after_sth}) {
my %dbh_attr_values;
@@ -340,10 +350,7 @@
$response->dbh_attributes(\%dbh_attr_values);
}
- # which would reduce memory usage and latency for large results
-
- $self->reset_dbh($dbh)
- if $dbh;
+ $self->reset_dbh($dbh);
return $response;
}
