note
Ryszard
Thanks to everyone who has replied. After a nights rest and fresh eyes, i've found what is causing the problem.
<p>a difference in the DBhandler module i'm using to the one posted here is the ability for it to use multiple dbd's. i've added support for both oracle and mysql.</p>
<p>the $self reference that holds the <i>actual</i> db reference becomes <code>$self->{_db_handle}{$arg{engine}}{$arg{handle}}</code>.</p>
<p>when i've gone about disconnecting the database connection in the destructor i've ommited the engine variable.</p>
<p>if i perform an explicit disconnect in the DESTROY method, <i>correctly</i> the database connection is dropped when the object goes out of scope (ie with a delete or an undef. the reverse is also true, if you dont perform an explicit disconnect when the object goes out of scope, the database connection remains, which i think could be considered a bug in the DBI/DBD/perl/whatever.</p>
<p>to those who have spent their valuable time on this, i apologise, i've lead you down the garden path, making reference to code that is different to what i've been actually using. lesson learnt.</p>
<p>to those who would like to have a crack at reproducing the bug, this is what i used below.</p>
<code>
#!/usr/local/bin/perl -w
use Daemon;
my $app = Daemon->new();
while (1) {
$app->do_something();
print scalar(localtime)." Sleeping 5 seconds...\n";
sleep 5;
}
-------8<--------------------------------
package Daemon;
use Data::Dumper;
use Handle;
{
sub _createConnection {
my $self = shift;
my %args = @_;
my $retval;
$self->{dbo} = Handle->new( handle => 'handle', user => 'jwilliams', pwd => 'type895', sid => 'ossp1',) if (! $self->{dbo} );
}
}
sub new {
my ($caller, %arg) = @_;
my $caller_is_obj = ref($caller);
my $class = $caller_is_obj || $caller;
my $self = bless {}, $class;
return $self;
}
sub do_something {
my $self = shift;
my %args = @_;
$self->_createConnection();
undef $self->{dbo};
return 'status message';
}
1
-------8<--------------------------------
package Handle;
use Data::Dumper;
$VERSION = 1.00;
use strict;
use DBI;
use Carp;
use Hook::LexWrap;
{
sub _get_db_handle {
my ($self, %args) = @_;
croak "Must supply username" unless ($args{user});
croak "Must supply password" unless ($args{pwd});
croak "Must supply SID" unless ($args{sid});
my $dsn = "DBI:Oracle:".$args{sid}; #set the dataset name
my %attr = ( RaiseError => 1, PrintError => 0, AutoCommit => 1 || $self->{_AutoCommit} ); #set error raising and printing
# lets go get the handle
my $handle = DBI->connect($dsn,$args{user},$args{pwd}, \%attr);
$handle->{InactiveDestroy} = 1;
croak "Unable to connect to ".$args{sid} unless ($handle);
return $handle;
}
}
sub new {
my ($caller, %arg) = @_;
my $caller_is_obj = ref($caller);
my $class = $caller_is_obj || $caller;
my $self = bless {}, $class;
$arg{engine} = 'oracle' if (!defined $arg{engine} );
$self->{_db_handle}{$arg{engine}}{$arg{handle}} = $self->_get_db_handle(%arg);
wrap 'DESTROY', pre => \&predestroy, post=> \&postdestroy;
return $self;
}
sub predestroy {
print STDERR "predestroy: ".Dumper(@_);
}
sub postdestroy {
print STDERR "postdestroy: ".Dumper(@_);
}
sub DESTROY {
my $self = shift;
foreach my $handle ( keys %{$self->{_db_handle}{'oracle'}} ) {
# non bug condition, the object is correctly referenced
#$self->{_db_handle}{'oracle'}{$handle}->disconnect;
# bug condition, the object is incorrectly referenced
$self->{_db_handle}{$handle}->disconnect;
}
}
1
-------8<--------------------------------
SQL> l
1 select username, to_char(logon_time, 'dd-mon-yyyy hh24:mi:ss') as logon from v$session
2* where username = '<username>'
SQL>
</code>
635540
635540