view release on metacpan or  search on metacpan

lib/Test/TempDatabase.pm  view on Meta::CPAN

use DBI;
use DBD::Pg;
use POSIX qw(setuid);
use Carp;
use File::Slurp;

=head1 NAME

Test::TempDatabase - temporary database creation and destruction.

=head1 SYNOPSIS

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

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

=head1 DESCRIPTION

This module automates creation and dropping of test databases.

=head1 USAGE

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

=cut
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);
}

=head2 $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.

=cut
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;
	}
}

=head2 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.

=cut
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;