I've managed to recreate the threading issue
with DBD::Sponge (see script below) ( I also
modified DBD::Sponge - not included below -
to add an $installed flag for its one
installed method)
The secret seems to be spawning a few threads that
connect(), then disconnect and exit, then
spawning some more threads that connect().
The 2nd set of threads generate the warning msg.
The interesting thing is that the scalar it complains about
is the same in all cases.
I'll try this on 5.8.3 when I get a chance.
###############################################################
#!/usr/local/bin/perl -w
use DBI;
use DBI qw(:sql_types);
use Config;
use threads;
use threads::shared; # so we can share data
use Thread::Queue; # a thread-safe shared queue!
#
# verify threads are available
#
die 'Perl not built with threads'
unless $Config{useithreads};
#
# open a connection in main thread
#
my $maindbh = DBI->connect('dbi:Sponge:', '','', {
PrintError => 1,
RaiseError => 0,
AutoCommit => 1
}) || die DBI->errstr;
#
# now spawn a thread that opens a connection
#
my $queue = Thread::Queue->new();
push @thrds, threads->create(\&child_thread, $queue)
foreach (1..2);
$queue->enqueue('go') foreach (1..2);
#
# wait for completion
#
$_->join foreach (@thrds);
#
# now spawn again
#
@thrds = ();
print "Spawning again\n";
push @thrds, threads->create(\&child_thread, $queue)
foreach (1..2);
$queue->enqueue('go') foreach (1..2);
#
# wait for completion
#
$_->join foreach (@thrds);
$maindbh->disconnect;
print "Test completed\n";
sub child_thread {
my ($queue) = @_;
$queue->dequeue();
my $dbh = DBI->connect('dbi:Sponge:', '', '', {
PrintError => 1,
RaiseError => 0,
AutoCommit => 1
}) || die DBI->errstr;
print "Child: connected and exitting\n";
$dbh->disconnect;
}
Dean Arnold
Presicient Corp.
www.presicient.com
