The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!/usr/bin/perl

use strict;
use warnings;

use Test::More;

# Test if all of the documented DBI API is implemented and working OK

BEGIN { use_ok ("DBI") }

# =============================================================================

my ($schema, $dbh) = ("DBUTIL");

#eval q{ {
#    local $ENV{UNIFY};
#    $dbh = DBI->connect ("dbi:Unify:", "", "", {
#	RaiseError => 0,
#	PrintError => 0,
#	});
#    } };
#like ($DBI::errstr, qr{UNIFY' directory does not exist},	"undefined \$UNIFY");

ok ($dbh = DBI->connect ("dbi:Unify:", "", $schema), "connect");

unless ($dbh) {
    BAIL_OUT ("Unable to connect to Unify ($DBI::errstr)\n");
    exit 0;
    }

# =============================================================================

ok ( DBD::Unify->driver,	"Top level driver");

# Attributes common to all handles

ok ( $dbh->{Warn},		"Warn");
ok ( $dbh->{Active},		"Active");
is ( $dbh->{Kids}, 0,		"Kids");
ok (!$dbh->{CachedKids} || 0 == keys %{$dbh->{CachedKids}}, "CachedKids");
is ( $dbh->{ActiveKids}, 0,	"ActiveKids");
ok (!$dbh->{CompatMode},	"CompatMode");

# =============================================================================

my @tables;
ok (@tables = $dbh->tables, "tables");
y/"//d for @tables;	# get_info (29) now returns "
ok ((1 == grep m/^SYS\.ACCESSIBLE_TABLES$/, @tables), "SYS.ACCESSIBLE_TABLES");
ok (@tables = $dbh->tables (undef, "SYS", "ACCESSIBLE_COLUMNS", "VIEW"), "tables (args)");
y/"//d for @tables;	# get_info (29) now returns "
ok (@tables == 1 && $tables[0] eq "SYS.ACCESSIBLE_COLUMNS", "got only one");

# =============================================================================

# Lets assume this is a default installation, and the DBA has *not* removed
# the DIRS table ;-)

ok ($dbh->do ("update DIRS set DIRNAME = 'Foo' where DIRNAME = '^#!\" //'"), "do update");
{   # Disable the warner, as the attributes are still unused
    local $SIG{__WARN__} = sub {};

    ok ($dbh->do ("update DIRS set DIRNAME = 'Foo' where DIRNAME = '^#!\" //'",
	{ uni_verbose => 1 }), "do () with 'unused' attributes");

    ok ($dbh->do ("update DIRS set DIRNAME = ? where DIRNAME = ?",
	{ uni_verbose => 1 },
	"Foo", '^#!\" //'), "do () with 'unused' params");
    }

ok ($dbh->rollback,	"rollback");
ok ($dbh->commit,	"commit");

ok ($dbh->do ("update DIRS set DIRNAME = 'Foo' where DIRNAME = '^#!\" //'"), "do () reverse");

# =============================================================================

ok ($dbh->disconnect,	"disconnect");
ok (!$dbh->{Active},	"!Active");
ok (!$dbh->ping,	"!ping");

done_testing;