1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
|
#!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;
}
plan tests => 16;
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;
push(@lines,
sprintf "%sh %s %s\n", $h->{Type}, "\t" x $level, $h);
show_child_handles($_, $level + 1)
for (grep { defined } @{$h->{ChildHandles}});
}
my $drh = $dbh->{Driver};
show_child_handles($drh, 0);
print @lines[0..4];
is scalar @lines, $sth_count + 2;
like $lines[0], qr/^drh/;
like $lines[1], qr/^dbh/;
like $lines[2], qr/^sth/;
}
my $handles = $dbh->{ChildHandles};
my @live = grep { defined $_ } @$handles;
is scalar @live, 0, "handles should be gone now";
# test visit_child_handles
{
my $info;
my $visitor = sub {
my ($h, $info) = @_;
my $type = $h->{Type};
++$info->{ $type }{ ($type eq 'st') ? $h->{Statement} : $h->{Name} };
return $info;
};
DBI->visit_handles($visitor, $info = {});
is_deeply $info, {
'dr' => {
'ExampleP' => 1,
($using_dbd_gofer) ? (Gofer => 1) : ()
},
'db' => { '' => 1 },
};
my $sth1 = $dbh->prepare('SELECT name FROM t');
my $sth2 = $dbh->prepare('SELECT name FROM t');
DBI->visit_handles($visitor, $info = {});
is_deeply $info, {
'dr' => {
'ExampleP' => 1,
($using_dbd_gofer) ? (Gofer => 1) : ()
},
'db' => { '' => 1 },
'st' => { 'SELECT name FROM t' => 2 }
};
}
# test that the childhandle array does not grow uncontrollably
SKIP: {
skip "slow tests avoided when using DBD::Gofer", 2 if $using_dbd_gofer;
for (1 .. 1000) {
my $sth = $dbh->prepare('SELECT name FROM t');
}
my $handles = $dbh->{ChildHandles};
cmp_ok scalar @$handles, '<', 1000;
my @live = grep { defined } @$handles;
is scalar @live, 0;
}
1;
|
