view release on metacpan or  search on metacpan

t/72childhandles.t  view on Meta::CPAN

#!perl -w
$|=1;

use strict;

#
# test script for the ChildHandles attribute
#

use DBI;

use Test::More;

my $HAS_WEAKEN = eval {
    require Scalar::Util;
    # this will croak() if this Scalar::Util doesn't have a working weaken().
    Scalar::Util::weaken( my $test = [] ); # same test as in DBI.pm
    1;
};
if (!$HAS_WEAKEN) {
    chomp $@;
    print "1..0 # Skipped: Scalar::Util::weaken not available ($@)\n";
    exit 0;
}

my $using_dbd_gofer = ($ENV{DBI_AUTOPROXY}||'') =~ /^dbi:Gofer.*transport=/i;

my $drh;

{
    # make 10 connections
    my @dbh;
    for (1 .. 10) {
        my $dbh = DBI->connect("dbi:ExampleP:", '', '', { RaiseError=>1 });
        push @dbh, $dbh;
    }
    
    # get the driver handle
    $drh = $dbh[0]->{Driver};
    ok $drh;

    # get the kids, should be the same list of connections
    my $db_handles = $drh->{ChildHandles};
    is ref $db_handles, 'ARRAY';
    is scalar @$db_handles, scalar @dbh;

    # make sure all the handles are there
    my $found = 0;
    foreach my $h (@dbh) {
        ++$found if grep { $h == $_ } @$db_handles;
    }
    is $found, scalar @dbh;
}

# now all the out-of-scope DB handles should be gone
{
    my $handles = $drh->{ChildHandles};
    my @db_handles = grep { defined } @$handles;
    is scalar @db_handles, 0, "All handles should be undef now";
}

my $dbh = DBI->connect("dbi:ExampleP:", '', '', { RaiseError=>1 });

my $empty = $dbh->{ChildHandles};
is_deeply $empty, [], "ChildHandles should be an array-ref if wekref is available";

# test child handles for statement handles
{
    my @sth;
    my $sth_count = 20;
    for (1 .. $sth_count) {
        my $sth = $dbh->prepare('SELECT name FROM t');
        push @sth, $sth;
    }
    my $handles = $dbh->{ChildHandles};
    is scalar @$handles, scalar @sth;

    # test a recursive walk like the one in the docs
    my @lines;
    sub show_child_handles {
        my ($h, $level) = @_;
        $level ||= 0;