Re: subclassing the DBI and the clone method

Tim Bunce wrote:
> On Tue, Jan 19, 2010 at 09:04:43PM +0000, Martin J. Evans wrote:
>> Hi,
>>
>> Is there anything special a subclassed DBI module (DBIx::Log4perl in
>> this case) needs to do for the clone method?
>>
>> The DBI docs currently say "The clone method duplicates the $dbh
>> connection by connecting with the same parameters ($dsn, $user,
>> $password) as originally used."
> 
>     sub clone {
>         my ($old_dbh, $attr) = @_;
>         my $closure = $old_dbh->{dbi_connect_closure} or return;
> 
> That's a closure created by connect() that performs the $drh->connect call.
> 
>         unless ($attr) {
>             # copy attributes visible in the attribute cache
>             keys %$old_dbh;     # reset iterator
>             while ( my ($k, $v) = each %$old_dbh ) {
>                 # ignore non-code refs, i.e., caches, handles, Err etc
>                 next if ref $v && ref $v ne 'CODE'; # HandleError etc
>                 $attr->{$k} = $v;
>             }
>             # explicitly set attributes which are unlikely to be in the
>             # attribute cache, i.e., boolean's and some others
>             $attr->{$_} = $old_dbh->FETCH($_) for (qw(
>                 AutoCommit ChopBlanks InactiveDestroy
>                 LongTruncOk PrintError PrintWarn Profile RaiseError
>                 ShowErrorStatement TaintIn TaintOut
>             ));
>         }
>         # use Data::Dumper; warn Dumper([$old_dbh, $attr]);
>         my $new_dbh = &$closure($old_dbh, $attr);
>         unless ($new_dbh) {
>             # need to copy err/errstr from driver back into $old_dbh
>             my $drh = $old_dbh->{Driver};
>             return $old_dbh->set_err($drh->err, $drh->errstr, $drh->state);
>         }
>         return $new_dbh;
>     }
> 
>> but I don't see any call to connect when clone is called.
> 
> You don't see a call to DBI->connect, but there is a call to
> $drh->connect via the closure.
> 
>> I presume there is something I need to do - any ideas?
> 
> The closure calles the connected() method ad that's a good method to
> override to (re)setup any private stuff you need.
> 
> Tim.
> 
> 

Tim,

Thank you for the pointers. I had all DBIx::Log4perl setup in the
connect method (strangely I don't recollect reading about the connected
method) and after moving it all to the connected method and deleting my
failing attempt at clone override this now seems to work except:

o when I pass DBIx::Log4perl attributes in the connection e.g.,
  connect('dbi:Oracle:xxx','user', 'pass', {DBIx_l4p_logmask => 1})

I get warnings from the connect closure like this:

Can't set DBIx::Log4perl::db=HASH(0x87116c0)->{DBIx_l4p_logmask}:
unrecognised attribute name or invalid value

Previously I didn't get these as I parsed my attributes out in my
connect method then deleted them before DBI saw them but now I need them
to get down to the connected method but I don't want those warnings and
the code checks before calling connected:

	if (%$apply) {

            if ($apply->{DbTypeSubclass}) {
                my $DbTypeSubclass = delete $apply->{DbTypeSubclass};
                DBI::_rebless_dbtype_subclass($dbh,
$rebless_class||$class, $DbTypeSubclass);
            }
	    my $a;
	    foreach $a (qw(Profile RaiseError PrintError AutoCommit)) { # do
these first
		next unless  exists $apply->{$a};
		$dbh->{$a} = delete $apply->{$a};
	    }
	    while ( my ($a, $v) = each %$apply) {
# MJE warnings generated here
		eval { $dbh->{$a} = $v } or $@ && warn $@;
	    }
	}

        # confirm to driver (ie if subclassed) that we've connected
sucessfully
        # and finished the attribute setup. pass in the original arguments
	$dbh->connected(@orig_args); #if ref $dbh ne 'DBI::db' or $proxy;

and I cannot capture them in connect as this does not work for clone (as
my connect never gets called if you clone).

o "Can't locate auto/DBIx/Log4perl/st/DELETE.al"

I feel this is something I've done wrong but I cannot find it yet. My
connect method is trying to call $dbh->func('dbms_output_enable') in
DBD::Oracle (as it always has done) but it is failing in my execute
attempting to undefine HandleError:

#
# If DBDSPECIFIC is enabled and this is DBD::Oracle we will attempt to
# to retrieve any dbms_output. However, 'dbms_output_get' actually
# creates a new statement, prepares it, executes it, binds parameters
# and then fetches the dbms_output. This will cause this execute method
# to be called again and we could recurse forever. To prevent that
# happening we set {dbd_specific} flag before calling dbms_output_get
# and clear it afterwards.
#
# Also in DBI (at least up to 1.54) and most DBDs, the same memory is
# used for a dbh errstr/err/state and each statement under it. As a
# result, if you sth1->execute (it fails) then $sth2->execute which
# succeeds, sth1->errstr/err are undeffed :-(
# see http://www.nntp.perl.org/group/perl.dbi.users/2007/02/msg30971.html
# To sort this out, we save the errstr/err/state on the first sth
# and put them back after using the second sth (ensuring we temporarily
# turn off any error handler to avoid set_err calling them again).
#
if (($h->{logger}->is_debug()) &&
    ($h->{logmask} & DBIX_L4P_LOG_DBDSPECIFIC) &&
	($h->{driver} eq 'Oracle') && (!$h->{dbd_specific})) {

    my ($errstr, $err, $state) = (
        $sth->errstr, $sth->err, $sth->state);
	$h->{dbd_specific} = 1;
	my $dbh = $sth->FETCH('Database');

    my @lines = $dbh->func('dbms_output_get');
	$sth->_dbix_l4p_debug($h, 2, 'dbms', @lines) if (scalar(@lines) > 0);
	$h->{dbd_specific} = 0;
    {
        local $sth->{HandleError} = undef; # MJE FAILS HERE
        local $sth->{HandleSetErr} = undef;
        $sth->set_err($err, $errstr, $state);
    }
}

Martin
-- 
Martin J. Evans
Easysoft Limited
http://www.easysoft.com