# Hej, Emacs, give us -*- perl -*- mode here!
#
# $Id: pNET.mtest,v 1.1.1.1 1999/06/13 12:59:36 joe Exp $
#
# database specific definitions for the DBI proxy 'DBD::pNET'
#
# DSN being used; EDIT THIS!
#
my $cipherDef = "";
my ($hostname, $dsn);
if (!$test_dsn) {
die "Need \$test_dsn being set in lib.pl.\n";
}
if ($dbdriver eq 'Ingres') {
$hostname = $ENV{'II_HOST'} || $ENV{'PNET_HOST'} || 'localhost';
} else {
$hostname = $ENV{'PNET_HOST'} || 'localhost';
}
TryToConnect($hostname, $test_dsn, $test_user, $test_password);
$dsn = "DBI:pNET:hostname=$hostname:port=3334";
$@ = '';
eval "use Crypt::DES";
if (!$@) {
$dsn .= ":key=0123456789abcdef:cipher=DES";
$cipherDef .= " encryption DES\n"
. " key 0123456789abcdef\n"
. " encryptModule Crypt::DES\n";
eval "use Crypt::IDEA";
if (!$@) {
$dsn .= ":userkey=0123456789abcdef0123456789abcdef"
. ":usercipher=IDEA";
$cipherDef .= " $test_user encrypt=\"Crypt::IDEA,IDEA,"
. "0123456789abcdef0123456789abcdef\"\n"
}
}
$test_dsn = "$dsn:dsn=DBI:$dbdriver:test";
# For testing DBD::pNET, we need a server available. So, fork
# a child and let it run as a server.
$childPid = undef;
sub childGone () {
my $pid = wait;
if (defined($childPid) && $pid == $childPid) {
undef $childPid;
}
$SIG{'CHLD'} = \&childGone;
}
sub StartServer () {
my ($path, $file, $clients);
if (!open(CLIENTS, ">t/clients")) {
die "Cannot create 'clients' file: $!\n";
}
print CLIENTS <<"EOF";
accept localhost
users $test_user
$cipherDef
deny .*
EOF
close(CLIENTS);
foreach $file ("./blib/script/pNETagent",
"../blib/script/pNETagent",
"./pNETagent",
"../pNETagent") {
if (-x $file) {
$path = $file;
last;
}
}
if (!$path) {
die "Cannot find pNETagent script.\n";
}
$SIG{'CHLD'} = \&childGone;
my $pid;
if (!defined($pid = fork())) {
die "Cannot fork: $!";
}
if (!$pid) {
# This is the child, start as the server
exec "perl -Iblib/lib -Iblib/arch $path --port 3334 --debug --configFile t/clients --pidFile pNETagent.pid";
} else {
$childPid = $pid;
}
}
sub StopServer () {
if (defined($childPid)) {
kill 15, $childPid;
undef $childPid;
sleep 5;
}
}
use Sys::Syslog;
if (defined(&Sys::Syslog::setlogsock)) {
Sys::Syslog::setlogsock('unix');
}
Sys::Syslog::openlog($0, '', 'daemon');
StartServer();
sleep 5;
END {
StopServer();
# if (-f 't/clients') { unlink 't/clients'; }
if (-f 'pNETagent.pid') { unlink 'pNETagent.pid'; }
exit 0;
}
############################################################################
#
# For typical drivers, we'd define a function ListTables here.
# As of pNET, however, we are interested in using $dbdriver's
# ListTables function.
#
# As a workaround we define a hook $listTablesHook pointing to
# pNetListTables, that's called from within FindNewTable.
# Advantages are:
#
# - We reuse the drivers ListTables
# - We don't bother driver authors and testers with details
# of DBD::pNET.
#
# Drawback is, this is getting somewhat complicated ...
#
############################################################################
use vars qw($listTablesHook);
{
my $listTablesData;
my $listTablesHostname;
sub TryToConnect ($$$$) {
my ($hostname, $dsn, $user, $password) = @_;
$listTablesData = [HostDsn($hostname, $dsn), $user, $password];
my $dbh = eval { DBI->connect(@$listTablesData) };
if (!$dbh) {
if( $0 !~ /00base\.t/) {
print "1..0\n";
print STDERR q{
Unable to execute test suite on this platform. The test suite can only be
executed if a
DBI->connect("DBI:$dbdriver:test", "$test_user", "$test_password");
succeeds or you modify the test suite.
};
exit 0;
}
} else {
$listTablesHook = \&pNetListTables;
$dbh->disconnect;
my $file;
}
}
sub pNetListTables ($) {
my ($dbh) = shift;
my ($ndbh) = DBI->connect(@$listTablesData);
if (!$ndbh) {
die "Cannot connect to dsn " . $listTablesData->[0] . ":"
. $DBI::errstr;
}
my @tables = ListTables($ndbh);
$ndbh->disconnect;
@tables;
}
}
1;