Having a runnable test case that didn't require spending hours trying to get stuff installed helped clarify the described problem.
The basic problem is that the DBIx::Simple object [returned from dbs()] gets destroyed after the DBIx::Simple::Statement object is created [and returned by query()] but before it can be used.
It wasn't, as I initially misunderstood, that the DBIx::Simple::Statement object is actually being DESTROYed before it can be used.
DBIx::Simple goes to some significant lengths to make all DBIx::Simple::Statement objects suddenly become unusable as soon as their parent DBIx::Simple object is destroyed.
I don't pretend to know why this strange lifecycle interplay is implemented or even whether or not it is a good idea.
But thwarting that part of the module design by inducing circular references such that things just never get destroyed is not what I would call a "bug fix", nor "wise".
Here is an abbreviated summary of the differences between runs of your test cases with one I added with and without the "fix" of not quoting $self (matching lines are prefixed with "=" to aid comparison):
=Starting CASE 1
=...
'db' => 'DBIx::Simple=...',
=...
=Hashes? $VAR1 = [];
=ok 1 - object isa DBIx::Simple::Statement
=Destroying DBIx::Simple::Result
=Destroying DBIx::Simple::Result
=Destroying DBIx::Simple::DeadObject
=Destroying DBIx::Simple::DeadObject
Destroying DBIx::Simple
Destroying DBIx::Simple::Statement
Destroying DBIx::Simple::DeadObject
=Starting CASE 2
=...
'db' => 'DBIx::Simple=...',
=...
=Hashes? $VAR1 = [];
=ok 2 - object isa DBIx::Simple::Statement
=Destroying DBIx::Simple::Result
=Destroying DBIx::Simple::Result
=Destroying DBIx::Simple::DeadObject
=Destroying DBIx::Simple::DeadObject
Destroying DBIx::Simple
Destroying DBIx::Simple::Statement
Destroying DBIx::Simple::DeadObject
=Starting CASE 3
Destroying DBIx::Simple
Destroying DBIx::Simple::Statement
not ok 3 - object isa ...
# Failed test ...
=Destroying DBIx::Simple::Result 1
(only one Result got created?)
=Destroying DBIx::Simple::DeadObject 1
(only one DeadObject got created?)
=Starting CASE 4
=...
'db' => 'DBIx::Simple=...',
=...
Destroying DBIx::Simple
Destroying DBIx::Simple::Statement
Destroying DBIx::Simple::Result
Destroying DBIx::Simple::DeadObject
Result object no longer usable
(no output)
(not even failed test report)
(destroyed above)
(only one Result created?)
(destroyed above)
=Destroying DBIx::Simple::DeadObject 2
=# Tests were run but no plan ...
=(global destruction begins)
(destroyed above)
(destroyed above)
(destroyed above)
(destroyed above)
(destroyed above)
(destroyed above)
(destroyed above)
(destroyed above)
(destroyed above)
(destroyed above)
(destroyed above)
(destroyed above)
(destroyed above)
| =Starting CASE 1
=...
'db' => bless( { ...
=...
=Hashes? $VAR1 = [];
=ok 1 - object isa DBIx::Simple::Statement
=Destroying DBIx::Simple::Result
=Destroying DBIx::Simple::Result
=Destroying DBIx::Simple::DeadObject
=Destroying DBIx::Simple::DeadObject
(not destroyed yet)
(not destroyed yet)
(not destroyed yet)
=Starting CASE 2
=...
'db' => bless( { ...
=...
=Hashes? $VAR1 = [];
=ok 2 - object isa DBIx::Simple::Statement
=Destroying DBIx::Simple::Result
=Destroying DBIx::Simple::Result
=Destroying DBIx::Simple::DeadObject
=Destroying DBIx::Simple::DeadObject
(not destroyed yet)
(not destroyed yet)
(not destroyed yet)
=Starting CASE 3
(not destroyed yet)
(not destroyed yet)
ok 3 - object isa DBIx::Simple::Statement
(doesn't fail)
=Destroying DBIx::Simple::Result 1
Destroying DBIx::Simple::Result 2
=Destroying DBIx::Simple::DeadObject 1
Destroying DBIx::Simple::DeadObject 2
=Starting CASE 4
=...
'db' => bless( { ...
=...
(not destroyed yet)
(not destroyed yet)
(not destroyed yet)
(not destroyed yet)
(object still usable)
Hashes? $VAR1 = [];
ok 4 - object isa DBIx::Simple::Statement
Destroying DBIx::Simple::Result
Destroying DBIx::Simple::Result
Destroying DBIx::Simple::DeadObject
=Destroying DBIx::Simple::DeadObject 2
=# Tests were run but no plan ...
=(global destruction begins)
Destroying DBIx::Simple
Destroying DBIx::Simple::Statement
Destroying DBIx::Simple::DeadObject
Destroying DBIx::Simple
Destroying DBIx::Simple::Statement
Destroying DBIx::Simple::DeadObject
Destroying DBIx::Simple::Statement
Destroying DBIx::Simple::Statement
Destroying DBIx::Simple
Destroying DBIx::Simple::DeadObject
Destroying DBIx::Simple
Destroying DBIx::Simple::Statement
Destroying DBIx::Simple::DeadObject
|
Which shows that the 'fix' does indeed prevent a bunch of stuff from being cleaned up until Perl's "global destruction".
Here is my modified test code. The modifications I made to DBIx::Simple are left as a trivial exercise for the reader:
# use Devel::SimpleTrace;
{
package Util;
sub dbconnect {
use DBI;
DBI->connect('dbi:SQLite:temp.db');
}
}
{
package Local::DBIx::Simple::Q;
use Moo;
has 'q' => ( is => 'rw', default => sub { $main::backgroundqueue }
+ );
has 'standard' => ( is => 'rw', default => sub { 0 } );
use Data::Dumper;
sub BUILD {
my ($self) = @_;
$main::globalstandardconnection = $self->standard
}
sub enq {
my ( $self, @arg ) = @_;
warn sprintf "Enqueing with id %d this data: %s", $self->enq_i
+d,
Dumper( \@arg );
$self->q->enqueue( [ $self->enq_id, @arg ] );
}
}
{
package Local::DBIx::Simple;
use Moo;
extends qw(Local::DBIx::Simple::Q);
use DBIx::Simple;
has 'enq_id' => ( is => 'rw', default => sub { 5 } );
has 'deq_id' => ( is => 'rw', default => sub { 6 } );
sub dbh {
Util::dbconnect;
}
sub dbs {
my ($self) = @_;
my $dbs = DBIx::Simple->connect( $self->dbh );
}
}
{
package main;
use strict;
use warnings;
use Data::Dumper;
use Test::More;
use lib 'lib';
sub constructor {
Local::DBIx::Simple->new( standard => 0 );
}
sub create_database {
my ($dbh) = @_;
my $ddl = <<'EODDL';
create table table_one (
col1 integer not null primary key,
col2 TEXT
)
EODDL
$dbh->do($ddl);
}
sub main {
my $dbh = Util::dbconnect;
create_database($dbh);
my $Q = "SELECT * FROM table_one";
my $desired_class = 'DBIx::Simple::Statement';
my $desired_desc = "object isa $desired_class";
warn "Starting CASE 1";
{ # CASE 1 - successful
my $s = constructor;
my $dbs = DBIx::Simple->connect( $s->dbh );
my $r = $dbs->query($Q);
warn sprintf 'Result of DBIx::Simple query: %s', Dumper($r
+);
my $h = $r->hashes;
warn sprintf 'Hashes? %s', Dumper($h);
ok( $r->{st}->isa($desired_class), $desired_desc );
}
warn "Starting CASE 2";
{ # CASE 2 - successful
my $s = constructor;
my $dbs = $s->dbs;
my $r = $dbs->query($Q);
warn sprintf 'Result of DBIx::Simple-from-Local query: %s'
+,
Dumper($r);
my $h = $r->hashes;
warn sprintf 'Hashes? %s', Dumper($h);
ok( $r->{st}->isa($desired_class), $desired_desc );
}
warn "Starting CASE 3";
{ # CASE 3 - *FAILS* when $self is quoted on line 165
my $s = constructor;
my $r = $s->dbs->query($Q);
ok( $r->{st}->isa($desired_class), $desired_desc );
}
warn "Starting CASE 4";
{ # CASE 4 - also fails
my $s = constructor;
my $r;
{
my $dbs = $s->dbs;
$r = $dbs->query($Q);
warn sprintf 'Result of DBIx::Simple-from-Local query:
+ %s',
Dumper($r);
}
my $h = $r->hashes;
warn sprintf 'Hashes? %s', Dumper($h);
ok( $r->{st}->isa($desired_class), $desired_desc );
}
}
}
main() unless caller;
1;
The test case I added makes it clearer how the lifecycle interplay designed into the module is violated:
warn "Starting CASE 4";
{ # CASE 4 - also fails
my $s = constructor;
my $r;
{
my $dbs = $s->dbs;
$r = $dbs->query($Q);
warn sprintf 'Result of DBIx::Simple-from-Local query:
+ %s',
Dumper($r);
}
my $h = $r->hashes;
warn sprintf 'Hashes? %s', Dumper($h);
ok( $r->{st}->isa($desired_class), $desired_desc );
}