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

$| = 1;
print "1..$::tests\n";

require DBI;
use strict;
use testenv;

my (@row);

my ($dsn, $user, $pass) = soluser();
print "ok 1\n";

my $dbh = DBI->connect($dsn, $user, $pass, {PrintError => 0}); 
print "not " unless($dbh);
print "ok 2\n";
exit(1) unless($dbh);

#### testing Tim's early draft DBI methods

my $foo = $DBI::errstr;		# suppress possible typo warnings
   $foo = $DBI::err;
   $foo = $DBI::state;
   $foo = $DBI::VERSION;

my ($t);
$t = 3;
$t = test_autocommit_init($dbh, $t);	# 3
$t = test_rows($dbh, $t);		# 4
$t = test_err($dbh, $t);		# 5
$t = test_errstr($dbh, $t);		# 6..8
$t = test_state($dbh, $t);		# 9

$dbh->disconnect();

BEGIN { $::tests = 9; }

sub test_autocommit_init
    {
    my ($dbh, $test) = (@_);
    print " Test $test: initial AutoCommit\n";

    print "not " unless $dbh->{AutoCommit};
    print "ok $test\n";
    ++$test;
    }

sub test_rows
    {
    my ($dbh, $test) = (@_);
    print " Test $test: rows attribute\n";
    my ($sth, $rows);

    $sth = $dbh->prepare("select count(*) from perl_dbd_test");
    $sth->execute();
    ($rows) = $sth->fetchrow;
    print " rows to delete: $rows\n";
    $sth->finish();

    $dbh->{AutoCommit} = 0;
    $sth = $dbh->prepare("DELETE FROM perl_dbd_test");
    $sth->execute();
    print " $DBI::rows rows deleted\n";
    print "not " unless($sth->rows > 0 
		    && $DBI::rows == $sth->rows);
    $sth->finish();
    $dbh->rollback();
    print "ok $test\n";
    ++$test;
    }

sub test_err
    {
    my ($dbh, $test) = (@_);
    print " Test $test: err attribute\n";

    my ($sth, @row);
    $sth = $dbh->prepare('SELECT x FROM perl_dbd_test WHERE 1 = 0');

    print "not " unless ($DBI::err == 13
			 && $dbh->err == $DBI::err);
    print "ok $test\n";
    ++$test;

    $test;
    }

sub test_errstr
    {
    my ($dbh, $test) = (@_);
    my $expectedErr = 'Table name PERL_DBD_TEST conflicts with an existing'
                      . ' entity';
    print " Test $test: errstr attribute\n";

    my ($sth, @row);
    $sth = $dbh->prepare('CREATE TABLE perl_dbd_test( A INTEGER )');
    $sth->execute();

    print " err=", $sth->err, " errstr=", $sth->errstr, "\n";

    print "not " unless ($sth->errstr =~ /$expectedErr/);
    print "ok $test\n";
    ++$test;

    $sth->execute();
    print "not " unless ($DBI::errstr =~ /$expectedErr/);
    print "ok $test\n";
    ++$test;

    $sth->execute();
    print "not " unless ($dbh->errstr =~ /$expectedErr/);
    print "ok $test\n";
    ++$test;

    $sth->finish();
    $test;
    }
sub test_state
    {
    my ($dbh, $test) = (@_);
    print " Test $test: state attribute\n";

    my ($sth, @row);
    $sth = $dbh->prepare('SELECT * FROM perl_dbd_test WHERE 1 = ?');
    $sth->execute('foobar');

    print " err=", $sth->err, " state=", $dbh->state,"\n";
    
#    print "not " if ($dbh->state != 22005
#    		     || $DBI::state != 22005
#		     || ($DBI::VERSION gt '0.82' && $sth->state != 22005));
    
    print "not " if ( $dbh->state ne '07006'
                  || $DBI::state ne '07006'
                  || ($DBI::VERSION gt '0.82' && $sth->state ne '07006') );
    
    $sth->finish();
    print "ok $test\n";
    ++$test;
    }
__END__