File Coverage

blib/lib/Test/DB/Postgres.pm

Criterion	Covered	Total	%
statement	14	75	18.6
branch	0	32	0.0
condition	0	9	0.0
subroutine	5	20	25.0
pod	3	15	20.0
total	22	151	14.5

package Test::DB::Postgres;

use 5.014;

use strict;
use warnings;

use Venus::Class;

with 'Venus::Role::Optional';

use DBI;

# VERSION

our $VERSION = '0.10';

# ATTRIBUTES

attr 'dbh';
attr 'dsn';
attr 'hostname';
attr 'hostport';
attr 'initial';
attr 'uri';
attr 'username';
attr 'password';
attr 'database';
attr 'template';

# OPTIONS

sub lazy_build_dbh {
  my ($self, $data) = @_;

  $data ||= DBI->connect($self->dsn, $self->username, $self->password, {
    RaiseError => 1,
    AutoCommit => 1
  });

  return $data;
}

sub lazy_build_dsn {
  my ($self, $data) = @_;

  return $self->dsngen($self->database);
}

sub lazy_build_hostname {
  my ($self, $data) = @_;

  return $data ? $data : $ENV{TESTDB_HOSTNAME};
}

sub lazy_build_hostport {
  my ($self, $data) = @_;

  return $data ? $data : $ENV{TESTDB_HOSTPORT};
}

sub lazy_build_initial {
  my ($self, $data) = @_;

  return $data ? $data : $ENV{TESTDB_INITIAL} || 'postgres';
}

sub lazy_build_uri {
  my ($self, $data) = @_;

  return $self->urigen($self->database);
}

sub lazy_build_username {
  my ($self, $data) = @_;

  return $data ? $data : $ENV{TESTDB_USERNAME} || '';
}

sub lazy_build_password {
  my ($self, $data) = @_;

  return $data ? $data : $ENV{TESTDB_PASSWORD} || '';
}

sub lazy_build_database {
  my ($self, $data) = @_;

  return $data ? $data : join '_', 'testing_db', time, $$, sprintf "%04d", rand 999;
}

sub lazy_build_template {
  my ($self, $data) = @_;

  return $data ? $data : $ENV{TESTDB_TEMPLATE};
}

# METHODS

sub clone {
  my ($self) = @_;

  my $source = $self->template;
  my $initial = $self->initial;

  my $dbh = DBI->connect($self->dsngen($initial),
    $self->username,
    $self->password,
    {
      RaiseError => 1,
      AutoCommit => 1
    }
  );

  my $sth = $dbh->prepare(qq(CREATE DATABASE "@{[$self->database]}" TEMPLATE "$source"));

  $sth->execute;
  $dbh->disconnect;

  $self->dbh;
  $self->uri;

  return $self;
}

sub create {
  my ($self) = @_;

  my $dbh = DBI->connect($self->dsngen($self->initial),
    $self->username,
    $self->password,
    {
      RaiseError => 1,
      AutoCommit => 1
    }
  );

  my $sth = $dbh->prepare(qq(CREATE DATABASE "@{[$self->database]}"));

  $sth->execute;
  $dbh->disconnect;

  $self->dbh;
  $self->uri;

  return $self;
}

sub destroy {
  my ($self) = @_;

  $self->dbh->disconnect if $self->{dbh};

  my $dbh = DBI->connect($self->dsngen($self->initial),
    $self->username,
    $self->password,
    {
      RaiseError => 1,
      AutoCommit => 1
    }
  );

  my $sth = $dbh->prepare(qq(DROP DATABASE "@{[$self->database]}"));

  $sth->execute;
  $dbh->disconnect;

  return $self;
}

sub dsngen {
  my ($self, $name) = @_;

  my $hostname = $self->hostname;
  my $hostport = $self->hostport;

  return join ';', "dbi:Pg:dbname=$name", join ';',
    ($hostname ? ("host=@{[$hostname]}") : ()),
    ($hostport ? ("port=@{[$hostport]}") : ())
}

sub urigen {
  my ($self, $name) = @_;

  my $username = $self->username;
  my $password = $self->password;
  my $hostname = $self->hostname;
  my $hostport = $self->hostport;

  return join(
    '/', 'postgresql',
    ($username ? '' : ()),
    (
      $username
      ? join('@',
        join(':', $username ? ($username, ($password ? $password : ())) : ()),
        $hostname
        ? ($hostport ? (join(':', $hostname, $hostport)) : $hostname)
        : '')
      : ()
    ),
    $name
    )
}

1;



=head1 NAME

Test::DB::Postgres - Temporary Testing Databases for Postgres

=cut

=head1 ABSTRACT

Temporary Postgres Database for Testing

=cut

=head1 VERSION

0.10

=cut

=head1 SYNOPSIS

  package main;

  use Test::DB::Postgres;

  my $tdbo = Test::DB::Postgres->new;

  # my $dbh = $tdbo->create->dbh;

=cut

=head1 DESCRIPTION

This package provides methods for generating and destroying Postgres databases
for testing purposes. The attributes can be set using their respective
environment variables: C, C,
C, C, C, and
C.

=cut

=head1 ATTRIBUTES

This package has the following attributes:

=cut

=head2 dbh

  dbh(Object)

This attribute is read-only, accepts C<(Object)> values, and is optional.

=cut

=head2 dsn

  dsn(Str)

This attribute is read-only, accepts C<(Str)> values, and is optional.

=cut

=head2 database

  database(Str)

This attribute is read-only, accepts C<(Str)> values, and is optional.

=cut

=head2 hostname

  hostname(Str)

This attribute is read-only, accepts C<(Str)> values, and is optional.

=cut

=head2 hostport

  hostport(Str)

This attribute is read-only, accepts C<(Str)> values, and is optional.

=cut

=head2 uri

  uri(Str)

This attribute is read-only, accepts C<(Str)> values, and is optional.

=cut

=head2 username

  username(Str)

This attribute is read-only, accepts C<(Str)> values, and is optional.

=cut

=head2 password

  password(Str)

This attribute is read-only, accepts C<(Str)> values, and is optional.

=cut

=head1 METHODS

This package provides the following methods:

=cut

=head2 clone

clone(Str $source) : Object

The clone method creates a temporary database from a database template.

=over 4

=item clone example 1

  # given: synopsis

  $tdbo->clone('template0');

  #

=back

=cut

=head2 create

create() : Object

The create method creates a temporary database and returns the invocant.

=over 4

=item create example 1

  # given: synopsis

  $tdbo->create;

  #

=back

=cut

=head2 destroy

destroy() : Object

The destroy method destroys (drops) the database and returns the invocant.

=over 4

=item destroy example 1

  # given: synopsis

  $tdbo->create;
  $tdbo->destroy;

  #

=back

=cut