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
|
#!perl -w
# Make sure we can connect and disconnect cleanly
# All tests are stopped if we cannot make the first connect
use Test::More;
use DBI;
use strict;
select((select(STDERR),$|=1)[0]);
$|=1;
if (defined $ENV{DBI_DSN}) {
plan tests => 8;
} else {
plan skip_all => 'Cannot run test unless DBI_DSN is defined. See the README file.';
}
## Define this here in case we get to the END block before a connection is made.
my ($pgversion,$pglibversion,$pgvstring,$pgdefport) = ('?','?','?','?');
# Trapping a connection error can be tricky, but we only have to do it
# this thoroughly one time. We are trapping two classes of errors:
# the first is when we truly do not connect, usually a bad DBI_DSN;
# the second is an invalid login, usually a bad DBI_USER or DBI_PASS
my $dbh;
eval {
$dbh = DBI->connect($ENV{DBI_DSN}, $ENV{DBI_USER}, $ENV{DBI_PASS},
{RaiseError => 1, PrintError => 0, AutoCommit => 0});
};
if ($@) {
if (! $DBI::errstr) {
print STDOUT "Bail out! Could not connect: $@\n";
}
else {
print STDOUT "Bail out! Could not connect: $DBI::errstr\n";
}
exit; # Force a hasty exit
}
pass('Established a connection to the database');
$pgversion = $dbh->{pg_server_version};
$pglibversion = $dbh->{pg_lib_version};
$pgdefport = $dbh->{pg_default_port};
$pgvstring = $dbh->selectall_arrayref("SELECT VERSION();")->[0][0];
ok( $dbh->disconnect(), 'Disconnect from the database');
# Connect two times. From this point onward, do a simpler connection check
ok( $dbh = DBI->connect($ENV{DBI_DSN}, $ENV{DBI_USER}, $ENV{DBI_PASS},
{RaiseError => 1, PrintError => 0, AutoCommit => 0}),
'Connected with first database handle');
my $dbh2;
ok( $dbh2 = DBI->connect($ENV{DBI_DSN}, $ENV{DBI_USER}, $ENV{DBI_PASS},
{RaiseError => 1, PrintError => 0, AutoCommit => 0}),
'Connected with second database handle');
my $sth = $dbh->prepare('SELECT 123');
ok ( $dbh->disconnect(), 'Disconnect with first database handle');
ok ( $dbh2->disconnect(), 'Disconnect with second database handle');
ok ( $dbh2->disconnect(), 'Disconnect again with second database handle');
eval {
$sth->execute();
};
ok( $@, 'Execute fails on a disconnected statement');
END {
my $pv = sprintf("%vd", $^V);
my $schema = exists $ENV{DBD_SCHEMA} ?
"\nDBD_SCHEMA $ENV{DBD_SCHEMA}" : '';
diag
"\nProgram Version\n".
"Perl $pv ($^O)\n".
"DBD::Pg $DBD::Pg::VERSION\n".
"PostgreSQL (compiled) $pglibversion\n".
"PostgreSQL (target) $pgversion\n".
"PostgreSQL (reported) $pgvstring\n".
"Default port $pgdefport\n".
"DBI $DBI::VERSION\n".
"DBI_DSN $ENV{DBI_DSN}$schema\n";
}
|
