view release on metacpan or  search on metacpan

j_test.pl  view on Meta::CPAN

	exit 1;
}

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

print "Testing: \$dbh->prepare( 'INSERT INTO $test_tabname VALUES ( \'Mr. ¥Þ¥¤¥¯\', \'¥Þ¥°¡¼\', 73, 99)' ): ";
( $sth = $dbh->prepare ( "INSERT INTO $test_tabname VALUES( \'Mr. ¥Þ¥¤¥¯\', \'¥Þ¥°¡¼\', 73, 99, \'Mr. ¥Þ¥®¥é\', \'¥´¥ê¥é\', 13, 98, \'Mr. ¥Ð¡¼¥Ë¡¼\', \'¥é¥Ö¥ë\', 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 ¼±ÊÌ»Ò = 22 WHERE  ̾»ú match \'¥Þ*\'' ): ";
( $sth = $dbh->prepare ( "UPDATE $test_tabname SET ¼±ÊÌ»Ò = 22 WHERE ̾»ú match \'¥Þ*\'" ) )
    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 ¼±ÊÌ»Ò < 5' ): ";
( $sth = $dbh->prepare( "DELETE FROM $test_tabname WHERE ¼±ÊÌ»Ò < 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 ¼±ÊÌ»Ò = 1' ): ";
( $cursor = $dbh->prepare( "SELECT * FROM $test_tabname WHERE ¼±ÊÌ»Ò = 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");