view release on metacpan or  search on metacpan

t/02simple.t  view on Meta::CPAN

#!perl -w -I./t

use Test::More;
use strict;
use Config;
use DBD::ODBC;

$| = 1;

my $has_test_nowarnings = 1;
eval "require Test::NoWarnings";
$has_test_nowarnings = undef if $@;
my $tests = 65;
$tests += 1 if $has_test_nowarnings;
plan tests => $tests;

use_ok('DBI', qw(:sql_types));
use_ok('ODBCTEST');
#use_ok('Data::Dumper');

BEGIN {
   if (!defined $ENV{DBI_DSN}) {
      plan skip_all => "DBI_DSN is undefined";
   }
}
END {
    Test::NoWarnings::had_no_warnings()
          if ($has_test_nowarnings);
}


my $dbh = DBI->connect();
unless($dbh) {
   BAIL_OUT("Unable to connect to the database ($DBI::errstr)\nTests skipped.\n");
   exit 0;
}
my $driver_name;
# Output DBMS which is useful when debugging cpan-testers output
{
    diag("\n");
    diag("Perl $Config{PERL_REVISION}.$Config{PERL_VERSION}.$Config{PERL_SUBVERSION}\n");
    diag("osname=$Config{osname}, osvers=$Config{osvers}, archname=$Config{archname}\n");
    diag("Using DBI $DBI::VERSION\n");
    diag("Using DBD::ODBC $DBD::ODBC::VERSION\n");
    diag("Using DBMS_NAME " . DBI::neat($dbh->get_info(17)) . "\n");
    diag("Using DBMS_VER " . DBI::neat($dbh->get_info(18)) . "\n");
    $driver_name = DBI::neat($dbh->get_info(6));
    diag("Using DRIVER_NAME $driver_name\n");
    diag("Using DRIVER_VER " . DBI::neat($dbh->get_info(7)) . "\n");
    diag("odbc_has_unicode " . ($dbh->{odbc_has_unicode} || '') . "\n");
}

# ReadOnly
{
    # NOTE: the catching of warnings here needs a DBI > 1.628
	local $dbh->{AutoCommit} = 0;
    my $warning;
    local $SIG{__WARN__} = sub {diag "AA:"; diag @_; $warning = 1};
    $dbh->{ReadOnly} = 1;
    if ($warning) {
        diag "Your ODBC driver does not support setting ReadOnly";
    }
    is($dbh->{ReadOnly}, 1, 'ReadOnly set');
    $dbh->{ReadOnly} = 0;
    is($dbh->{ReadOnly}, 0, 'ReadOnly cleared');
}


#
# test private_attribute_info.
# connection handles and statement handles should return a hash ref of
# private attributes
#
SKIP: {
    skip "DBI too old for private_attribute_info", 3
	if ($DBI::VERSION < 1.54);
    my $pai = $dbh->private_attribute_info();
    #diag Data::Dumper->Dump([$pai], [qw(dbc_private_attribute_info)]);
    ok(defined($pai), 'dbc private_attribute_info result');
    ok(ref($pai) eq 'HASH', 'dbc private_attribute_info is hashref');
    ok(scalar(keys %{$pai}) >= 1,
       'dbc private_attribute_info has some attributes');
};

SKIP: {
    skip "DBI too old for private_attribute_info", 3
	if ($DBI::VERSION < 1.54);

    my $sql;
    my $drv = $dbh->get_info(17);
    if ($drv =~ /Oracle/i) {
        $sql = q/select 1 from dual/;
    } elsif ($drv =~ /Firebird/i) {
        $sql = q/select 1 from rdb$database/;
    } else {
        $sql = q/select 1/;
    }
    my $sth = $dbh->prepare($sql);
    my $pai = $sth->private_attribute_info();
    #diag Data::Dumper->Dump([$pai], [qw(stmt_private_attribute_info)]);
    ok(defined($pai), 'stmt private_attribute_info result');
    ok(ref($pai) eq 'HASH', 'stmt private_attribute_info is hashref');
    ok(scalar(keys %{$pai}) >= 1, 'stmt private_attribute_info has some attributes');
    $sth->finish;
};

#
# Test changing of AutoCommit - start by setting away from the default
#
$dbh->{AutoCommit} = 0;