view release on metacpan or  search on metacpan

t/dbdpg_test_setup.pl  view on Meta::CPAN

            goto INITDB;
        }
        $@ and return $helpconnect, $@, undef;
        $dbh->do("SET search_path TO $S");
        eval { $dbh->do('CREATE SEQUENCE dbd_pg_testsequence'); };
        $@ and Test::More::BAIL_OUT('Failed to create test sequence');

        # If you add columns to this, please do not use reserved words!
        $SQL = q{
CREATE TABLE dbd_pg_test (
  id         integer not null primary key,
  lii        integer unique not null default nextval('dbd_pg_testsequence'),
  pname      varchar(20) default 'Testing Default' ,
  val        text,
  score      float CHECK(score IN ('1','2','3', '999')),
  Fixed      character(5) CHECK (lii > -777),
  pdate      timestamp default now(),
  testarray  text[][],
  testarray2 int[],
  testarray3 bool[],
  "CaseTest" boolean CHECK (score < 888),
  expo       numeric(6,2),
  bytetest   bytea,
  bytearray  bytea[]
)
};

        $dbh->{Warn} = 0;
        eval { $dbh->do($SQL); };
        $@ and Test::More::BAIL_OUT('Failed to create test sequence');
        $dbh->{Warn} = 1;
        $dbh->do(q{COMMENT ON COLUMN dbd_pg_test.id IS 'Bob is your uncle'});

    } ## end setup

$dbh->commit() unless $dbh->{AutoCommit};

if ($arg->{disconnect}) {
    $dbh->disconnect();
    return $helpconnect, '', undef;
}

$dbh->{AutoCommit} = 0 unless $arg->{AutoCommit};
return $helpconnect, '', $dbh;

} ## end of connect_database


sub build_command {

    ## Build a command to pass to the system, quoting as needed
    my $string = shift;
    my $args = shift;
    my $effect = shift || '';
    my $x = 0;

    $string =~ s!([A-Z]{2}[A-Z_]+)!
      {
       my $var = $args->[$x++];
       if (not defined $var) {
         my $line = (caller)[2];
         die "Invalid command string from line $line\n";
       }
       if ($var =~ /\s/) {
           if ($effect eq 'backslash_spaces') {
               $var =~ s/ /\\ /g;
               $var;
           }
           else {
               qq{"$var"};
           }
       }
       else {
           $var;
       }
      }
      !gex;

    ## Quick test to rule out shenanigans
    (my $tempstring = $string) =~ s/ /SPACE/g;
    if ($tempstring =~ /\s/) {
        warn "Found non-space whitespace in command string: $tempstring\n";
        Test::More::BAIL_OUT('Invalid whitespace found in command');
        exit 1;
    }

    ## If this is Windows, do not specify a socket directory
    if ($^O =~ /Win32/) {
        $string =~ s/-o '-k .*?' -l/-l/;
    }

    my $debug = $ENV{DBDPG_DEBUG} || 0;
    $debug and Test::More::diag "Built command: ($string)";

    return $string;
}


sub is_super {

    return $superuser;

}


sub get_test_settings {

    ## Returns test database information from the testfile if it exists
    ## Defaults to ENV variables or blank

    ## Find the best candidate for the pg_ctl program
    my $pg_ctl = 'pg_ctl';
    my $initdb = 'default';
    if (exists $ENV{POSTGRES_HOME} and -e "$ENV{POSTGRES_HOME}/bin/pg_ctl") {
        $pg_ctl = "$ENV{POSTGRES_HOME}/bin/pg_ctl";
        $initdb = "$ENV{POSTGRES_HOME}/bin/initdb";
    }
    elsif (exists $ENV{DBDPG_INITDB} and -e $ENV{DBDPG_INITDB}) {
        ($pg_ctl = $ENV{DBDPG_INITDB}) =~ s/initdb/pg_ctl/;
    }
    elsif (exists $ENV{PGINITDB} and -e $ENV{PGINITDB}) {