subclassing DBI 1.15 - disconnect problem

[Phil R Lawrence]

Our upgrade to DBI 1.15 (from 1.13) seems to have broken something
with regards to subclassing the DBI.  My reports used to work fine,
but now produce the following error:

  Uncaught exception from user code:
        DBI->disconnect is not a DBI method...

This is odd, so I created a set of very simple test modules and
scripts to model how we have accomplished DBI subclassing to this
point.  The model was originally taken from ./t/subclass.t in the DBI
install dir.

Test System Overview:
SUBCLASS_DBI.pm     - subclasses DBI, uses init_rootclass
                      method, provides ridiculous alternate
                      connect method
STORIT.pm           - uses SUBCLASS_DBI.pm to bless its own
                      self and inherit all of the DBI
use_SUBCLASS_DBI.pl - title says it all
use_STORIT.pl       - title says it all


Please note this *Important Clue*:  the error I noted above only
occurs when running use_STORIT.pl.  The first level(?semantics?)
subclassing that goes on when invoking use_SUBCLASS_DBI.pl causes no
error.

Thank you for your help,
Phil R Lawrence

                                          ***SUBCLASS_DBI.pm***
---------------------------------------------------------------
package SUBCLASS_DBI;
@ISA = qw(DBI);

use DBI;
use strict;

sub test_connect {

    # Note that other classes may inherit and use this method
    # only if they also subclass SUBCLASS_DBI::db and
    # SUBCLASS_DBI::st in the same manner that SUBCLASS_DBI
    # subclasses DBI::db and DBI::st.  See ./t/subclass.t in
    # the DBI install directory for the basic example of
    # subclassing the DBI from which this module was modelled.
    my $proto = shift;
    my $class = ref($proto) || $proto;

    # Tell the DBI that $class is a new 'root class'.  This
    # enables DBI to bless our object for us.  In other words,
    # the constructor for our class is in the DBI package!
    $class->init_rootclass;


    my $dbh = $class->connect(
        'dbi:Oracle:bnco.world','prl2','prl24',
        {PrintError => 0}
    );
    if ($dbh) {
        # Return PrintError to the default setting of ON.
        $dbh->{PrintError} = 1;
    }
    return $dbh;

}

#==============================================================
package SUBCLASS_DBI::db;
use vars qw( @ISA );
@ISA = qw( DBI::db);

#==============================================================
package SUBCLASS_DBI::st;
use vars qw( @ISA );
@ISA = qw(DBI::st);
---------------------------------------------------------------


                                                ***STORIT.pm***
---------------------------------------------------------------
package STORIT;
use strict;
use SUBCLASS_DBI;

use vars qw( @ISA );
@ISA = qw ( SUBCLASS_DBI );

sub new {
    my $proto = shift;
    my $class = ref($proto) || $proto;

    # SUBCLASS_DBI's test_connect method gives back $s already
    # blessed into our $class, or we die.
    my $s;
    $s = $class->test_connect or die;

    return $s;
}

sub storit {
    my $self = shift;
    my ($key,$val) = (shift,shift);
    $self->{private_STORIT_info}{$key} = $val;
}

sub getit {
    my $self = shift;
    my $key = shift;
    return $self->{private_STORIT_info}{$key};
}

#==============================================================
package STORIT::db;
use vars qw( @ISA );
@ISA = qw( STORIT SUBCLASS_DBI::db );


#==============================================================
package STORIT::st;
use vars qw( @ISA );
@ISA = qw(SUBCLASS_DBI::st);
---------------------------------------------------------------


                                      ***use_SUBCLASS_DBI.pl***
---------------------------------------------------------------
#!/usr/local/bin/perl -w
use diagnostics;
use strict;
use lib '/u/prl2/perl/modules';
use SUBCLASS_DBI;

SUBCLASS_DBI->trace(1,"$0.trace");

my $dbh = SUBCLASS_DBI->test_connect or die;
$dbh->{RaiseError} = 1;

my $sth = $dbh->prepare("SELECT 'blah' FROM dual");
$sth->execute;
my $val = $sth->fetchrow_array;
$sth->finish;

print "$0 ended up with $val\n";
$dbh->disconnect;
---------------------------------------------------------------


                                            ***use_STORIT.pl***
---------------------------------------------------------------
#!/usr/local/bin/perl -w
use diagnostics;
use strict;
use lib '/u/prl2/perl/modules';
use STORIT;

STORIT->trace(1,"$0.trace");

my $s = STORIT->test_connect;
$s->{RaiseError} = 1;

my $sth = $s->prepare("SELECT 'blah' FROM dual");
$sth->execute;
my $val = $sth->fetchrow_array;
$sth->finish;

my $key = 'foo';
$s->storit($key,$val);

print "$0 ended up with ", $s->getit($key), "\n";
$s->disconnect;
---------------------------------------------------------------