Tim, et al,
Here is a patch againt DBI-1.30 which adds some important
functionality and fixes a minor problem or two.
(Minor Highlights)
The notion of Proxy <--> ProxyServer protocol level is introduced to
maintain sanity and interoperability with older versions. There is
almost certainly a better way to implement it, but I wanted to get
something that worked out there for comments and testing.
Support is added to Proxy.pm for passing in PlRPC specific parameters;
specifically I needed to set 'maxmessage' in the DBI_AUTOPROXY
environment string. Anything prefixed with 'rpc_' has this trimmed
off and passed along to the PlRPC object.
A bug in the ProxyServer table_info() method was fixed. With Perl
5.8.0 and DBD::DB2 driver v1.26, calling $sth->fetch() in scalar
context is a losing proposition, resulting in the dreaded "Can't use
scalar '1' as an array ref.." exception.
I'm not sure if anyone has ever used 'dbish' to work with a proxied
database by setting DBI_AUTOPROXY, but as it stands the DBD::Sponge
pseudo driver gets invoked on the far end unless measures are taken.
This _should_ work, I suppose, but the dbish 'table_info' command
causes a dramatic core dump on the client side when run in this
manner. I suspect a bug in Storable, but have not been motivated to
track it down. Should be repeatable if anyone else wants to pursue
it. Forcibly clearing the environment variable after the initial
connection is setup ensures that Sponge runs on the client. Life is
then Good.
The dbish semantics for table_info also require that a Proxy
table_info call set the statement handle 'Active'. This now works
properly.
(Major Highlights)
Synchronous prepare / execute:
I remain unconvinced that the original "lazy" method (deferring
prepare until the first call to execute) was truly saving any
time. Further, although the DBI spec may legalize deferred prepare,
enforcing this on the proxy session when the underlying remote
database has meaningful and distinct prepare behavior violates the
principle of least surprise.
I make liberal use of positioned updates in my applications, and DB2
requires that a statement be prepared by the database before a valid
cursor name can be obtained. Also, "fetch-ahead" wreaks havoc in this
situation since we want the (remote) database cursor to remain on the
row being read on the client.
Propagation of remote database errors:
It is often desirable to suppress DBI exceptions and have the program
logic deal with common (or expected) cases. For this to work
transparently, the application must see the actual error information
generated by the remote database. My proposal is to always turn off
'RaiseError' on the ProxyServer and pass back the database-specific
codes on failure.
All this has been tested in a pre-production environment for a bit
over a week, using DB2 V7.2 as the remote database. I would greatly
appreciate any and all comments, criticisms and suggestions pertaining
to this code. If folks can throw it against a variety of other
databases, that would be great!
Regards,
Steve
(obligatory disclaimer: This message does not imply any official position
of IBM Corporation regarding its subject matter.)
--
----------------------------------------------------------------
Steven N. Hirsch tie-line: 446-6557 ext: 802-769-6557
Staff Engineer Methodology Integration Team
ASIC Product Development IBM Microelectronics
----------------------------------------------------------------
-------------------- Cut Here -------------------------
Index: DBI-1.30/lib/DBD/Proxy.pm
diff -u DBI-1.30/lib/DBD/Proxy.pm:1.1.1.1 DBI-1.30/lib/DBD/Proxy.pm:1.7
--- DBI-1.30/lib/DBD/Proxy.pm:1.1.1.1 Tue Sep 3 10:07:13 2002
+++ DBI-1.30/lib/DBD/Proxy.pm Mon Sep 9 09:38:25 2002
@@ -109,20 +109,28 @@
return DBI::set_err($drh, 1, $err) if $err; # Returns undef
+ my %client_opts = (
+ 'peeraddr' => $attr{'hostname'},
+ 'peerport' => $attr{'port'},
+ 'socket_proto' => 'tcp',
+ 'application' => $attr{dsn},
+ 'user' => $user || '',
+ 'password' => $auth || '',
+ 'version' => $DBD::Proxy::VERSION,
+ 'cipher' => $cipherRef,
+ 'debug' => $attr{debug} || 0,
+ 'timeout' => $attr{timeout} || undef,
+ 'logfile' => $attr{logfile} || undef
+ );
+ # Options starting with 'rpc_' are forwarded to the RPC layer after
+ # stripping the prefix.
+ while (my($var,$val) = each %attr) {
+ if ($var =~ s/^rpc_//) {
+ $client_opts{$var} = $val;
+ }
+ }
# Create an RPC::PlClient object.
- my($client, $msg) = eval { RPC::PlClient->new(
- 'peeraddr' => $attr{'hostname'},
- 'peerport' => $attr{'port'},
- 'socket_proto' => 'tcp',
- 'application' => $attr{dsn},
- 'user' => $user || '',
- 'password' => $auth || '',
- 'version' => $DBD::Proxy::VERSION,
- 'cipher' => $cipherRef,
- 'debug' => $attr{debug} || 0,
- 'timeout' => $attr{timeout} || undef,
- 'logfile' => $attr{logfile} || undef
- ) };
+ my($client, $msg) = eval { RPC::PlClient->new(%client_opts) };
return DBI::set_err($drh, 1, "Cannot log in to DBI::ProxyServer: $@")
if $@; # Returns undef
@@ -131,6 +139,22 @@
$msg = RPC::PlClient::Object->new($1, $client, $msg);
+ my $max_proto;
+ my ($version_string) = eval { $client->Call('Version') };
+ if ( $@ ) {
+ # Server denies call, assume legacy protocol.
+ $max_proto = 1;
+ } else {
+ # Parse proxy server version.
+ my ($version) = $version_string =~ /^DBI::ProxyServer\s+([\d\.]+)/;
+ $max_proto = $version >= 0.3 ? 2 : 1;
+ }
+ if ( exists $attr{proxy_proto} ) {
+ my $req_proto = $attr{proxy_proto};
+ return DBI::set_err($drh, 1, "DBI::ProxyServer does not support protocol
+version $req_proto")
+ if $max_proto < $req_proto;
+ }
+
# Switch to user specific encryption mode, if desired
if ($userCipherRef) {
$client->{'cipher'} = $userCipherRef;
@@ -141,7 +165,8 @@
'Name' => $dsnOrig,
'proxy_dbh' => $msg,
'proxy_client' => $client,
- 'RowCacheSize' => $attr{'RowCacheSize'} || 20
+ 'RowCacheSize' => $attr{'RowCacheSize'} || 20,
+ 'proxy_protocol' => $attr{'proxy_proto'} || $max_proto
});
foreach $var (keys %attr) {
@@ -168,6 +193,13 @@
use vars qw(%ATTR $AUTOLOAD);
+# inherited: STORE / FETCH against this class.
+# local: STORE / FETCH against parent class.
+# cached: STORE to remote and local objects, FETCH from local.
+# remote: STORE / FETCH against remote object only (default).
+#
+# Note: Attribute names starting with 'proxy_' always treated as 'inherited'.
+#
%ATTR = ( # see also %ATTR in DBD::Proxy::st
'Warn' => 'local',
'Active' => 'local',
@@ -268,16 +300,30 @@
sub prepare ($$;$) {
my($dbh, $stmt, $attr) = @_;
-
- # We *could* send the statement over the net immediately, but the
- # DBI specs allows us to defer that until the first 'execute'.
- # XXX should make this configurable
my $sth = DBI::_new_sth($dbh, {
- 'Statement' => $stmt,
- 'proxy_attr' => $attr,
- 'proxy_params' => [],
- 'proxy_cache_only' => 0,
- });
+ 'Statement' => $stmt,
+ 'proxy_attr' => $attr,
+ 'proxy_cache_only' => 0,
+ 'proxy_params' => [],
+ }
+ );
+ if ( $dbh->{'proxy_protocol'} > 1 ) {
+ $sth->{'proxy_attr_cache'} = {cache_filled => 0};
+ my $rdbh = $dbh->{'proxy_dbh'};
+ my $proto = $dbh->{'proxy_protocol'};
+ my $rsth = eval { $rdbh->prepare($sth->{'Statement'}, $sth->{'proxy_attr'},
+undef, $proto) };
+ return DBI::set_err($sth, 1, $@) if $@;
+ return DBI::set_err($sth, 1,
+ "Constructor didn't return a handle: $rsth")
+ unless ($rsth =~ /^((?:\w+|\:\:)+)=(\w+)/);
+
+ my $client = $dbh->{'proxy_client'};
+ $rsth = RPC::PlClient::Object->new($1, $client, $rsth);
+
+ $sth->{'proxy_sth'} = $rsth;
+ # If statement is a positioned update we do not want any readahead.
+ $sth->{'RowCacheSize'} = 1 if $stmt =~ /\bfor\s+update\b/i;
+ }
$sth;
}
@@ -321,11 +367,14 @@
'NUM_OF_PARAMS' => 0,
'NUM_OF_FIELDS' => $numFields,
'NAME' => $names,
- 'TYPE' => $types
+ 'TYPE' => $types,
+ 'cache_filled' => 1
},
'proxy_cache_only' => 1,
});
$sth->SUPER::STORE('NUM_OF_FIELDS' => $numFields);
+ $sth->SUPER::STORE('Active' => 1) if @rows;
+ $sth->{'proxy_rows'} = @rows;
return $sth;
}
@@ -350,6 +399,15 @@
use vars qw(%ATTR);
+# inherited: STORE to current object. FETCH from current if exists, else call up
+# to the (proxy) database object.
+# local: STORE / FETCH against parent class.
+# cache_only: STORE noop (read-only). FETCH from private_* if exists, else call
+# remote and cache the result.
+# remote: STORE / FETCH against remote object only (default).
+#
+# Note: Attribute names starting with 'proxy_' always treated as 'inherited'.
+#
%ATTR = ( # see also %ATTR in DBD::Proxy::db
'Warn' => 'local',
'Active' => 'local',
@@ -378,60 +436,73 @@
# new execute, so delete any cached rows from previous execute
undef $sth->{'proxy_data'};
- my $dbh = $sth->FETCH('Database');
- my $client = $dbh->{'proxy_client'};
my $rsth = $sth->{proxy_sth};
+ my $dbh = $sth->FETCH('Database');
+ my $proto = $dbh->{proxy_protocol};
+
+ my ($numRows, @outData);
- my ($numFields, $numParams, $numRows, $names, $types, @outParams);
+ if ( $proto > 1 ) {
+ ($numRows, @outData) = eval { $rsth->execute($params, $proto) };
+ return DBI::set_err($sth, 1, $@) if $@;
+ # RaiseError is off for 'execute' at proxy, but there still may
+ # have been problems. Propagate the DBD-specific code, SQLSTATE and
+ # error string.
+ return DBI::set_err($sth, @outData[0..2]) unless $numRows;
+
+ # Attributes passed back only on the first execute() of a statement.
+ unless ($sth->{proxy_attr_cache}->{cache_filled}) {
+ my ($numFields, $numParams, $names, $types) = splice(@outData, 0, 4);
+ $sth->{'proxy_attr_cache'} = {
+ 'NUM_OF_FIELDS' => $numFields,
+ 'NUM_OF_PARAMS' => $numParams,
+ 'NAME' => $names,
+ 'cache_filled' => 1
+ };
+ $sth->SUPER::STORE('NUM_OF_FIELDS' => $numFields);
+ $sth->SUPER::STORE('NUM_OF_PARAMS' => $numParams);
+ }
- if ($sth->{'proxy_data'}) {
- my $attrCache = $sth->{'proxy_attr_cache'};
- $numFields = $attrCache->{'NUM_OF_FIELDS'};
- $numParams = $attrCache->{'NUM_OF_PARAMS'};
- $names = $attrCache->{'NAME'};
- $types = $attrCache->{'TYPE'};
- $numRows = scalar @{$sth->{'proxy_data'}};
} else {
+ if ($rsth) {
+ ($numRows, @outData) = eval { $rsth->execute($params, $proto) };
+ return DBI::set_err($sth, 1, $@) if $@;
- if (!$rsth) {
+ } else {
my $rdbh = $dbh->{'proxy_dbh'};
-
- ($rsth, $numFields, $numParams, $names, $types, $numRows, @outParams) =
- eval { $rdbh->prepare($sth->{'Statement'},
- $sth->{'proxy_attr'}, $params) };
+
+ # Legacy prepare is actually prepare + first execute on the server.
+ ($rsth, @outData) =
+ eval { $rdbh->prepare($sth->{'Statement'},
+ $sth->{'proxy_attr'}, $params, $proto) };
return DBI::set_err($sth, 1, $@) if $@;
return DBI::set_err($sth, 1,
"Constructor didn't return a handle: $rsth")
- unless ($rsth =~ /^((?:\w+|\:\:)+)=(\w+)/);
-
+ unless ($rsth =~ /^((?:\w+|\:\:)+)=(\w+)/);
+
+ my $client = $dbh->{'proxy_client'};
$rsth = RPC::PlClient::Object->new($1, $client, $rsth);
+ my ($numFields, $numParams, $names, $types) = splice(@outData, 0, 4);
$sth->{'proxy_sth'} = $rsth;
- $sth->SUPER::STORE('NUM_OF_FIELDS' => $numFields);
- $sth->SUPER::STORE('NUM_OF_PARAMS' => $numParams);
- } else {
- my $attrCache = $sth->{'proxy_attr_cache'};
- $numFields = $attrCache->{'NUM_OF_FIELDS'};
- $numParams = $attrCache->{'NUM_OF_PARAMS'};
- $names = $attrCache->{'NAME'};
- $types = $attrCache->{'TYPE'};
- ($numRows, @outParams) = eval { $rsth->execute($params) };
- return DBI::set_err($sth, 1, $@) if $@;
- }
- }
- $sth->{'proxy_rows'} = $numRows;
- $sth->{'proxy_attr_cache'} = {
+ $sth->{'proxy_attr_cache'} = {
'NUM_OF_FIELDS' => $numFields,
'NUM_OF_PARAMS' => $numParams,
'NAME' => $names
- };
-
- $sth->SUPER::STORE('Active' => 1) if $numFields; # is SELECT
-
- if (@outParams) {
+ };
+ $sth->SUPER::STORE('NUM_OF_FIELDS' => $numFields);
+ $sth->SUPER::STORE('NUM_OF_PARAMS' => $numParams);
+ $numRows = shift @outData;
+ }
+ }
+ # Always condition active flag.
+ $sth->SUPER::STORE('Active' => 1) if $sth->FETCH('NUM_OF_FIELDS'); # is SELECT
+ $sth->{'proxy_rows'} = $numRows;
+ # Any remaining items are output params.
+ if (@outData) {
foreach my $p (@$params) {
if (ref($p) && @$p > 2) {
- my $ref = shift @outParams;
+ my $ref = shift @outData;
${$p->[0]} = $$ref;
}
}
Index: DBI-1.30/lib/DBI-1.30/ProxyServer.pm
diff -u DBI-1.30/lib/DBI-1.30/ProxyServer.pm:1.1.1.1
DBI-1.30/lib/DBI-1.30/ProxyServer.pm:1.4
--- DBI-1.30/lib/DBI-1.30/ProxyServer.pm:1.1.1.1 Tue Sep 3 10:07:14 2002
+++ DBI-1.30/lib/DBI-1.30/ProxyServer.pm Sun Sep 8 10:49:35 2002
@@ -48,7 +48,7 @@
use vars qw($VERSION @ISA);
-$VERSION = "0.2005";
+$VERSION = "0.3005";
@ISA = qw(RPC::PlServer DBI);
@@ -76,6 +76,7 @@
$o->{'logfile'} = undef; # Use syslog or EventLog.
$o->{'methods'} = {
'DBI::ProxyServer' => {
+ 'Version' => 1,
'NewHandle' => 1,
'CallMethod' => 1,
'DestroyHandle' => 1
@@ -247,7 +248,7 @@
@DBI::ProxyServer::db::ISA = qw(DBI::db);
sub prepare {
- my($dbh, $statement, $attr, $params) = @_;
+ my($dbh, $statement, $attr, $params, $proto) = @_;
my $server = $dbh->{'private_server'};
if (my $client = $server->{'client'}) {
if ($client->{'sql'}) {
@@ -261,22 +262,28 @@
}
}
}
-
- # The difference between the usual prepare and ours is that we implement
- # a combined prepare/execute. The DBD::Proxy driver doesn't call us for
- # prepare. Only if an execute happens, then we are called with method
- # "prepare". Further execute's are called as "execute".
my $sth = $dbh->SUPER::prepare($statement, $attr);
- my @result = $sth->execute($params);
my $handle = $server->StoreHandle($sth);
- my ($NAME, $TYPE);
- my $NUM_OF_FIELDS = $sth->{NUM_OF_FIELDS};
- if ($NUM_OF_FIELDS) { # is a SELECT
+
+ if ( $proto and $proto > 1 ) {
+ $sth->{private_proxyserver_described} = 0;
+ return $handle;
+
+ } else {
+ # The difference between the usual prepare and ours is that we implement
+ # a combined prepare/execute. The DBD::Proxy driver doesn't call us for
+ # prepare. Only if an execute happens, then we are called with method
+ # "prepare". Further execute's are called as "execute".
+ my @result = $sth->execute($params);
+ my ($NAME, $TYPE);
+ my $NUM_OF_FIELDS = $sth->{NUM_OF_FIELDS};
+ if ($NUM_OF_FIELDS) { # is a SELECT
$NAME = $sth->{NAME};
$TYPE = $sth->{TYPE};
+ }
+ ($handle, $NUM_OF_FIELDS, $sth->{'NUM_OF_PARAMS'},
+ $NAME, $TYPE, @result);
}
- ($handle, $NUM_OF_FIELDS, $sth->{'NUM_OF_PARAMS'},
- $NAME, $TYPE, @result);
}
sub table_info {
@@ -293,7 +300,8 @@
# DBI::st and not DBI::ProxyServer::st. We could fix this by permitting
# the client to execute method DBI::st, but I don't like this.
my @rows;
- while (my $row = $sth->fetch()) {
+ while (my ($row) = $sth->fetch()) {
+ last unless defined $row;
push(@rows, [@$row]);
}
($numFields, $names, $types, @rows);
@@ -305,7 +313,7 @@
@DBI::ProxyServer::st::ISA = qw(DBI::st);
sub execute {
- my $sth = shift; my $params = shift;
+ my $sth = shift; my $params = shift; my $proto = shift;
my @outParams;
if ($params) {
for (my $i = 0; $i < @$params;) {
@@ -325,9 +333,34 @@
}
}
}
+ if ( $proto and $proto > 1 ) {
+ # Suppress exceptions for execute() so we can cleanly return
+ # database-specific error information to caller.
+ local $sth->{RaiseError} = 0;
+ if (my $rows = $sth->SUPER::execute()) {
+ unless ($sth->{private_proxyserver_described}) {
+ my ($NAME, $TYPE);
+ my $NUM_OF_FIELDS = $sth->{NUM_OF_FIELDS};
+ if ($NUM_OF_FIELDS) { # is a SELECT
+ $NAME = $sth->{NAME};
+ $TYPE = $sth->{TYPE};
+ }
+ $sth->{private_proxyserver_described} = 1;
+ # First execution, we ship back description.
+ return ($rows, $NUM_OF_FIELDS, $sth->{'NUM_OF_PARAMS'}, $NAME, $TYPE,
+@outParams);
+ }
+ # Only rowcount and output parms on subsequent calls.
+ return ($rows, @outParams);
+ } else {
+ # If target driver reported an error, be precise about returning
+ # it to client.
+ return (undef, $sth->err(), $sth->errstr(), $sth->state());
+ }
- my $rows = $sth->SUPER::execute();
- ($rows, @outParams);
+ } else {
+ my $rows = $sth->SUPER::execute();
+ return ($rows, @outParams);
+ }
}
sub fetch {
Index: DBI-1.30/lib/DBI-1.30/Shell.pm
diff -u DBI-1.30/lib/DBI-1.30/Shell.pm:1.1.1.1 DBI-1.30/lib/DBI-1.30/Shell.pm:1.2
--- DBI-1.30/lib/DBI-1.30/Shell.pm:1.1.1.1 Tue Sep 3 10:07:14 2002
+++ DBI-1.30/lib/DBI-1.30/Shell.pm Thu Sep 5 08:22:49 2002
@@ -335,7 +335,8 @@
# Use valid "dbi:driver:..." to connect with source.
$sh->do_connect( $sh->{data_source} );
-
+ # So we don't invoke Sponge on the far end!
+ delete $ENV{DBI_AUTOPROXY};
#
# Main loop
#
