Author: turnstep
Date: Sun Apr 27 11:45:16 2008
New Revision: 11143
Modified:
DBD-Pg/trunk/Changes
DBD-Pg/trunk/MANIFEST.SKIP
DBD-Pg/trunk/Makefile.PL
DBD-Pg/trunk/README
DBD-Pg/trunk/TODO
DBD-Pg/trunk/t/01connect.t
DBD-Pg/trunk/t/02attribs.t
DBD-Pg/trunk/t/04misc.t
DBD-Pg/trunk/t/99cleanup.t
DBD-Pg/trunk/t/dbdpg_test_setup.pl
Log:
Create our own database cluster if we can't get a valid connection.
Modified: DBD-Pg/trunk/Changes
==============================================================================
--- DBD-Pg/trunk/Changes (original)
+++ DBD-Pg/trunk/Changes Sun Apr 27 11:45:16 2008
@@ -1,5 +1,10 @@
('GSM' is Greg Sabino Mullane, [EMAIL PROTECTED])
+2.6.2
+
+ - Allow 'make test' create a test database from scratch if
+ if it can't find an existing one to use. [GSM]
+
2.6.1 Released April 22, 2008 (subversion r11133)
- Don't free placeholder section, fixes problem when using
Modified: DBD-Pg/trunk/MANIFEST.SKIP
==============================================================================
--- DBD-Pg/trunk/MANIFEST.SKIP (original)
+++ DBD-Pg/trunk/MANIFEST.SKIP Sun Apr 27 11:45:16 2008
@@ -20,3 +20,5 @@
\.blame$
^tmp/*
cover_db/
+README.testdatabase
+dbdpg_test_database/*
Modified: DBD-Pg/trunk/Makefile.PL
==============================================================================
--- DBD-Pg/trunk/Makefile.PL (original)
+++ DBD-Pg/trunk/Makefile.PL Sun Apr 27 11:45:16 2008
@@ -188,7 +188,7 @@
PERL_MALLOC_OK => 1,
NEEDS_LINKING => 1,
NO_META => 1,
- clean => { FILES => 'trace Pg.xsi' },
+ clean => { FILES => 'trace Pg.xsi README.testdatabase' },
);
if ($os eq 'hpux') {
Modified: DBD-Pg/trunk/README
==============================================================================
--- DBD-Pg/trunk/README (original)
+++ DBD-Pg/trunk/README Sun Apr 27 11:45:16 2008
@@ -112,6 +112,10 @@
DBI_DSN='dbi:Pg:dbname="<data;base>"'
+If no valid connection is found, the tests will use the "initdb"
+program to try and create a Postgres database cluster to test with.
+The first available port starting at 5440 will be used.
+
You can increase the verbosity of the tests by setting the
environment variable TEST_VERBOSE. You can also enable tracing
within the tests themselves by setting DBD_TRACE to whatever
Modified: DBD-Pg/trunk/TODO
==============================================================================
--- DBD-Pg/trunk/TODO (original)
+++ DBD-Pg/trunk/TODO Sun Apr 27 11:45:16 2008
@@ -14,5 +14,3 @@
- Remove libpq dependency
- Handle and/or better tests for different encoding, especially those not
supported as a server encoding (e.g. BIG5)
-- Be more aggressive and finding or creating a database for
- complete testing.
Modified: DBD-Pg/trunk/t/01connect.t
==============================================================================
--- DBD-Pg/trunk/t/01connect.t (original)
+++ DBD-Pg/trunk/t/01connect.t Sun Apr 27 11:45:16 2008
@@ -20,15 +20,10 @@
($helpconnect,$connerror,$dbh) = connect_database();
-if (! defined $dbh) {
+if (! defined $dbh or $connerror) {
plan skip_all => 'Connection to database failed, cannot continue
testing';
}
-plan tests => 15;
-
-# 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
+plan tests => 13;
my ($t);
@@ -77,44 +72,28 @@
}
$t=q{Connect with invalid option fails};
- my $oldname = $1;
- (my $dbi = $ENV{DBI_DSN}) =~ s/$alias\s*=/dbbarf=/;
- eval {
- $dbh = DBI->connect($dbi, $ENV{DBI_USER}, $ENV{DBI_PASS},
{RaiseError=>1});
- };
- like ($@, qr{DBI connect.+failed:}, $t);
+ my $err;
+ (undef,$err,$dbh) = connect_database({ dbreplace => 'dbbarf' });
+ like ($err, qr{DBI connect.+failed:}, $t);
+
for my $opt (qw/db dbname database/) {
$t=qq{Connect using string '$opt' works};
- ($dbi = $ENV{DBI_DSN}) =~ s/$alias\s*=/$opt=/;
- eval {
- $dbh = DBI->connect($dbi, $ENV{DBI_USER},
$ENV{DBI_PASS}, {RaiseError=>1});
- };
- is($@, q{}, $t);
+ $dbh and $dbh->disconnect();
+ (undef,$err,$dbh) = connect_database({dbreplace => $opt});
+ is($err, '', $t);
}
if ($ENV{DBI_DSN} =~ /$alias\s*=\s*\"/) {
skip 'DBI_DSN already contains quoted database, no need for
explicit test', 1;
}
$t=q{Connect using a quoted database argument};
- ($dbi = $ENV{DBI_DSN}) =~ s/$alias\s*=(\w+)/'db="'.lc $2.'"'/e;
eval {
- $dbh = DBI->connect($dbi, $ENV{DBI_USER}, $ENV{DBI_PASS},
{RaiseError=>1});
+ $dbh and $dbh->disconnect();
+ (undef,$err,$dbh) = connect_database({dbquotes => 1});
};
is($@, q{}, $t);
}
-$t=q{Connect with an undefined user picks up $ENV{DBI_USER}};
-eval {
- $dbh = DBI->connect($ENV{DBI_DSN}, undef, $ENV{DBI_PASS},
{RaiseError=>1});
-};
-is($@, q{}, $t);
-
-$t=q{Connect with an undefined password picks up $ENV{DBI_PASS}};
-eval {
- $dbh = DBI->connect($ENV{DBI_DSN}, $ENV{DBI_USER}, undef,
{RaiseError=>1});
-};
-is($@, q{}, $t);
-
END {
my $pv = sprintf('%vd', $^V);
my $schema = 'dbd_pg_testschema';
@@ -150,9 +129,12 @@
if ($helpconnect & 4) {
$extra .= 'DBI_USER';
}
+ if ($helpconnect & 16) {
+ $extra .= 'initdb';
+ }
}
- if (defined $connerror) {
+ if (defined $connerror and length $connerror) {
$connerror =~ s/.+?failed: //;
$connerror =~ s{\n at t/dbdpg.*}{}m;
$extra .= "\nError was: $connerror";
Modified: DBD-Pg/trunk/t/02attribs.t
==============================================================================
--- DBD-Pg/trunk/t/02attribs.t (original)
+++ DBD-Pg/trunk/t/02attribs.t Sun Apr 27 11:45:16 2008
@@ -11,7 +11,7 @@
require 'dbdpg_test_setup.pl';
select(($|=1,select(STDERR),$|=1)[1]);
-my $dbh = connect_database();
+my ($helpconnect,$connerror,$dbh) = connect_database();
if (! defined $dbh) {
plan skip_all => 'Connection to database failed, cannot continue
testing';
@@ -92,6 +92,11 @@
my ($attrib,$SQL,$sth,$warning,$result,$expected);
+# Get the DSN and user from the test file, if it exists
+my ($testdsn, $testuser) = get_test_settings();
+
+
+
#
# Test of the database handle attribute "Statement"
#
@@ -177,16 +182,15 @@
#
SKIP: {
- if (!exists $ENV{DBI_DSN} or $ENV{DBI_DSN} !~ /^dbi:Pg:(.+)$/) {
- skip q{Cannot test DB handle attribute "Name": invalid
DBI_DSN}, 1;
- }
- else {
- $expected = $1 || $ENV{PGDATABASE};
- defined $expected and length $expected or skip 'Cannot test
unless database name known', 1;
- $attrib = $dbh->{Name};
- $expected =~ s/(db|database)=/dbname=/;
- is( $attrib, $expected, 'DB handle attribute "Name" returns
same value as DBI_DSN');
+
+ if (! length $testdsn or $testdsn !~ /^dbi:Pg:(.+)/) {
+ skip q{Cannot test DB handle attribute "Name" invalid DBI_DSN},
1;
}
+ $expected = $1 || $ENV{PGDATABASE};
+ defined $expected and length $expected or skip 'Cannot test unless
database name known', 1;
+ $attrib = $dbh->{Name};
+ $expected =~ s/(db|database)=/dbname=/;
+ is( $attrib, $expected, 'DB handle attribute "Name" returns same value
as DBI_DSN');
}
#
@@ -204,7 +208,7 @@
#
$attrib = $dbh->{Username};
-is( $attrib, $ENV{DBI_USER}, 'DB handle attribute "Username" returns the same
value as DBI_USER');
+is( $attrib, $testuser, 'DB handle attribute "Username" returns the same value
as DBI_USER');
#
# Test of the "PrintWarn" database handle attribute
Modified: DBD-Pg/trunk/t/04misc.t
==============================================================================
--- DBD-Pg/trunk/t/04misc.t (original)
+++ DBD-Pg/trunk/t/04misc.t Sun Apr 27 11:45:16 2008
@@ -5,6 +5,7 @@
use strict;
use warnings;
use Test::More;
+use Data::Dumper;
use DBI;
use DBD::Pg;
use lib 't','.';
@@ -267,7 +268,12 @@
};
is( $@, q{}, 'The data_sources() method did not throw an exception');
-is( grep (/^dbi:Pg:dbname=template1$/, @result), '1', 'The data_sources()
method returns a template1 listing');
+if (! defined $result[0]) {
+ fail 'The data_sources() method returned an empty list';
+}
+else {
+ is( grep (/^dbi:Pg:dbname=template1$/, @result), '1', 'The
data_sources() method returns a template1 listing');
+}
$t=q{The data_sources() returns undef when fed a bogus second argument};
@result = DBI->data_sources('Pg','foobar');
Modified: DBD-Pg/trunk/t/99cleanup.t
==============================================================================
--- DBD-Pg/trunk/t/99cleanup.t (original)
+++ DBD-Pg/trunk/t/99cleanup.t Sun Apr 27 11:45:16 2008
@@ -1,23 +1,28 @@
#!perl
## Cleanup all database objects we may have created
+## Shutdown the test database if we created one
use strict;
use warnings;
-use Test::More;
+use Test::More tests => 1;
use lib 't','.';
require 'dbdpg_test_setup.pl';
select(($|=1,select(STDERR),$|=1)[1]);
-my $dbh = connect_database({nosetup => 1});
+my $dbh = connect_database({nosetup => 1, nocreate => 1});
-if (! defined $dbh) {
- plan skip_all => 'Connection to database failed, cannot continue
testing';
+SKIP: {
+ if (! defined $dbh) {
+ skip 'Connection to database failed, cannot cleanup', 1;
+ }
+
+ isnt( $dbh, undef, 'Connect to database for cleanup');
+
+ cleanup_database($dbh);
}
-plan tests => 1;
-isnt( $dbh, undef, 'Connect to database for cleanup');
+shutdown_test_database();
-cleanup_database($dbh);
$dbh->disconnect() if defined $dbh and ref $dbh;
Modified: DBD-Pg/trunk/t/dbdpg_test_setup.pl
==============================================================================
--- DBD-Pg/trunk/t/dbdpg_test_setup.pl (original)
+++ DBD-Pg/trunk/t/dbdpg_test_setup.pl Sun Apr 27 11:45:16 2008
@@ -32,8 +32,16 @@
'dbd_pg_testschema2.dbd_pg_testsequence3',
);
+## Schema used for testing:
my $S = 'dbd_pg_testschema';
+## File written so we don't have to retry connections:
+my $helpfile = 'README.testdatabase';
+
+## If we create our own cluster, store it here:
+my $test_database_dir = 'dbdpg_test_database';
+
+
sub connect_database {
## Connect to the database (unless 'dbh' is passed in)
@@ -42,59 +50,321 @@
## 1. helpconnect for use by 01connect.t
## 2. Any error generated
## 3. The database handle, or undef
- ## The returned handle has AutoCommit=0 (unless AutoCommit is passed in)
my $arg = shift || {};
ref $arg and ref $arg eq 'HASH' or die qq{Need a hashref!\n};
my $dbh = $arg->{dbh} || '';
+ my $alias = qr{(database|db|dbname)};
+ my $info;
- my $helpconnect = 0;
- if (!defined $ENV{DBI_DSN}) {
- $helpconnect = 1;
- $ENV{DBI_DSN} = 'dbi:Pg:';
+ ## We'll try various ways to get to a database to test with
+
+ ## First, check to see if we've been here before and left directions
+ my ($testdsn,$testuser,$helpconnect,$su,$testdir) = get_test_settings();
+
+ ## Did we fail last time? Fail this time too, but quicker!
+ if ($testdsn =~ /FAIL!/) {
+ return $helpconnect, 'Previous failure', undef;
}
- if (!$dbh) {
+ ## Got a working DSN? Give it an attempt
+ if ($testdsn and $testuser) {
+
+ ## Used by t/01connect.t
+ if ($arg->{dbreplace}) {
+ $testdsn =~ s/$alias\s*=/$arg->{dbreplace}=/;
+ }
+ if ($arg->{dbquotes}) {
+ $testdsn =~ s/$alias\s*=(\w+)/'db="'.lc $2.'"'/e;
+ }
eval {
- $dbh = DBI->connect($ENV{DBI_DSN}, $ENV{DBI_USER},
$ENV{DBI_PASS},
+ $dbh = DBI->connect($testdsn, $testuser, '',
{RaiseError =>
1, PrintError => 0, AutoCommit => 1});
};
if ($@) {
- return $helpconnect, $@, undef if $@ !~ /FATAL/ or
defined $ENV{DBI_USER};
- ## Try one more time as postgres user (and possibly
database)
+ if ($@ !~ /domain socket/ or 16 != $helpconnect) {
+ return $helpconnect, $@, undef;
+ }
+
+ ## If we created it, and it was shut down, start it up
again
+ warn "Restarting test database $testdsn at $testdir\n";
+
+ my $COM = qq{pg_ctl -l $testdir/dbdpg_test.logfile -D
$testdir start};
+ if ($su) {
+ $COM = qq{su -l $su -c "$COM"};
+ }
+ $info = '';
+ eval { $info = qx{$COM}; };
+ if ($@ or $info !~ /\w/) {
+ $@ = "Could not startup new database ($@)
($info)";
+ return $helpconnect, $@, undef;
+ }
+ ## Wait for it to startup and verify the connection
+ sleep 1;
+ my $loop = 1;
+ STARTUP: {
+ eval {
+ $dbh = DBI->connect($testdsn,
$testuser, '',
+
{RaiseError => 1, PrintError => 0, AutoCommit => 1});
+ };
+ if ($@ =~ /starting up/ or $@ =~ /PGSQL\.\d+/) {
+ if ($loop++ < 20) {
+ sleep 1;
+ redo STARTUP;
+ }
+ }
+ }
+
+ if ($@) {
+ return $helpconnect, $@, $dbh;
+ }
+
+ } ## end got an error on connect attempt
+
+ ## We've got a good connection, so do final tweaks and return
+ goto GOTDBH;
+
+ } ## end got testdsn and testuser
+
+ ## No previous info, so start connection attempt from scratch
+
+ $testdsn ||= $ENV{DBI_DSN};
+ $testuser ||= $ENV{DBI_USER};
+
+ if (! $testdsn) {
+ $helpconnect = 1;
+ $testdsn = 'dbi:Pg:';
+ }
+ if (! $testuser) {
+ $testuser = 'postgres';
+ }
+
+ ## From here on out, we don't return directly, but save it first
+ GETHANDLE: {
+ eval {
+ $dbh = DBI->connect($testdsn, $testuser, $ENV{DBI_PASS},
+ {RaiseError =>
1, PrintError => 0, AutoCommit => 1});
+ };
+ last GETHANDLE if ! $@;
+
+ ## If the error was because of the user, try a few others
+ if ($@ =~ /postgres/) {
+
if ($helpconnect) {
- $ENV{DBI_DSN} .= 'dbname=postgres';
+ $testdsn .= 'dbname=postgres';
$helpconnect += 2;
}
$helpconnect += 4;
- $ENV{DBI_USER} = $^O =~
+ $testuser = $^O =~
/openbsd/ ? '_postgresql'
: $^O =~ /bsd/i ? 'pgsql'
: 'postgres';
eval {
- $dbh = DBI->connect($ENV{DBI_DSN},
$ENV{DBI_USER}, $ENV{DBI_PASS},
+ $dbh = DBI->connect($testdsn, $testuser,
$ENV{DBI_PASS},
{RaiseError => 1, PrintError => 0, AutoCommit => 1});
};
+ last GETHANDLE if ! $@;
+
+ ## Final user tweak: set to postgres for Beastie
+ if ($testuser ne 'postgres') {
+ $helpconnect += 8;
+ $testuser = 'postgres';
+ ## XXX Same as above - don't check unless user
was problem
+ eval {
+ $dbh = DBI->connect($testdsn,
$testuser, $ENV{DBI_PASS},
+
{RaiseError => 1, PrintError => 0, AutoCommit => 1});
+ };
+ last GETHANDLE if ! $@;
+ }
+ }
+
+ ## Cannot connect to an existing database, so we'll create our
own
+ if ($arg->{nocreate}) {
+ return $helpconnect, '', undef;
+ }
+
+ my ($info,$testport);
+ $helpconnect = 16;
+
+ ## Do we have initdb available?
+ $info = '';
+ eval {
+ $info = qx{initdb --help};
+ };
+ last GETHANDLE if $@;
+
+ if ($info !~ /[EMAIL PROTECTED]/) {
+ $@ = 'Bad initdb output';
+ last GETHANDLE;
+ }
+
+ ## initdb seems to be available, let's use it to create a new
cluster
+ warn "Please wait, creating new database for testing\n";
+ $info = '';
+ eval {
+ $info = qx{initdb -D $test_database_dir 2>&1};
+ };
+ last GETHANDLE if $@;
+
+ if ($info =~ /FATAL/) {
+ $@ = "initdb gave a FATAL error: $info";
+ last GETHANDLE;
+ }
+
+ ## initdb and pg_ctl cannot be run as root, so let's handle that
+ if ($info =~ /run as root/) {
+ eval {
+ require File::Temp;
+ };
if ($@) {
- ## Try one final time for Beastie
- if ($ENV{DBI_USER} ne 'postgres') {
- $helpconnect += 8;
- $ENV{DBI_USER} = 'postgres';
- eval {
- $dbh =
DBI->connect($ENV{DBI_DSN}, $ENV{DBI_USER}, $ENV{DBI_PASS},
-
{RaiseError => 1, PrintError => 0, AutoCommit => 1});
- };
+ $@ = 'File::Temp required to safely create
non-root-owned test directory';
+ last GETHANDLE;
+ }
+ $test_database_dir =
+ File::Temp::tempdir('dbdpg_testing_XXXXXXX',
CLEANUP => 0, TMPDIR => 1);
+ my $readme = "$test_database_dir/README";
+ if (open my $fh, '>', $readme) {
+ print $fh "This is a test directory for DBD::Pg
and may be removed\n";
+ print $fh "You may want to ensure the
postmaster has been stopped first.\n";
+ print $fh "Check the port in the
postgresql.conf file\n";
+ close $fh;
+ }
+ my $founduser = 0;
+ $su = $testuser = '';
+ for my $user (qw/postgres postgresql pgsql/) {
+ my $uid = (getpwnam $user)[2];
+ next if !defined $uid;
+ next unless chown $uid, -1, $test_database_dir;
+ $su = $user;
+ $founduser++;
+ $info = '';
+ eval {
+ $info = qx{su -l $user -c "initdb -D
$test_database_dir" 2>&1};
+ };
+ if (!$@ and $info =~ /owned by user "$user"/) {
+ $testuser = $user;
+ last;
+ }
+ }
+ if (!$founduser) {
+ $@ = 'Unable to find a user to run initdb as';
+ last GETHANDLE;
+ }
+ if (!$testuser) {
+ $@ = "Failed to run initdb as user $su: $@";
+ last GETHANDLE;
+ }
+ ## At this point, both $su and $testuser are set
+ }
+
+ ## Which user do we connect as?
+ if (!$su and $info =~ /owned by user "(.+?)"/) {
+ $testuser = $1;
+ }
+
+ ## Now we need to find an open port to use
+ $testport = 5442;
+ ## If we've got netstat available, we'll trust that
+ $info = '';
+ eval {
+ $info = qx{netstat -lnx};
+ };
+ if ($@) {
+ warn "netstat call failed, trying port $testport\n";
+ }
+ else {
+ ## Start at 5440 and go up until we are free
+ $testport = 5440;
+ my $maxport = 5470;
+ {
+ last if $info !~ /PGSQL\.$testport$/m;
+ last if ++$testport >= $maxport;
+ redo;
+ }
+ if ($testport >= $maxport) {
+ $@ = "No free ports found for testing: tried
5442 to $maxport\n";
+ last GETHANDLE;
+ }
+ }
+
+ $@ = '';
+ ## Change to this new port and fire it up
+ my $conf = "$test_database_dir/postgresql.conf";
+ my $cfh;
+ if (! open $cfh, '>>', $conf) {
+ $@ = qq{Could not open "$conf": $!};
+ last GETHANDLE;
+ }
+ print $cfh "\n\n## DBD::Pg testing port\nport=$testport\n\n";
+ close $cfh;
+
+ ## Attempt to start up the test server
+ $info = '';
+ my $COM = qq{pg_ctl -l $test_database_dir/dbdpg_test.logfile -D
$test_database_dir start};
+ if ($su) {
+ $COM = qq{su -l $su -c "$COM"};
+ }
+ eval {
+ $info = qx{$COM};
+ };
+ if ($@ or $info !~ /\w/) {
+ $@ = "Could not startup new database ($@) ($info)";
+ last GETHANDLE;
+ }
+
+ ## Attempt to connect to this server
+ sleep 1;
+ $testdsn = "dbi:Pg:dbname=postgres;port=$testport";
+ my $loop = 1;
+ STARTUP: {
+ eval {
+ $dbh = DBI->connect($testdsn, $testuser, '',
+
{RaiseError => 1, PrintError => 0, AutoCommit => 1});
+ };
+ if ($@ =~ /starting up/ or $@ =~ /PGSQL\.$testport/) {
+ if ($loop++ < 20) {
+ sleep 1;
+ redo STARTUP;
}
- return $helpconnect, $@, undef if $@;
}
+ last GETHANDLE;
+ }
+
+ } ## end of GETHANDLE
+
+ ## At this point, we've got a connection, or have failed
+ ## Either way, we record for future runs
+
+ if (open my $fh, '>', $helpfile) {
+ print $fh "## This is a temporary file created for testing
DBD::Pg\n";
+ print $fh "## Created: " . scalar localtime() . "\n";
+ print $fh "## Feel free to remove it!\n";
+ print $fh "## Helpconnect: $helpconnect\n";
+ if ($@) {
+ print $fh "## DSN: FAIL!\n";
+ print $fh "## ERROR: [EMAIL PROTECTED]";
}
+ else {
+ print $fh "## DSN: $testdsn\n";
+ print $fh "## User: $testuser\n";
+ print $fh "## Testdir: $test_database_dir\n" if 16 ==
$helpconnect;
+ print $fh "## Testowner: $su\n" if $su;
+ }
+ close $fh;
}
+
+ GOTDBH:
+ ## This allows things like data_sources() to work if we did an initdb
+ $ENV{DBI_DSN} = $testdsn;
+ $ENV{DBI_USER} = $testuser;
+
if ($arg->{nosetup}) {
- return $helpconnect, undef, $dbh unless schema_exists($dbh, $S);
+ return $helpconnect, '', $dbh unless schema_exists($dbh, $S);
$dbh->do("SET search_path TO $S");
}
else {
+
cleanup_database($dbh);
eval {
@@ -131,15 +401,38 @@
if ($arg->{disconnect}) {
$dbh->disconnect();
- return $helpconnect, undef, undef;
+ return $helpconnect, '', undef;
}
$dbh->{AutoCommit} = 0 unless $arg->{AutoCommit};
-return $helpconnect, undef, $dbh;
+return $helpconnect, '', $dbh;
} ## end of connect_database
+sub get_test_settings {
+
+ ## Returns the DSN and user from the testfile if it exists
+ ## Defaults to ENV variables or blank
+
+ my ($testdsn, $testuser, $testdir) = ('','','');
+ my ($helpconnect, $su) = (0,'');
+ if (-e $helpfile) {
+ open my $fh, '<', $helpfile or die qq{Could not open
"$helpfile": $!\n};
+ while (<$fh>) {
+ /DSN: (.+)/ and $testdsn = $1;
+ /User: (\w+)/ and $testuser = $1;
+ /Helpconnect: (\d+)/ and $helpconnect = $1;
+ /Testowner: (\w+)/ and $su = $1;
+ /Testdir: (.+)/ and $testdir = $1;
+ }
+ close $fh or die qq{Could not close "$helpfile": $!\n};
+ }
+
+ return $testdsn, $testuser, $helpconnect, $su, $testdir;
+}
+
+
sub schema_exists {
my ($dbh,$schema) = @_;
@@ -164,9 +457,10 @@
}
-
sub cleanup_database {
+ ## Clear out any testing objects in the current database
+
my $dbh = shift;
my $type = shift || 0;
@@ -198,4 +492,28 @@
}
+sub shutdown_test_database {
+
+ if (-e $test_database_dir) {
+ eval {
+ qx{pg_ctl -D $test_database_dir -m fast stop};
+ };
+ return $@;
+ }
+
+ my ($testdsn,$testuser,$helpconnect,$su,$testdir) = get_test_settings();
+ if ($testdir) {
+ my $COM = "pg_ctl -D $testdir -m fast stop";
+ if ($su) {
+ $COM = qq{su -l $su -c "$COM"};
+ }
+ warn "Shutting down test database\n";
+ eval {
+ qx{$COM};
+ };
+ return $@;
+ }
+
+}
+
1;
