Tim, I made the changes you suggested. Here is the code:
-------------------------------
package MySubDBI;
use strict;
use DBI;
use vars qw(@ISA);
@ISA = qw(DBI);
package MySubDBI::dr;
use vars qw(@ISA);
@ISA = qw(DBI::dr);
sub connect {
my ($drh, @args) = @_;
my $dbh = $drh->SUPER::connect(@args)
or return;
$dbh->{private_mysubdbi_test} = 'blabla';
print "test0\n";
return $dbh;
}
package MySubDBI::db;
use vars qw(@ISA);
@ISA = qw(DBI::db);
sub test {
my $dbh = shift;
return $dbh->{private_mysubdbi_test};
}
package MySubDBI::st;
use vars qw(@ISA);
@ISA = qw(DBI::st);
package Main;
my $dbn = "DBI:mysql:database=***:host=***:port=***";
my $dbh = MySubDBI->connect( $dbn, '***', '***' );
if ( $dbh ) { print "connection ok\n" } else { print "connection error\n" }
print 'test1: ', $dbh->{private_mysubdbi_test}, "\n";
print 'test2: ', $dbh->test, "\n";
-------------------------------
But it gives exactly the same result, namely:
connection ok
test1:
test2:
