The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#
#	$Id: test.pl, Empress Software Inc., 0.45, Mon Jul 15 11:15:45 Canada/Eastern 1996
#

#BEGIN{unshift @INC, "../../lib", "./lib";}

use DBI "0.89";
use Sys::Hostname;
use Cwd;

if (open (fd, "/bin/bsh"))
{
	$my_bourne_shell = "/bin/bsh";
}
elsif (open (fd, "/bin/sh"))
{
	$my_bourne_shell = "/bin/sh";
}
else
{
	die ("Can't find Bourne shell");
} 
close fd; 

printf "Bourne shell on this machine is $my_bourne_shell\n";

my $test_dbname	= 'test_db';
my $conn_dbname	= 'test_db';
my $test_tabname = 'test_table';
my $nconnect	= 10;		# no of times to loop in testing connect
my $ncreate	= 10;		# no of times to loop in testing create/drop table
my ($iconnect, $icreate);

$mspath = $ENV{MSPATH};
if ($mspath)
{
	print "Using Empress Version located at $mspath\n";
}
else
{
	print "MSPATH not set\n";
	exit 1;
}

#----------------------------------------------------------------------
# Which version of DBD::Empress 
#----------------------------------------------------------------------
$dsql = FALSE;
print ("Running tests in Network mode\n");

$host = hostname ();
$dir  = cwd ();
$myuser = getpwuid $<;
system ("rm -rf config");
system ("mkdir config");
$conn_dbname	= "SERVER=$host;Database=test_db;UID=$myuser;PWD=";
open (ODBC, ">config/srv.conf") 
                       || die ("open server config file failed");
print ODBC "EMPODBC_WORKINGDIR = $dir\n";
print ODBC "EMPODBC_PASSWDFILE = $dir/config/passwd\n";
print ODBC "EMPODBC_LOGFILE = $dir/odbc.log\n";
close ODBC;
open (PWORD, ">config/passwd");
print PWORD "$myuser";
print PWORD "::::::\n";
close PWORD;        
$ENV {"MSODBCSRVCFGFILE"} = "$dir/config/srv.conf";
system ("$mspath/bin/empodbc", "-v1") != 256
               or die ("System call to empodbc failed\nIs a server already running?");

# Now redirect errors to file
$stderr_file = "test.stderr.$$";
open (STDERR, ">$stderr_file") || die ("open STDERR output file $stderr_file failed");


# --------------------------------------------------------------------------
# TODO: This section is not generic!!!
# --------------------------------------------------------------------------

my $mkdbcmd	= "$mspath/bin/empmkdb $test_dbname";
my $mktabcmd	= "$mspath/bin/empcmd $test_dbname \"run from \'$test_dbname.schema\'\"";
my $mkdatacmd	= "$mspath/bin/empcmd $test_dbname \"run from \'$test_dbname.data\'\"";
my $rmdbcmd	= "rm -rf $test_dbname";

# --------------------------------------------------------------------------
# install the Empress driver
# --------------------------------------------------------------------------

print "Testing: DBI->install_driver( 'EmpressNet' ): ";
( $drh = DBI->install_driver( 'EmpressNet' ) )
  and print( "ok\n" )
  or die "not ok: $DBI::errstr\n";

# -----------------------------------------------------------------------
# set Empress low-level debugging.  Set to 0 .. 4.
# -----------------------------------------------------------------------

DBI->internal->{DebugDispatch} = 0;

# --------------------------------------------------------------------------
# create the testing database 
# --------------------------------------------------------------------------

# TODO: This section is not generic!!!

# remove the db if it exists
if ( -d $test_dbname ) {
	print "Removing old database '$test_dbname'...";
	$st = system ($rmdbcmd);
	if ( -d $test_dbname ) {
		print "failed... exiting.\n";
		exit 1;
	}
	print "... ok\n";
}

# make db
print "Making database '$test_dbname'...";
$st = system ($mkdbcmd);
if ( $st & 256 ) {	# this checks the exit status of empmkdb...
	print "... command '$mkdbcmd' failed ($st)... exiting.\n";
	exit 1;
}
print "...ok\n";


# --------------------------------------------------------------------------
# connect/disconnect to the testing database, repeatedly
# --------------------------------------------------------------------------

print "Test repeated connect/disconnect: \$drh->connect( '$conn_dbname' ):\n";
for $iconnect (1 .. $nconnect) {

	( $dbh = DBI->connect( "DBI:EmpressNet:$conn_dbname" ) )
	    and print(" c$iconnect\n") 
	    or die "not ok on connect $iconnect: $DBI::errstr\n";
	
	( $dbh->disconnect )
	    and print(" d$iconnect\n") 
	    or die "not ok on disconnect $iconnect: $DBI::errstr\n";

}

# --------------------------------------------------------------------------
# test the db handle functions.
# --------------------------------------------------------------------------

print "Test db handle functions\n";
( $dbh = $drh->connect( $conn_dbname ) )
    and print( "connect ok\n" )
    or die "connect not ok: $DBI::errstr\n";

# -----------------------------------------------------------------------
# test repeated table creation/table drop
# -----------------------------------------------------------------------

for $icreate (1 .. $ncreate) {

	# ------------ create

	print "Testing: \$dbh->prepare('create table $test_tabname')\n";
	( $sth = $dbh->prepare( "CREATE TABLE $test_tabname ( fname nlschar, lname nlschar, age integer, id longinteger )" ) )
	    and print( "ok ($icreate)\n" )
	    or die "not ok ($icreate): $DBI::errstr\n";

	print "Testing: \$sth->execute()\n";
	( $sth->execute )
	    and print( "ok ($icreate)\n" )
	    or die "not ok ($icreate): $DBI::errstr\n";
	
	# ------------ drop

	print "Testing: \$dbh->prepare('drop table $test_tabname')\n";
	( $sth = $dbh->prepare( "DROP TABLE $test_tabname" ) )
	    and print( "ok ($icreate)\n" )
	    or die "not ok ($icreate): $DBI::errstr\n";
	
	print "Testing: \$sth->execute()\n";
	( $sth->execute )
	    and print( "ok ($icreate)\n" )
	    or die "not ok ($icreate): $DBI::errstr\n";
}

# -----------------------------------------------------------------------
# create a table to do further tests with
# -----------------------------------------------------------------------

print "Testing: \$dbh->prepare('create table $test_tabname')\n";
( $sth = $dbh->prepare( "CREATE TABLE $test_tabname ( fname nlschar, lname nlschar, age integer, id longinteger )" ) )
    and print( "ok ($icreate)\n" )
    or die "not ok ($icreate): $DBI::errstr\n";

print "Testing: \$sth->execute()\n";
( $sth->execute )
    and print( "ok\n" )
    or die "not ok: $DBI::errstr\n";

# -----------------------------------------------------------------------
# bulk insert into the table (from a file)
# -----------------------------------------------------------------------
 
print "bulk insertion into table '$test_tabname'\n";
$st = system ($mkdatacmd);
if ( $st & 256 ) {      # this checks the exit status of empcmd...
	print "Insert data command '$mkdatacmd' failed ($st)... exiting.\n";
	exit 1;
}

# -----------------------------------------------------------------------
# insert into the table
# -----------------------------------------------------------------------

print "Testing: \$dbh->prepare( 'INSERT INTO $test_tabname VALUES ( \'Mr. Mike\', \'Magoo\', 73, 99)' ): ";
( $sth = $dbh->prepare ( "INSERT INTO $test_tabname VALUES( \'Mr. Mike\', \'Magoo\', 73, 99, \'Mr. Magilla\', \'Gorilla\', 13, 98, \'Mr. Barney\', \'Rubble\', 35, 97 )" ) )
    and print( "prepare insert ok\n" )
    or die "prepare insert not ok: $DBI::errstr\n";

( $sth->execute )
    and print( "execute insert ok\n" )
    or die "execute insert not ok: $DBI::errstr\n";

# -----------------------------------------------------------------------
# update the table using a WHERE clause
# -----------------------------------------------------------------------

print "Testing: \$dbh->prepare ( 'UPDATE $test_tabname SET id = 22 WHERE lname match \'M*\'' ): ";
( $sth = $dbh->prepare ( "UPDATE $test_tabname SET id = 22 WHERE lname match \'M*\'" ) )
    and print( "prepare update ok\n" )
    or die "prepare update not ok: $DBI::errstr\n";

( $sth->execute )
    and print( "execute update ok\n" )
    or die "execute update not ok: $DBI::errstr\n";

print "Testing: \$sth->rows(): ";
( $numrows = $sth->rows( ) )
    and print( "rows() ok\n" )
    or die "rows() not ok: $DBI::errstr\n";

print "Rows returned should be: 3\nActual rows returned: $numrows\n";

# -----------------------------------------------------------------------
# delete from the table using a WHERE clause
# -----------------------------------------------------------------------

print "Testing: \$dbh->prepare( 'DELETE FROM $test_tabname WHERE id < 5' ): ";
( $sth = $dbh->prepare( "DELETE FROM $test_tabname WHERE id < 5" ) )
    and print( "prepare delete ok\n" )
    or die "prepare delete not ok: $DBI::errstr\n";

( $sth->execute )
    and print( "execute delete ok\n" )
    or die "execute delete not ok: $DBI::errstr\n";

print "Testing: \$sth->rows():\n ";
( $numrows = $sth->rows( ) )
    and print( "rows() ok\n" )
    or die "rows() not ok: $DBI::errstr\n";

print "Rows returned should be: 3\nActual rows returned: $numrows\n";

# --------------------------------------------------------------------------
# Cursor functions: prepare/execute/fetch/nrows, etc.
# --------------------------------------------------------------------------

print "Testing: \$cursor = \$dbh->prepare( 'SELECT FROM $test_tabname WHERE id = 1' ): ";
( $cursor = $dbh->prepare( "SELECT * FROM $test_tabname WHERE id = 1" ) )
    and print( "prepare select ok\n" )
    or print( "prepare select not ok: $DBI::errstr\n" );

print "Testing: \$cursor->execute: ";
( $cursor->execute )
    and print( "execute select ok\n" )
    or die "execute select not ok: $DBI::errstr\n";

# expect the following select to fail, as id=1 has been deleted already

print "Testing: \$cursor->fetchrow: ";
if ( @row = $cursor->fetchrow ) 
{
	print( "not ok ($DBI::err): $DBI::errstr, record: @row\n" );
}
else
{
	print( "ok\n" );	# expect it to fail for id=1
}

print "Testing: \$cursor->finish: ";
( $cursor->finish )
    and print( "ok\n" )
    or print( "not ok: $DBI::errstr\n" );

# multiple record tests

print "Testing: \$cursor = \$dbh->prepare( 'SELECT FROM $test_tabname' ): ";
( $cursor = $dbh->prepare( "SELECT * FROM $test_tabname" ) )
    and print( "prepare select ok\n" )
    or die "prepare select not ok: $DBI::errstr\n";

print "Testing: \$cursor->execute: ";
( $cursor->execute )
    and print( "ok\n" )
    or die "not ok: $DBI::errstr\n";

print "Testing: multiple \$cursor->fetchrow's:\n";
while ( @row = $cursor->fetchrow ) 
{
    if ( $DBD::EmpressNet::err != 0 )
    {
	print "Fetch Error ($DBD::EmpressNet::err): $DBD::EmpressNet::errstr\n";
    }
    print( "@row\n" )
}

print "Testing: \$cursor->finish: ";
( $cursor->finish )
    and print( "ok\n" )
    or die "not ok: $DBI::errstr\n";

( $dbh->disconnect )
    and print(" d$iconnect\n") 
    or die "not ok on disconnect $iconnect: $DBI::errstr\n";

close (STDERR);

if ($dsql eq FALSE)
{
	print "Shutting down server\n";
	system ("$mspath/bin/empoadm", "svshut", "nowarn");
}

print "*** Testing of DBD::EmpressNet complete! You appear to be normal! ***\n";

# remove the db 
print "Removing database '$test_dbname'...";
$st = system ($rmdbcmd);
if ( -d $test_dbname ) {
	print "failed... exiting.\n";
	exit 1;
}
print "... ok\n";

system ("rm $stderr_file");