#!perl -w -I./t # $Id: 03dbatt.t 12168 2008-12-16 09:48:08Z mjevans $ use Test::More; use strict; my $has_test_nowarnings = 1; eval "require Test::NoWarnings"; $has_test_nowarnings = undef if $@; my $tests = 25 + 4; $tests += 1 if $has_test_nowarnings; plan tests => $tests; $|=1; use_ok('DBI', qw(:sql_types)); use_ok('ODBCTEST'); BEGIN { if (!defined $ENV{DBI_DSN}) { plan skip_all => "DBI_DSN is undefined"; } } END { Test::NoWarnings::had_no_warnings() if ($has_test_nowarnings); } my @row; my $dbh = DBI->connect(); unless($dbh) { BAIL_OUT("Unable to connect to the database $DBI::errstr\nTests skipped.\n"); exit 0; } $dbh->{LongReadLen} = 1000; is($dbh->{LongReadLen}, 1000, "Set Long Read Len"); my $dbname = $dbh->{odbc_SQL_DBMS_NAME}; #### testing set/get of connection attributes $dbh->{RaiseError} = 0; $dbh->{AutoCommit} = 1; ok($dbh->{AutoCommit}, "AutoCommit set on dbh"); my $rc = commitTest($dbh); diag(" Strange: " . $dbh->errstr . "\n") if ($rc < -1); SKIP: { skip "skipped due to lack of transaction support", 3 if ($rc == -1); is($rc, 1, "commitTest with AutoCommit"); $dbh->{AutoCommit} = 0; ok(!$dbh->{AutoCommit}, "AutoCommit turned off"); $rc = commitTest($dbh); diag(" Strange: " . $dbh->errstr . "\n") if ($rc < -1); is($rc, 0, "commitTest with AutoCommit off"); }; $dbh->{AutoCommit} = 1; ok($dbh->{AutoCommit}, "Ensure autocommit back on"); # ------------------------------------------------------------ my $rows = 0; # Check for tables function working. my $sth; my @table_info_cols = ( 'TABLE_CAT', 'TABLE_SCHEM', 'TABLE_NAME', 'TABLE_TYPE', 'REMARKS', ); my @odbc2_table_info_cols = ( 'TABLE_QUALIFIER', 'TABLE_OWNER', 'TABLE_NAME', 'TABLE_TYPE', 'REMARKS'); SKIP: { $sth = $dbh->table_info(); skip "table_info returned undef sth", 7 unless $sth; my $cols = $sth->{NAME}; isa_ok($cols, 'ARRAY', "sth {NAME} returns ref to array"); diag("\nN.B. Some drivers (postgres/cache) may return ODBC 2.0 column names for the SQLTables result-set e.g. TABLE_QUALIFIER instead of TABLE_CAT"); for (my $i = 0; $i < @$cols; $i++) { # print ${$cols}[$i], ": ", $sth->func($i+1, 3, ColAttributes), # "\n"; ok(($cols->[$i] eq $table_info_cols[$i]) || ($cols->[$i] eq $odbc2_table_info_cols[$i]), "Column test for table_info $i") or diag("${$cols}[$i] ne $table_info_cols[$i]"); if (($cols->[$i] ne $table_info_cols[$i]) && ($cols->[$i] eq $odbc2_table_info_cols[$i])) { diag("Your driver is returning ODBC 2.0 column names for the SQLTables result-set"); diag(" $odbc2_table_info_cols[$i] instead of $table_info_cols[$i]"); } } while (@row = $sth->fetchrow()) { $rows++; } cmp_ok($rows, '>', 0, "must be some tables out there?"); $sth->finish(); }; $rows = 0; $dbh->{PrintError} = 0; my @tables = $dbh->tables; cmp_ok($#tables, '>', 0, "tables returns array"); $rows = 0; if ($sth = $dbh->column_info(undef, undef, $ODBCTEST::table_name, undef)) { while (@row = $sth->fetchrow()) { $rows++; } $sth->finish(); } cmp_ok($rows, '>', 0, "column info returns more than one row for test table"); $rows = 0; if ($sth = $dbh->primary_key_info(undef, undef, $ODBCTEST::table_name, undef)) { while (@row = $sth->fetchrow()) { $rows++; } $sth->finish(); } SKIP: { skip "Primary Key Known to fail using MS Access through 2000", 1 if ($dbname =~ /Access/i); cmp_ok($rows, '>', 0, "primary key count"); }; # test $sth->{NAME} when using non-select statements $sth = $dbh->prepare("update $ODBCTEST::table_name set COL_A = 100 WHERE COL_A = 100"); ok($sth, "prepare update statement returns valid sth "); is(@{$sth->{NAME}}, 0, "update statement has 0 columns returned"); $sth->execute; SKIP: { skip 'Testing $sth->{NAME} after successful execute on update statement known to fail in Postgres', 1 if ($dbname =~ /PostgreSQL/i); is(@{$sth->{NAME}}, 0, "update statement has 0 columns returned 2"); }; is($dbh->{odbc_query_timeout}, 0, 'verify default dbh odbc_query_timeout = 0'); my $sth_timeout = $dbh->prepare("select COL_A from $ODBCTEST::table_name"); is($sth_timeout->{odbc_query_timeout}, 0, 'verify default sth odbc_query_timeout = 0'); $sth_timeout = undef; $dbh->{odbc_query_timeout} = 30; is($dbh->{odbc_query_timeout}, 30, "Verify odbc_query_timeout set ok"); $sth_timeout = $dbh->prepare("select COL_A from $ODBCTEST::table_name"); is($sth_timeout->{odbc_query_timeout}, 30, "verify dbh setting for query_timeout passed to sth"); $sth_timeout->{odbc_query_timeout} = 1; is($sth_timeout->{odbc_query_timeout}, 1, "verify sth query_timeout can be overridden"); # odbc_column_display_size is($dbh->{odbc_column_display_size}, 2001, 'verify default for odbc_column_display_size'); ok($dbh->{odbc_column_display_size} = 3000, 'set odbc_column_display_size'); is($dbh->{odbc_column_display_size}, 3000, 'verify changed odbc_column_display_size'); $dbh->disconnect; exit 0; # avoid annoying warning print $DBI::errstr; # print STDERR $dbh->{odbc_SQL_DRIVER_ODBC_VER}, "\n"; # ------------------------------------------------------------ # returns true when a row remains inserted after a rollback. # this means that autocommit is ON. # ------------------------------------------------------------ sub commitTest { my $dbh = shift; my @row; my $rc = -2; my $sth; # since this test deletes the record, we should do it regardless # of whether or not it the db supports transactions. $dbh->do("DELETE FROM $ODBCTEST::table_name WHERE COL_A = 100") or return undef; { # suppress the "commit ineffective" warning local($SIG{__WARN__}) = sub { }; $dbh->commit(); } my $supported = $dbh->get_info(46); # SQL_TXN_CAPABLE # print "Transactions supported: $supported\n"; if (!$supported) { return -1; } @row = ODBCTEST::get_type_for_column($dbh, 'COL_D'); my $dateval; if (ODBCTEST::isDateType($row[1])) { $dateval = "{d '1997-01-01'}"; } else { $dateval = "{ts '1997-01-01 00:00:00'}"; } $dbh->do("insert into $ODBCTEST::table_name values(100, 'x', 'y', $dateval)"); { # suppress the "rollback ineffective" warning local($SIG{__WARN__}) = sub { }; $dbh->rollback(); } $sth = $dbh->prepare("SELECT COL_A FROM $ODBCTEST::table_name WHERE COL_A = 100"); $sth->execute(); if (@row = $sth->fetchrow()) { $rc = 1; } else { $rc = 0; } # in case not all rows have been returned..there shouldn't be more than one. $sth->finish(); $rc; } # ------------------------------------------------------------