view release on metacpan or  search on metacpan

t/002_postgres.t  view on Meta::CPAN

#!perl
BEGIN
{
	use strict;
	use warnings;
    use Test::More qw( no_plan );
    select(($|=1,select(STDERR),$|=1)[1]);
    use Module::Generic::File qw( file );
	use JSON;
	use version;
	our $DEBUG = exists( $ENV{AUTHOR_TESTING} ) ? $ENV{AUTHOR_TESTING} : 0;
};

# BEGIN { use_ok( 'DB::Object::Postgres' ); };
my $me = file(__FILE__);
my $path = $me->parent;
my @cleanup = ();
local $SIG{__DIE__} = \&_cleanup;
local $SIG{ABRT} = \&_cleanup;
local $SIG{BUS}  = \&_cleanup;
local $SIG{INT}  = \&_cleanup;
local $SIG{QUIT} = \&_cleanup;
local $SIG{SEGV} = \&_cleanup;
local $SIG{TERM} = \&_cleanup;

SKIP:
{
	eval
	{
		require DBD::Pg;
	};
	if( $@ )
	{
        skip( "DBD::Pg is not installed", 25 );
	}
	else
	{
        use_ok( 'DB::Object::Postgres' );
        use_ok( "DB::Object::Postgres::Query" );
        use_ok( "DB::Object::Postgres::Statement" );
        use_ok( "DB::Object::Postgres::Lo" );
        use_ok( "DB::Object::Postgres::Tables" );
    }
	
	# Connection parameters are taken from environment variables (DB_NAME, DB_LOGIN, DB_PASSWD, DB_DRIVER, DB_SCHEMA), or from file (DB_CON_FILE) or from uri (DB_CON_URI)
	# DB_CON_URI=http://localhost:5432?database=postgres&login=jack&
	my $con_params =
	{
	db		=> 'postgres',
	host    => ( $ENV{DB_HOST} || 'localhost' ),
	driver	=> 'Pg',
	debug   => $DEBUG,
	};
	if( $^O eq 'MSWin32' )
	{
		$con_params->{login} = ( $ENV{DB_LOGIN} || getlogin ) if( !$ENV{DB_CON_FILE} );
	}
	else
	{
		$con_params->{login} = ( $ENV{DB_LOGIN} || getlogin || (getpwuid( $> ))[0] ) if( !$ENV{DB_CON_FILE} );
	}
	my $dbh1 = DB::Object->connect( $con_params );
	if( !defined( $dbh1 ) )
	{
		skip( "Database connection failed, cancelling other tests: ". DB::Object->error, 17 );
	}

	# $pg->debug(3);
	ok( $dbh1, "Getting DB::Object::Postgres object" );
	isa_ok( $dbh1, 'DB::Object::Postgres', "Checking class of object" );
	# should trigger a connection using our shell login id and postgres database
	$ENV{DB_HOST} ||= 'localhost';
	my @db = $dbh1->databases;
	ok( @db, "Checking available databases" );
	diag( sprintf( "Found the databases: %s", join( ", ", @db ) ) );
	if( grep( /^postgres$/, @db ) )
	{
		pass( "postgres availability" );
	}
	else
	{
		fail( "postgres availability" );
	}

	# ok( $dbh, "Testing connection" );
	our $test_db = 'db_object_pg_test';
	if( scalar( grep( /^$test_db$/, @db ) ) )
	{
		diag( "Switching database to template1 to drop the old test database $test_db" );
		if( !$dbh1->use( 'postgres' ) )
		{
			fail( "Could not switch to database postgres" )
		}
		else
		{
			pass( "Switching database" );
			my $rv = $dbh1->do( "DROP DATABASE $test_db" );
			ok( $rv, "Dropping leftover test database $test_db" );
		}
	}
	else
	{
		pass( "No leftover test database $test_db" );
	}

	our $dbh = $dbh1->create_db( $test_db );
	ok( $dbh, "Creating database $test_db" );
	BAIL_OUT( "Unable to create database $test_db: " . $dbh1->error ) if( !$dbh );
	push( @cleanup, sub
	{
	    return if( !$dbh );
        my @dbs = $dbh->databases;

        if( scalar( grep( /^$test_db$/, @dbs ) ) )
        {
            diag( "Switching database to template1 to drop the old test database $test_db" );
            my $dbh2;
            if( !( $dbh2 = $dbh->use( 'template1' ) ) )
            {
                diag( "Unable to switch to database template1" );