# Hej, Emacs, give us -*- perl mode here!
#
# $Id: lib.pl,v 1.1812 1997/09/27 14:34:47 joe Exp $
#
# lib.pl is the file where database specific things should live,
# whereever possible. For example, you define certain constants
# here and the like.
#
require 5.003;
use strict;
use vars qw($mdriver $dbdriver $childPid $test_dsn $test_user $test_password
$verbose);
$verbose=!!$ENV{DBD_ILLUSTRA_VERBOSE};
#
# Driver names; EDIT THIS!
#
$mdriver = 'Illustra';
$dbdriver = 'Illustra'; # $dbdriver is usually just the same as $mdriver.
# The exception is DBD::pNET where we have to
# to separate between local driver (pNET) and
# the remote driver ($dbdriver)
#
# DSN being used; do not edit this, edit "$dbdriver.dbtest" instead
#
$test_dsn = $ENV{'DBI_DSN'} || "DBI:$dbdriver:test";
$test_user = $ENV{'DBI_USER'} || '';
$test_password = $ENV{'DBI_PASS'} || '';
$::COL_NULLABLE = 1;
$::COL_KEY = 2;
my $file;
if (-f ($file = "t/$dbdriver.dbtest") || -f ($file = "$dbdriver.dbtest")) {
eval { require $file; };
if ($@) {
print STDERR "Cannot execute $file: $@.\n";
print "1..0\n";
exit 0;
}
}
if (-f ($file = "t/$mdriver.mtest") || -f ($file = "$mdriver.mtest")) {
eval { require $file; };
if ($@) {
print STDERR "Cannot execute $file: $@.\n";
print "1..0\n";
exit 0;
}
}
#
# The Testing() function builds the frame of the test; it can be called
# in many ways, see below.
#
# Usually there's no need for you to modify this function.
#
# Testing() (without arguments) indicates the beginning of the
# main loop; it will return, if the main loop should be
# entered (which will happen twice, once with $state = 1 and
# once with $state = 0)
# Testing('off') disables any further tests until the loop ends
# Testing('group') indicates the begin of a group of tests; you
# may use this, for example, if there's a certain test within
# the group that should make all other tests fail.
# Testing('disable') disables further tests within the group; must
# not be called without a preceding Testing('group'); by default
# tests are enabled
# Testing('enabled') reenables tests after calling Testing('disable')
# Testing('finish') terminates a group; any Testing('group') must
# be paired with Testing('finish')
#
# You may nest test groups.
#
{
# Note the use of the pairing {} in order to get local, but static,
# variables.
my (@stateStack, $count, $off);
$count = 0;
sub Testing(;$) {
my ($command) = shift;
if (!defined($command)) {
@stateStack = ();
$off = 0;
if ($count == 0) {
++$count;
$::state = 1;
} elsif ($count == 1) {
my($d);
if ($off) {
print "1..0\n";
exit 0;
}
++$count;
$::state = 0;
print "1..$::numTests\n";
} else {
return 0;
}
if ($off) {
$::state = 1;
}
$::numTests = 0;
} elsif ($command eq 'off') {
$off = 1;
$::state = 0;
} elsif ($command eq 'group') {
push(@stateStack, $::state);
} elsif ($command eq 'disable') {
$::state = 0;
} elsif ($command eq 'enable') {
if ($off) {
$::state = 0;
} else {
my $s;
$::state = 1;
foreach $s (@stateStack) {
if (!$s) {
$::state = 0;
last;
}
}
}
return;
} elsif ($command eq 'finish') {
$::state = pop(@stateStack);
} else {
die("Testing: Unknown argument\n");
}
return 1;
}
#
# Read a single test result
#
sub Test ($;$$) {
my($result, $error, $diag) = @_;
++$::numTests;
if ($count == 2) {
if ($::verbose && defined($diag)) {
printf("$diag%s", (($diag =~ /\n$/) ? "" : "\n"));
}
if ($::state || $result) {
print "ok $::numTests\n";
return 1;
} else {
printf("not ok $::numTests%s\n",
(defined($error) ? " $error" : ""));
return 0;
}
}
return 1;
}
}
#
# Print a DBI error message
#
sub DbiError ($$) {
my($rc, $err) = @_;
if ($::verbose) {
print "Test $::numTests: DBI error $rc, $err\n";
}
}
#
# This functions generates a list of possible DSN's aka
# databases and returns a possible table name for a new
# table being created.
#
# Problem is, we have two different situations here: Test scripts
# call us by pasing a dbh, which is fine for most situations.
# From within DBD::pNET, however, the dbh isn't that meaningful.
# Thus we are working with the global variable $listTablesHook:
# Once defined, we call &$listTablesHook instead of ListTables.
#
# See DBD::pNET/t/pNET.mtest for details.
#
{
use vars qw($listTablesHook);
my(@tables, $testtable, $listed);
$testtable = "testaa";
$listed = 0;
sub FindNewTable($) {
my($dbh) = @_;
if (!$listed) {
if (defined($listTablesHook)) {
@tables = &$listTablesHook($dbh);
} elsif (defined(&ListTables)) {
@tables = &ListTables($dbh);
} else {
die "Fatal: ListTables not implemented.\n";
}
$listed = 1;
}
# A small loop to find a free test table we can use to mangle stuff in
# and out of. This starts at testaa and loops until testaz, then testba
# - testbz and so on until testzz.
my $foundtesttable = 1;
my $table;
while ($foundtesttable) {
$foundtesttable = 0;
foreach $table (@tables) {
if ($table eq $testtable) {
$testtable++;
$foundtesttable = 1;
}
}
}
$table = $testtable;
$testtable++;
$table;
}
}
sub ErrMsg (@) { if ($verbose) { print (@_); } }
sub ErrMsgF (@) { if ($verbose) { printf (@_); } }
1;