Author: timbo
Date: Tue Sep 26 15:33:45 2006
New Revision: 7857
Modified:
dbi/trunk/lib/DBD/Proxy.pm
dbi/trunk/lib/DBI/ProxyServer.pm
dbi/trunk/t/80proxy.t
Log:
Fixed DBD::Proxy handling of some methods, including commit and rollback.
(Looks like there's scope for significant speedups as select*_* methods
currently aren't proxied, so the rows are fetch by lower-level code.)
Modified: dbi/trunk/lib/DBD/Proxy.pm
==============================================================================
--- dbi/trunk/lib/DBD/Proxy.pm (original)
+++ dbi/trunk/lib/DBD/Proxy.pm Tue Sep 26 15:33:45 2006
@@ -219,13 +219,21 @@
$DBD::Proxy::db::imp_data_size = 0;
-# XXX probably many more methods need to be added here.
+# XXX probably many more methods need to be added here
+# in order to trigger our AUTOLOAD to redirect them to the server.
+# (Unless the sub is declared it's bypassed by perl method lookup.)
# See notes in ToDo about method metadata
+# The question is whether to add all the methods in %DBI::DBI_methods
+# to the corresponding classes (::db, ::st etc)
+# Also need to consider methods that, if proxied, would change the server state
+# in a way that might not be visible on the client, ie begin_work ->
AutoCommit.
+
sub commit;
sub connected;
sub rollback;
sub ping;
+
use vars qw(%ATTR $AUTOLOAD);
# inherited: STORE / FETCH against this class.
@@ -249,38 +257,31 @@
sub AUTOLOAD {
my $method = $AUTOLOAD;
$method =~ s/(.*::(.*)):://;
- # warn "AUTOLOAD of $method";
my $class = $1;
my $type = $2;
- my %expand =
- ( 'method' => $method,
- 'class' => $class,
- 'type' => $type,
- 'h' => "DBI::_::$type"
- );
- my $method_code = UNIVERSAL::can($expand{'h'}, $method) ?
- q/package ~class~;
- sub ~method~ {
+ #warn "AUTOLOAD of $method (class=$class, type=$type)";
+ my %expand = (
+ 'method' => $method,
+ 'class' => $class,
+ 'type' => $type,
+ 'call' => "$method([EMAIL PROTECTED])",
+ # XXX was trying to be smart but was tripping up over the DBI's own
+ # smartness. Disabled, but left here in case there are issues.
+ # 'call' => (UNIVERSAL::can("DBI::_::$type", $method)) ? "$method([EMAIL
PROTECTED])" : "func([EMAIL PROTECTED], '$method')",
+ );
+
+ my $method_code = q{
+ package ~class~;
+ sub ~method~ {
my $h = shift;
- local $@;
- my @result = wantarray
- ? eval { $h->{'proxy_~type~h'}->~method~(@_) }
- : eval { scalar $h->{'proxy_~type~h'}->~method~(@_) };
+ local $@;
+ my @result = wantarray
+ ? eval { $h->{'proxy_~type~h'}->~call~ }
+ : eval { scalar $h->{'proxy_~type~h'}->~call~ };
return DBD::Proxy::proxy_set_err($h, $@) if $@;
- wantarray ? @result : $result[0];
- }
- / :
- q/package ~class~;
- sub ~method~ {
- my $h = shift;
- local $@;
- my @result = wantarray
- ? eval { $h->{'proxy_~type~h'}->func(@_, '~method~') }
- : eval { scalar $h->{'proxy_~type~h'}->func(@_, '~method~') };
- return DBD::Proxy::proxy_set_err($h, $@) if $@;
- wantarray ? @result : $result[0];
- }
- /;
+ return wantarray ? @result : $result[0];
+ }
+ };
$method_code =~ s/\~(\w+)\~/$expand{$1}/eg;
local $SIG{__DIE__} = 'DEFAULT';
my $err = do { local $@; eval $method_code.2; $@ };
@@ -895,6 +896,26 @@
=head1 KNOWN ISSUES
+=head2 Unproxied method calls
+
+If a method isn't being proxied, try declaring a stub sub in the appropriate
+package (DBD::Proxy::db for a dbh method, and DBD::Proxy::st for an sth
method).
+For example:
+
+ sub DBD::Proxy::db::selectall_arrayref;
+
+That will enable selectall_arrayref to be proxied.
+
+Currently many methods aren't explicitly proxied and so you get the DBI's
+default methods executed on the client.
+
+Some of those methods, like selectall_arrayref, may then call other methods
+that are proxied (selectall_arrayref calls fetchall_arrayref which calls fetch
+which is proxied). So things may appear to work but operate more slowly than
+the could.
+
+This may all change in a later version.
+
=head2 Complex handle attributes
Sometimes handles are having complex attributes like hash refs or
Modified: dbi/trunk/lib/DBI/ProxyServer.pm
==============================================================================
--- dbi/trunk/lib/DBI/ProxyServer.pm (original)
+++ dbi/trunk/lib/DBI/ProxyServer.pm Tue Sep 26 15:33:45 2006
@@ -68,7 +68,9 @@
$o->{'localport'} = undef; # Must set port number on the
# command line.
$o->{'logfile'} = undef; # Use syslog or EventLog.
- $o->{'methods'} = {
+
+ # XXX don't restrict methods that can be called (trust users once
connected)
+ $o->{'XXX_methods'} = {
'DBI::ProxyServer' => {
'Version' => 1,
'NewHandle' => 1,
Modified: dbi/trunk/t/80proxy.t
==============================================================================
--- dbi/trunk/t/80proxy.t (original)
+++ dbi/trunk/t/80proxy.t Tue Sep 26 15:33:45 2006
@@ -71,10 +71,12 @@
or die "Failed to create config file $config_file: $!";
my($handle, $port);
-my $numTests = 125;
+my $numTests = 135;
+
if (@ARGV) {
$port = $ARGV[0];
-} else {
+}
+else {
# set DBI_TRACE to 0 to just get dbiproxy.log DBI trace for server
# set DBI_TRACE > 0 to also get DBD::Proxy trace
@@ -87,11 +89,13 @@
# If desperate uncomment this and add '-d' after $^X below:
# local $ENV{PERLDB_OPTS} = "AutoTrace NonStop=1 LineInfo=dbiproxy.dbg";
+ # pass our @INC to children (e.g., so -Mblib passes through)
+ $ENV{PERL5LIB} = join(':', @INC);
+
my $dbi_trace_level = DBI->trace(0);
my @child_args = (
#'truss', '-o', 'dbiproxy.truss',
- $^X, '-Iblib/lib', '-Iblib/arch',
- 'dbiproxy', '--test', # --test must be first command line arg
+ $^X, 'dbiproxy', '--test', # --test must be first command line arg
($dbi_trace_level ? ('--dbitrace=dbiproxy.log') : ()),
'--configfile', $config_file,
(($dbi_trace_level) ? ('--logfile=1') : ()),
@@ -131,6 +135,25 @@
};
Test($@ eq "BANG!!!\n", "\$@ value lost");
+
+print "begin_work...\n";
+Test($dbh->{AutoCommit});
+Test(!$dbh->{BegunWork});
+
+Test($dbh->begin_work);
+Test(!$dbh->{AutoCommit});
+Test($dbh->{BegunWork});
+
+$dbh->commit;
+Test(!$dbh->{BegunWork});
+Test($dbh->{AutoCommit});
+
+Test($dbh->begin_work({}));
+$dbh->rollback;
+Test($dbh->{AutoCommit});
+Test(!$dbh->{BegunWork});
+
+
print "Doing a ping.\n";
$_ = $dbh->ping;
Test($_);
