Test::TempDatabase - temporary database creation and destruction.


Test-TempDatabase documentation Contained in the Test-TempDatabase distribution.

Index


Code Index:

NAME

Top

Test::TempDatabase - temporary database creation and destruction.

SYNOPSIS

Top

  use Test::TempDatabase;

  my $td = Test::TempDatabase->create(dbname => 'temp_db');
  my $dbh = $td->handle;

  ... some tests ...
  # Test::TempDatabase drops database

DESCRIPTION

Top

This module automates creation and dropping of test databases.

USAGE

Top

Create test database using Test::TempDatabase->create. Use handle to get a handle to the database. Database will be automagically dropped when Test::TempDatabase instance goes out of scope.

$class->become_postgres_user

When running as root, this function becomes different user. It decides on the user name by probing TEST_TEMP_DB_USER, SUDO_USER environment variables. If these variables are empty, default "postgres" user is used.

create

Creates temporary database. It will be dropped when the resulting instance will go out of scope.

Arguments are passed in as a keyword-value pairs. Available keywords are:

dbname: the name of the temporary database.

rest: the rest of the database connection string. It can be used to connect to a different host, etc.

username, password: self-explanatory.

BUGS

Top

* Works with PostgreSQL database currently.

AUTHOR

Top

	Boris Sukholitko
	boriss@gmail.com

COPYRIGHT

Top

SEE ALSO

Top

Test::More


Test-TempDatabase documentation Contained in the Test-TempDatabase distribution.
use strict;
use warnings FATAL => 'all';

package Test::TempDatabase;

our $VERSION = 0.16;
use DBI;
use DBD::Pg;
use POSIX qw(setuid);
use Carp;
use File::Slurp;

sub connect {
	my ($self, $db_name) = @_;
	my $cp = $self->connect_params;
	$db_name ||= $cp->{dbname};
	my $h = $cp->{cluster_dir} ? "host=$cp->{cluster_dir};" : "";
	my $dbi_args = $cp->{dbi_args} || { RaiseError => 1, AutoCommit => 1 };
	return DBI->connect("dbi:Pg:dbname=$db_name;$h" . ($cp->{rest} || ''),
				$cp->{username}, $cp->{password}, $dbi_args);
}

sub find_postgres_user {
	return $< if $<;

	my $uname = $ENV{TEST_TEMP_DB_USER} || $ENV{SUDO_USER} || "postgres";
	return getpwnam($uname);
}

sub become_postgres_user {
	my $class = shift;
	return if $<;

	my $p_uid = $class->find_postgres_user;
	my @pw = getpwuid($p_uid);

	carp("# $class\->become_postgres_user: setting $pw[0] uid\n");
	setuid($p_uid) or die "Unable to set $p_uid uid";
	$ENV{HOME} = $pw[ $#pw - 1 ];
}

sub create_db {
	my $self = shift;
	my $cp = $self->connect_params;
	my $dbh = $self->connect('template1');

	my $found = @{ $dbh->selectcol_arrayref(
			"select datname from pg_database where "
			. "datname = '$cp->{dbname}'") };

	my $drop_it = (!$cp->{no_drop} && $found);
	$self->drop_db if $drop_it;

	my $tn = $cp->{template} ? "template \"$cp->{template}\"" : "";
	$dbh->do("create database \"$cp->{dbname}\" $tn")
		if ($drop_it || !$found);
	$dbh->disconnect;
	$dbh = $self->connect($cp->{dbname});
	$self->{db_handle} = $dbh;

	if (my $schema = $cp->{schema}) {
		my $vs = $schema->new($dbh);
		$vs->run_updates;
		$self->{schema} = $vs;
	}
}

sub create {
	my ($class, %args) = @_;
	my $self = $class->new(\%args);
	$self->become_postgres_user;
	$self->create_db;
	return $self;
}

sub new {
	my ($class, $args) = @_;
	my $self = bless { connect_params => $args }, $class;
	$self->{pid} = $$;
	return $self;
}

sub _call_pg_cmd {
	my ($self, $cmd) = @_;
	my ($bdir) = (`pg_config | grep BINDIR` =~ /= (\S+)$/);
	$cmd = "$bdir/$cmd";
	$cmd = "su - postgres -c '$cmd'" unless $<;
	my $res = `$cmd 2>&1`;
	confess $res if $?;
}

sub create_cluster {
	my $self = shift;
	my $cdir = $self->{connect_params}->{cluster_dir};
	$self->_call_pg_cmd("initdb -D $cdir");
	append_file("$cdir/postgresql.conf"
		, "\nlisten_addresses = ''\nunix_socket_directory = '$cdir'\n");
}

sub start_server {
	my $self = shift;
	my $cdir = $self->{connect_params}->{cluster_dir};
	$self->_call_pg_cmd("pg_ctl -D $cdir -l $cdir/log start");

	sleep 1;
	for (1 .. 5) {
		my $log = read_file("$cdir/log");
		return if $log =~ /ready to accept/;
		sleep 1;
	}
	die "Server did not start " . read_file("$cdir/log");
}

sub stop_server {
	my $self = shift;
	my $cdir = $self->{connect_params}->{cluster_dir};
	$self->_call_pg_cmd("pg_ctl -D $cdir -m fast -l $cdir/log stop");
}

sub connect_params { return shift()->{connect_params}; }
sub handle { return shift()->{db_handle}; }

sub drop_db {
	my $self = shift;
	my $dn = $self->connect_params->{dbname};
	my @plines = `ps auxx | grep post | grep $dn | grep -v grep`;
	my $dbh = $self->connect('template1');
	for (@plines) {
		/\w\s+(\d+)/ or next;
		$dbh->do("select pg_terminate_backend($1)");
	}
	$dbh->do(q{ set client_min_messages to warning });
	$dbh->do("drop database if exists \"$dn\"");
	$dbh->disconnect;
	$self->{db_handle} = undef;
}

sub destroy {
	my $self = shift;
	return if $self->handle->{InactiveDestroy};
	$self->handle->disconnect;
	$self->{db_handle} = undef;
	return unless $self->{pid} == $$;
	return if $self->connect_params->{no_drop};
	$self->drop_db;
}

sub DESTROY {
	my $self = shift;
	$self->destroy if $self->handle;
}

sub dump_db {
	my ($self, $file) = @_;
	my $cp = $self->connect_params;
	my $h = $cp->{cluster_dir} ? "-h $cp->{cluster_dir}" : "";
	my $cmd = "pg_dump $h -O -c $cp->{dbname} > $file";
	system($cmd) and confess "Unable to do $cmd";
}

1;