[check_postgres] [commit] Begin unit tests with "backend" action.
check_postgres at bucardo.org
check_postgres at bucardo.org
Tue Feb 24 02:28:04 UTC 2009
Committed by Greg Sabino Mullane <greg at endpoint.com>
Begin unit tests with "backend" action.
---
check_postgres.pl.asc | 6 +-
check_postgres.pl.html | 10 ++-
index.html | 2 +-
t/00-signature.t | 34 +++++++
t/01connect.t | 97 --------------------
t/02backends.t | 154 +++++++++++++++++++++++++++++++
t/99_spellcheck.t | 4 +
t/CP_Testing.pm | 238 ++++++++++++++++++++++++++++++++++++++++++++++++
8 files changed, 442 insertions(+), 103 deletions(-)
diff --git a/check_postgres.pl.asc b/check_postgres.pl.asc
index 9dea88b..4579e89 100644
--- a/check_postgres.pl.asc
+++ b/check_postgres.pl.asc
@@ -1,6 +1,6 @@
-----BEGIN PGP SIGNATURE-----
-iEYEABEDAAYFAkmR3/cACgkQvJuQZxSWSshFpwCfSmS1vozCrmVL/PFM8VoBqSFi
-gzYAnA4pWREsuvlOsfnIsdsw3Tf2VDIh
-=dt4G
+iEYEABEDAAYFAkmjWs8ACgkQvJuQZxSWSsiRPwCfZc7WWECYzxNCM2TvCEVUWMkA
+ZZQAoL+0pEfXuu4MCkNJWm+dq7g6eAYU
+=L1hr
-----END PGP SIGNATURE-----
diff --git a/check_postgres.pl.html b/check_postgres.pl.html
index 145d91c..5f343ac 100644
--- a/check_postgres.pl.html
+++ b/check_postgres.pl.html
@@ -1120,6 +1120,9 @@ and/or as comma-separated lists. A leading tilde will match the following word
as a regular expression.</p>
<p>To match a schema, end the search term with a single period. Leading tildes can
be used for schemas as well.</p>
+<p>Be careful when using filtering: an inclusion rule on the backends, for example,
+may report no problems not only because the matching database had no backends,
+but because you misspelled the name of the database!</p>
<p>Examples:</p>
<p>Only checks items named pg_class:</p>
<pre>
@@ -1253,8 +1256,11 @@ feature requests, and commit notices, send email to <a href="mailto:check_postgr
<dd>
<pre>
- Add the 'disabled_triggers' check.
- Added basic internationalization support.</pre>
+ Added the 'disabled_triggers' check.
+ Added internationalization support.
+ French translations (Guillaume Lelarge)
+ Make the backends search return ok if no matches due to inclusion rules,
+ per report by Guillaume Lelarge</pre>
</dd>
<dt><strong><a name="item_3"><strong>Version 2.7.3</strong> (February 10, 2009)</a></strong></dt>
diff --git a/index.html b/index.html
index 8b981c6..817b8c4 100644
--- a/index.html
+++ b/index.html
@@ -21,7 +21,7 @@ h1 {
<h1>check_postgres.pl</h1>
-<p><b>check_postgres.pl</b> is a script for checking the state of one or more Postgres databases and reporting back in a Nagios-friendly manner. It was developed by Greg Sabino Mullane of <a href="http://www.endpoint.com/">End Point Corporation</a> and is BSD-licensed. The latest version is <b>2.8.0</b>, and was released on February 15, 2009.</p>
+<p><b>check_postgres.pl</b> is a script for checking the state of one or more Postgres databases and reporting back in a Nagios-friendly manner. It was developed by Greg Sabino Mullane of <a href="http://www.endpoint.com/">End Point Corporation</a> and is BSD-licensed. The latest version is <b>2.8.0</b>, and was released on February 23, 2009.</p>
<ul>
<li><a href="/check_postgres/check_postgres.pl.html">Documentation for check_postgres 2.8.0</a></li>
diff --git a/t/00-signature.t b/t/00-signature.t
new file mode 100644
index 0000000..4021b92
--- /dev/null
+++ b/t/00-signature.t
@@ -0,0 +1,34 @@
+#!perl
+
+## Test that our PGP signature file is valid
+
+use 5.006;
+use strict;
+use warnings;
+use Test::More;
+select(($|=1,select(STDERR),$|=1)[1]);
+
+my $sigfile = 'check_postgres.pl.asc';
+
+if (!$ENV{TEST_SIGNATURE}) {
+ plan skip_all => 'Set the environment variable TEST_SIGNATURE to enable this test';
+}
+plan tests => 1;
+
+SKIP: {
+ if ( !-e $sigfile ) {
+ fail (qq{File '$sigfile' file was not found});
+ }
+ elsif ( ! -s $sigfile) {
+ fail (qq{File '$sigfile' was empty});
+ }
+ else {
+ my $result = system "gpg --no-options --no-auto-check-trustdb --no-tty --logger-fd 1 --quiet --verify $sigfile >/dev/null";
+ if (0 == $result) {
+ pass (qq{Valid signature file '$sigfile'});
+ }
+ else {
+ fail (qq{Invalid signature file '$sigfile'});
+ }
+ }
+}
diff --git a/t/01connect.t b/t/01connect.t
deleted file mode 100644
index bf803e3..0000000
--- a/t/01connect.t
+++ /dev/null
@@ -1,97 +0,0 @@
-#!perl
-
-## Make sure we can connect and disconnect cleanly
-## All tests are stopped if we cannot make the first connect
-
-use strict;
-use warnings;
-use DBI;
-use DBD::Pg;
-use Test::More;
-use lib 't','.';
-require 'check_postgres_setup.pl';
-select(($|=1,select(STDERR),$|=1)[1]);
-
-## Define this here in case we get to the END block before a connection is made.
-BEGIN {
- use vars qw/$pgversion $pglibversion $pgvstring $pgdefport $helpconnect $dbh $connerror %set/;
- ($pgversion,$pglibversion,$pgvstring,$pgdefport) = ('?','?','?','?');
-}
-
-($helpconnect,$connerror,$dbh) = connect_database();
-
-if (! defined $dbh) {
- plan skip_all => 'Connection to database failed, cannot continue testing';
-}
-plan tests => 1;
-
-# 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 ($t);
-
-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];
-
-END {
- my $pv = sprintf('%vd', $^V);
- my $schema = 'check_postgres_schema';
- my $dsn = exists $ENV{DBI_DSN} ? $ENV{DBI_DSN} : '?';
- my $ver = defined $DBD::Pg::VERSION ? $DBD::Pg::VERSION : '?';
- my $user = exists $ENV{DBI_USER} ? $ENV{DBI_USER} : '<not set>';
-
- my $extra = '';
- for (sort qw/HOST HOSTADDR PORT DATABASE USER PASSWORD PASSFILE OPTIONS REALM
- REQUIRESSL KRBSRVNAME CONNECT_TIMEOUT SERVICE SSLMODE SYSCONFDIR
- CLIENTENCODING/) {
- my $name = "PG$_";
- if (exists $ENV{$name} and defined $ENV{$name}) {
- $extra .= sprintf "\n%-21s $ENV{$name}", $name;
- }
- }
- for my $name (qw/DBI_DRIVER DBI_AUTOPROXY/) {
- if (exists $ENV{$name} and defined $ENV{$name}) {
- $extra .= sprintf "\n%-21s $ENV{$name}", $name;
- }
- }
-
- ## More helpful stuff
- for (sort keys %set) {
- $extra .= sprintf "\n%-21s %s", $_, $set{$_};
- }
-
- if ($helpconnect) {
- $extra .= "\nAdjusted: ";
- if ($helpconnect & 1) {
- $extra .= 'DBI_DSN ';
- }
- if ($helpconnect & 4) {
- $extra .= 'DBI_USER';
- }
- }
-
- if (defined $connerror) {
- $connerror =~ s/.+?failed: //;
- $connerror =~ s{\n at t/check_postgres.*}{}m;
- $extra .= "\nError was: $connerror";
- }
-
- diag
- "\nDBI Version $DBI::VERSION\n".
- "DBD::Pg Version $ver\n".
- "Perl Version $pv\n".
- "OS $^O\n".
- "PostgreSQL (compiled) $pglibversion\n".
- "PostgreSQL (target) $pgversion\n".
- "PostgreSQL (reported) $pgvstring\n".
- "Default port $pgdefport\n".
- "DBI_DSN $dsn\n".
- "DBI_USER $user\n".
- "Test schema $schema$extra\n";
-}
diff --git a/t/02backends.t b/t/02backends.t
new file mode 100644
index 0000000..665c490
--- /dev/null
+++ b/t/02backends.t
@@ -0,0 +1,154 @@
+#!perl
+
+## Test the "backends" action
+
+use strict;
+use warnings;
+use Data::Dumper;
+use DBI;
+use Cwd;
+use Test::More tests => 52;
+use lib 't','.';
+use CP_Testing;
+
+use vars qw/$dbh $dbh2 $SQL $count $host $t $result/;
+
+my $cp = CP_Testing->new();
+
+$dbh = $cp->test_database_handle();
+
+## Check current number of connections: should be 1 (for recent versions of PG)
+$SQL = 'SELECT count(*) FROM pg_stat_activity';
+$count = $dbh->selectall_arrayref($SQL)->[0][0];
+
+$t=q{Current number of backends is one (ourselves)};
+is ($count, 1, $t);
+1==$count or BAIL_OUT "Cannot continue unless we start from a sane connection count\n";
+
+$host = $cp->get_host();
+
+$result = $cp->run('backends');
+
+$t=q{Action 'backends' returned expected text and OK value};
+like ($result, qr{^POSTGRES_BACKENDS OK:}, $t);
+
+$t=q{Action 'backends' returned correct host name};
+like ($result, qr{^POSTGRES_BACKENDS OK: \(host:$host\)}, $t);
+
+$t=q{Action 'backends' returned correct connection count};
+like ($result, qr{^POSTGRES_BACKENDS OK: \(host:$host\) 2 of 10 connections}, $t);
+
+$t=q{Action 'backends' returned correct percentage};
+like ($result, qr{^POSTGRES_BACKENDS OK: \(host:$host\) 2 of 10 connections \(20%\)}, $t);
+
+$t=q{Action 'backends' returned correct performance data};
+like ($result, qr{ \| time=(\d\.\d\d) beedeebeedee=0 postgres=2 template0=0 template1=0\s$}, $t);
+
+$t=q{Action 'backends' fails when called with an invalid option};
+like ($cp->run('backends', 'foobar=12'), qr{^\s*Usage:}, $t);
+
+$t=q{Action 'backends' fails when called with an invalid warning option};
+like ($cp->run('backends', '-w felz'), qr{^ERROR: Warning}, $t);
+like ($cp->run('backends', '-w " 12345"'), qr{^ERROR: Warning}, $t);
+like ($cp->run('backends', '-w 23%%'), qr{^ERROR: Warning}, $t);
+
+$t=q{Action 'backends' fails when called with an invalid critical option};
+like ($cp->run('backends', '-c felz'), qr{^ERROR: Critical}, $t);
+like ($cp->run('backends', '-c " 12345"'), qr{^ERROR: Critical}, $t);
+like ($cp->run('backends', '-c 23%%'), qr{^ERROR: Critical}, $t);
+
+$t=q{Action 'backends' fails when the warning option is greater than the critical option};
+like ($cp->run('backends', '-w 20 -c 10'), qr{^ERROR: The 'warning'.+greater}, $t);
+like ($cp->run('backends', '-w 20% -c 10%'), qr{^ERROR: The 'warning'.+greater}, $t);
+
+$t=q{Action 'backends' fails when the warning option is less than the critical option};
+like ($cp->run('backends', '-w -10 -c -20'), qr{^ERROR: The 'warning'.+less}, $t);
+
+$t=q{Action 'backends' fails when the warning option is a negative percent};
+like ($cp->run('backends', '-w -10%'), qr{^ERROR: Cannot specify a negative percent}, $t);
+
+$t=q{Action 'backends' fails when the critical option is a negative percent};
+like ($cp->run('backends', '-c -10%'), qr{^ERROR: Cannot specify a negative percent}, $t);
+
+$t=q{Action 'backends' with the 'noidle' option returns expected result};
+like ($cp->run('backends', '-noidle'), qr{^POSTGRES_BACKENDS OK:.+ 2 of 10 connections}, $t);
+$dbh2 = $cp->get_fresh_dbh();
+$dbh2->do('SELECT 123');
+like ($cp->run('backends', '-noidle'), qr{^POSTGRES_BACKENDS OK:.+ 3 of 10 connections}, $t);
+$dbh2->commit();
+like ($cp->run('backends', '-noidle'), qr{^POSTGRES_BACKENDS OK:.+ 2 of 10 connections}, $t);
+
+$t=q{Action 'backends' has critical option trump the warning option};
+like ($cp->run('backends', '-w 1 -c 1'), qr{^POSTGRES_BACKENDS CRITICAL}, $t);
+like ($cp->run('backends', '--critical=1 --warning=0'), qr{^POSTGRES_BACKENDS CRITICAL}, $t);
+
+$t=q{Action 'backends' works with warning option as an absolute number};
+like ($cp->run('backends', '-w 2'), qr{^POSTGRES_BACKENDS WARNING}, $t);
+like ($cp->run('backends', '-w 3'), qr{^POSTGRES_BACKENDS WARNING}, $t);
+like ($cp->run('backends', '-w 4'), qr{^POSTGRES_BACKENDS OK}, $t);
+
+$t=q{Action 'backends' works with warning option as an percentage};
+like ($cp->run('backends', '-w 20%'), qr{^POSTGRES_BACKENDS WARNING}, $t);
+like ($cp->run('backends', '-w 30%'), qr{^POSTGRES_BACKENDS WARNING}, $t);
+like ($cp->run('backends', '-w 40%'), qr{^POSTGRES_BACKENDS OK}, $t);
+
+$t=q{Action 'backends' works with warning option as a negative number};
+like ($cp->run('backends', '-w -6'), qr{^POSTGRES_BACKENDS WARNING}, $t);
+like ($cp->run('backends', '-w -7'), qr{^POSTGRES_BACKENDS WARNING}, $t);
+like ($cp->run('backends', '-w -8'), qr{^POSTGRES_BACKENDS OK}, $t);
+
+$t=q{Action 'backends' works with critical option as an absolute number};
+like ($cp->run('backends', '-c 2'), qr{^POSTGRES_BACKENDS CRITICAL}, $t);
+like ($cp->run('backends', '-c 3'), qr{^POSTGRES_BACKENDS CRITICAL}, $t);
+like ($cp->run('backends', '-c 4'), qr{^POSTGRES_BACKENDS OK}, $t);
+
+$t=q{Action 'backends' works with critical option as an percentage};
+like ($cp->run('backends', '-c 20%'), qr{^POSTGRES_BACKENDS CRITICAL}, $t);
+like ($cp->run('backends', '-c 30%'), qr{^POSTGRES_BACKENDS CRITICAL}, $t);
+like ($cp->run('backends', '-c 40%'), qr{^POSTGRES_BACKENDS OK}, $t);
+
+$t=q{Action 'backends' works with critical option as a negative number};
+like ($cp->run('backends', '-c -6'), qr{^POSTGRES_BACKENDS CRITICAL}, $t);
+like ($cp->run('backends', '-c -7'), qr{^POSTGRES_BACKENDS CRITICAL}, $t);
+like ($cp->run('backends', '-c -8'), qr{^POSTGRES_BACKENDS OK}, $t);
+
+$t=q{Action 'backends' works when no items caught by pg_stat_activity};
+## This is tricky to test properly.
+$cp->create_fake_pg_table('pg_stat_activity');
+like ($cp->run('backends'), qr{^POSTGRES_BACKENDS OK: .+No connections}, $t);
+
+$t=q{Action 'backends' returns correct MRTG output when no rows};
+is ($cp->run('backends', '--output=MRTG'), qq{0\n0\n\nDB=postgres Max connections=10\n}, $t);
+
+$cp->remove_fake_pg_table('pg_stat_activity');
+
+$t=q{Action 'backends' fails as expected when max_connections cannot be determined};
+$cp->create_fake_pg_table('pg_settings');
+like ($cp->run('backends'), qr{^POSTGRES_BACKENDS UNKNOWN: .+max_connections}, $t);
+$cp->remove_fake_pg_table('pg_settings');
+
+$t=q{Action 'backends' returns correct MRTG output when rows found};
+is ($cp->run('backends', '--output=MRTG'), qq{3\n0\n\nDB=postgres Max connections=10\n}, $t);
+
+$t=q{Action 'backends' works when include forces no matches};
+like ($cp->run('backends', '--include=foobar'), qr{POSTGRES_BACKENDS OK: .+No connections}, $t);
+
+$t=q{Action 'backends' works when include has valid database};
+like ($cp->run('backends', '--include=postgres'), qr{POSTGRES_BACKENDS OK: .+3 of 10}, $t);
+
+$t=q{Action 'backends' works when exclude forces no matches};
+like ($cp->run('backends', '--exclude=postgres'), qr{POSTGRES_BACKENDS OK: .+No connections}, $t);
+
+$t=q{Action 'backends' works when exclude excludes nothing};
+like ($cp->run('backends', '--exclude=foobar'), qr{POSTGRES_BACKENDS OK: .+3 of 10}, $t);
+
+$t=q{Action 'backends' works when include and exclude make a match};
+like ($cp->run('backends', '--exclude=postgres --include=postgres'), qr{POSTGRES_BACKENDS OK: .+3 of 10}, $t);
+
+$t=q{Action 'backends' works when include and exclude make a match};
+like ($cp->run('backends', '--include=postgres --exclude=postgres'), qr{POSTGRES_BACKENDS OK: .+3 of 10}, $t);
+
+$t=q{Action 'backends' returned correct performance data with include};
+like ($cp->run('backends', '--include=postgres'), qr{ \| time=(\d\.\d\d) beedeebeedee=0 postgres=3}, $t);
+
+exit;
diff --git a/t/99_spellcheck.t b/t/99_spellcheck.t
index 1b0536b..aaef426 100644
--- a/t/99_spellcheck.t
+++ b/t/99_spellcheck.t
@@ -132,11 +132,13 @@ __DATA__
## Common:
+backends
bucardo
DBI
DSN
Mullane
Nagios
+PGP
Sabino
http
login
@@ -226,6 +228,7 @@ minvalue
morpork
mrtg
MRTG
+msg
nagios
NAGIOS
nextval
@@ -276,3 +279,4 @@ wal
WAL
watson
wilkins
+RequireInterpolationOfMetachars
diff --git a/t/CP_Testing.pm b/t/CP_Testing.pm
new file mode 100644
index 0000000..63451c5
--- /dev/null
+++ b/t/CP_Testing.pm
@@ -0,0 +1,238 @@
+package CP_Testing;
+
+## Common methods used by the other tests for check_postgres.pl
+
+use strict;
+use warnings;
+use Data::Dumper;
+use Time::HiRes qw/sleep/;
+use Cwd;
+
+my $DEBUG = 0;
+
+use vars qw/$com $info $count/;
+
+sub new {
+ my $class = shift;
+ my $self = {
+ started => time(),
+ dbdir => 'test_database_check_postgres',
+ testuser => 'check_postgres_testing',
+ };
+ return bless $self => $class;
+}
+
+sub test_database_handle {
+
+ ## Request for a database handle: create and startup DB as needed
+
+ my $self = shift;
+ my $arg = shift || {};
+
+ ref $arg eq 'HASH' or die qq{Must pass a hashref (or nothing) to test_database_handle\n};
+
+ ## Create the test database directory if it does not exist
+ my $dbdir = $self->{dbdir};
+ if (! -d $dbdir) {
+
+ -e $dbdir and die qq{Oops: I cannot create "$dbdir", there is already a file there!\n};
+
+ Test::More::diag qq{Creating database in directory "$dbdir"\n};
+
+ mkdir $dbdir;
+
+ my $initdb = $ENV{PGINITDB} || 'initdb';
+
+ $com = qq{LC_ALL=en LANG=C $initdb --locale=C -E UTF8 -D $dbdir/data 2>&1};
+ eval {
+ $info = qx{$com};
+ };
+ if ($@) {
+ die qq{Failed to run "$com": error was $@\n};
+ }
+
+ ## Modify the postgresql.conf
+ my $cfile = "$dbdir/data/postgresql.conf";
+ open my $cfh, '>>', $cfile or die qq{Could not open "$cfile": $!\n};
+ print $cfh qq{\n\n## check_postgres.pl testing parameters\n};
+ print $cfh qq{listen_addresses = ''\n};
+ print $cfh qq{max_connections = 10\n};
+ print $cfh "\n";
+ close $cfh or die qq{Could not close "$cfile": $!\n};
+
+ mkdir "$dbdir/data/socket";
+
+ }
+
+ ## See if the database is already running.
+ my $needs_startup = 0;
+
+ my $pidfile = "$dbdir/data/postmaster.pid";
+ if (! -e $pidfile) {
+ $needs_startup = 1;
+ }
+ else {
+ open my $fh, '<', $pidfile or die qq{Could not open "$pidfile": $!\n};
+ <$fh> =~ /^(\d+)/ or die qq{Invalid information in file "$pidfile", expected a PID\n};
+ my $pid = $1;
+ close $fh or die qq{Could not open "$pidfile": $!\n};
+ ## Send a signal to see if this PID is alive
+ $count = kill 0 => $pid;
+ if ($count == 0) {
+ Test::More::diag qq{Found a PID file, but no postmaster. Removing file "$pidfile"\n};
+ unlink $pidfile;
+ $needs_startup = 1;
+ }
+ }
+
+ if ($needs_startup) {
+
+ my $logfile = "$dbdir/pg.log";
+
+ unlink $logfile;
+
+ $com = "LC_ALL=en LANG=C pg_ctl -o '-k socket' -l $logfile -D $dbdir/data start";
+ eval {
+ $info = qx{$com};
+ };
+ if ($@) {
+ die qq{Failed to run "$com": got $!\n};
+ }
+
+ my $bail_out = 100;
+ my $found = 0;
+ open my $logfh, '<', $logfile or die qq{Could not open "$logfile": $!\n};
+ SCAN: {
+ seek $logfh, 0, 0;
+ while (<$logfh>) {
+ if (/ready to accept connections/) {
+ last SCAN;
+ }
+ }
+ if (!$bail_out--) {
+ die qq{Gave up waiting for $logfile to say it was ready\n};
+ }
+ sleep 0.1;
+ redo;
+ }
+ close $logfh or die qq{Could not close "$logfile": $!\n};
+
+ } ## end of needs startup
+
+ my $here = cwd();
+ my $dsn = "dbi:Pg:host=$here/$dbdir/data/socket;dbname=postgres";
+ my @superdsn = ($dsn, '', '', {AutoCommit=>0,RaiseError=>1,PrintError=>0});
+ my $dbh = DBI->connect(@superdsn);
+ $dbh->ping() or die qq{Failed to ping!\n};
+
+ $dbh->{AutoCommit} = 1;
+ $dbh->{RaiseError} = 0;
+ my $dbuser = $self->{testuser};
+ $dbh->do("CREATE USER $dbuser SUPERUSER");
+ $dbh->do("CREATE USER sixpack NOSUPERUSER CREATEDB");
+ $dbh->do("CREATE USER readonly NOSUPERUSER NOCREATEDB");
+ $dbh->do("ALTER USER readonly SET default_transaction_read_only = 1");
+ $dbh->do("CREATE DATABASE beedeebeedee");
+ $dbh->{AutoCommit} = 0;
+ $dbh->{RaiseError} = 1;
+
+ $self->{dbhost} = "$here/$dbdir/data/socket";
+ $self->{dbname} = 'postgres';
+ $self->{dbh} = $dbh;
+ $self->{dsn} = $dsn;
+ $self->{superdsn} = \@superdsn;
+
+ ## Sanity check
+ $dbh->do("ALTER USER $dbuser SET search_path = public");
+ $dbh->do("SET search_path = public");
+ $dbh->do("COMMIT");
+
+ return $dbh;
+
+} ## end of test_database_handle
+
+
+sub run {
+
+ my $self = shift;
+ my $action = shift or die "First arg must be the command\n";
+ my $extra = shift || '';
+
+ my $dbhost = $self->{dbhost};
+ my $dbuser = $self->{testuser};
+ my $dbname = $self->{dbname};
+
+ my $com = "perl check_postgres.pl --action=$action --dbhost=$dbhost --dbname=$dbname --dbuser=$dbuser";
+
+ $extra and $com .= " $extra";
+
+ $DEBUG and warn "DEBUG RUN: $com\n";
+
+ my $result;
+ eval {
+ $result = qx{$com 2>&1};
+ };
+ if ($@) {
+ return "TESTERROR: $@";
+ }
+
+ return $result;
+
+} ## end of run
+
+sub get_host {
+ my $self = shift;
+ return $self->{dbhost};
+}
+
+sub get_dbh {
+ my $self = shift;
+ return $self->{dbh} || die;
+}
+
+sub get_fresh_dbh {
+
+ my $self = shift;
+ my $superdsn = $self->{superdsn} || die;
+
+ my $dbh = DBI->connect(@$superdsn);
+
+ return $dbh;
+}
+
+sub create_fake_pg_table {
+
+ ## Dangerous: do not try this at home!
+
+ my $self = shift;
+ my $name = shift;
+ my $dbh = $self->{dbh};
+ my $dbuser = $self->{testuser} || die;
+ {
+ local $dbh->{Warn};
+ $dbh->do("DROP TABLE IF EXISTS public.$name");
+ }
+ $dbh->do("CREATE TABLE public.$name AS SELECT * FROM $name LIMIT 0");
+ $dbh->do("ALTER USER $dbuser SET search_path = public, pg_catalog");
+ $dbh->commit();
+
+} ## end of create_fake_pg_table
+
+
+sub remove_fake_pg_table {
+
+ my $self = shift;
+ my $name = shift;
+ my $dbh = $self->{dbh};
+ my $dbuser = $self->{testuser} || die;
+ {
+ local $dbh->{Warn};
+ $dbh->do("DROP TABLE IF EXISTS public.$name");
+ }
+ $dbh->do("ALTER USER $dbuser SET search_path = public");
+ $dbh->commit();
+
+} ## end of remove_fake_pg_table
+
+
+1;
--
1.6.0.5
More information about the Check_postgres
mailing list