#!/usr/bin/perl

# Check commit, rollback and "AutoCommit" attribute

use strict;
use warnings;
use Test::More;

BEGIN { use_ok ("DBI") }
do "t/lib.pl";

my $nano = $ENV{DBI_SQL_NANO};
my @tbl_def = (
    [ "id",   "INTEGER",  4, 0 ],
    [ "name", "CHAR",    64, 0 ],
    );

sub RowCount
{
    my ($dbh, $tbl) = @_;

    if ($nano) {
	diag ("SQL::Nano does not support count (*)");
	return 0;
	}

    local $dbh->{PrintError} = 1;
    my $sth = $dbh->prepare ("SELECT count (*) FROM $tbl") or return;
    $sth->execute or return;
    my $row = $sth->fetch or return;
    $row->[0];
    } # RowCount

ok (my $dbh = Connect (),			"connect");

ok (my $tbl = FindNewTable ($dbh),		"find new test table");

like (my $def = TableDefinition ($tbl, @tbl_def),
	qr{^create table $tbl}i,		"table definition");
ok ($dbh->do ($def),				"create table");

is ($dbh->{AutoCommit}, 1,			"AutoCommit on");

eval { $dbh->{AutoCommit} = 0; };
like ($@, qr{^Can't disable AutoCommit},	"disable");
is ($dbh->{AutoCommit}, 1,			"AutoCommit still on");

# Check whether AutoCommit mode works.
ok ($dbh->do ("insert into $tbl values (1, 'Jochen')"), "insert 1");
is (RowCount ($dbh, $tbl), $nano ? 0 : 1,	"1 row");

ok ($dbh->disconnect,				"disconnect");

ok ($dbh = Connect (),				"connect");
is (RowCount ($dbh, $tbl), $nano ? 0 : 1,	"still 1 row");

# Check whether commit issues a warning in AutoCommit mode
ok ($dbh->do ("insert into $tbl values (2, 'Tim')"), "insert 2");
is ($dbh->{AutoCommit}, 1,			"AutoCommit on");
{   my $got_warn = 0;
    local $SIG{__WARN__} = sub { $got_warn++; };
    eval { ok ($dbh->commit,			"commit"); };
    is ($got_warn, 1,				"warning");
    }

# Check whether rollback issues a warning in AutoCommit mode
# We accept error messages as being legal, because the DBI
# requirement of just issueing a warning seems scary.
ok ($dbh->do ("insert into $tbl values (3, 'Alligator')"), "insert 3");
is ($dbh->{AutoCommit}, 1,			"AutoCommit on");
{   my $got_warn = 0;
    local $SIG{__WARN__} = sub { $got_warn++; };
    eval { is ($dbh->rollback, 0,		"rollback"); };
    is ($got_warn, 1,				"warning");
    is ($dbh->err, undef,			"err");
    }

ok ($dbh->do ("drop table $tbl"),		"drop table");
ok ($dbh->disconnect,				"disconnect");

done_testing ();