view release on metacpan or  search on metacpan

t/TestFirebird.pm  view on Meta::CPAN

package TestFirebird;
#
# Helper file for the DBD::Firebird tests
#
# 2011-04-01: Created by stefan(s.bv.)
# Based on the DBD::InterBase - Makefile.PL script
# (2008-01-08 05:29:19Z by edpratomo)
# Inspired by the 't/dbdpg_test_setup.pl' script from DBD::Pg.
#

use strict;
use warnings;
use Carp;

use DBI 1.43;                   # minimum version for 'parse_dsn'
use File::Spec;
use File::Basename;
use File::Temp;

use Test::More;

use base 'Exporter';

our @EXPORT = qw(find_new_table);

sub import {
    my $me = shift;
    $me->export_to_level(1,undef, qw(find_new_table));
}

use constant test_conf => 't/tests-setup.tmp.conf';
use constant test_mark => 't/tests-setup.tmp.OK';
use constant dbd => 'DBD::Firebird';

sub new {
    my $class = shift;
    my $self = bless {@_}, $class;

    $self->read_cached_configs;

    $self->check_credentials;

    return $self;
}

sub check_credentials {
    my $self = shift;

    unless ( defined $self->{pass}
        or defined $ENV{DBI_PASS}
        or defined $ENV{ISC_PASSWORD} )
    {
        plan skip_all =>
            "Neither DBI_PASS nor ISC_PASSWORD present in the environment";
        exit 0;    # do not fail with CPAN testers
    }
}

=head2 read_cached_configs

Read the connection parameters from the 'tests-setup.conf' file.

=cut

sub read_cached_configs {
    my $self = shift;

    my $test_conf = $self->test_conf;

    if (-f $test_conf) {
        # print "\nReading cached test configuration...\n";

        open my $file_fh, '<', $test_conf
            or croak "Can't open file ", $test_conf, ": $!";

        foreach my $line (<$file_fh>) {
            next if $line =~ m{^#+};         # skip comments

            my ($key, $val) = split /:=/, $line, 2;
            chomp $val;
            $self->{$key} = $val;
        }

        close $file_fh;
    }
}

=head2 connect_to_database

Initialize setting for the connection.

Connect to database and return handler.

Takes optional parameter for connection attributes.

=cut

sub connect_to_database {
    my $self = shift or confess;
    my $attr = shift;

    my $error_str = $self->tests_init();

    my $dbh;
    unless ($error_str) {
        my $default_attr = {