The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!/usr/bin/perl -w -I./t
#
# Test odbc_describe_parameters
# Should default to on but you can turn it off in the prepare or at the
# connection level.
#
use Test::More;
use strict;
$| = 1;

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

use DBI qw(:sql_types);
#1
use_ok('ODBCTEST');

my $dbh;

BEGIN {
   if (!defined $ENV{DBI_DSN}) {
      plan skip_all => "DBI_DSN is undefined";
   }
}

END {
    if ($dbh) {
        eval {
            local $dbh->{PrintWarn} = 0;
            local $dbh->{PrintError} = 0;
            $dbh->do(q/drop table PERL_DBD_drop_me/);
        };
        $dbh->disconnect;
    }
    Test::NoWarnings::had_no_warnings()
          if ($has_test_nowarnings);
}

$dbh = DBI->connect();
unless($dbh) {
   BAIL_OUT("Unable to connect to the database $DBI::errstr\nTests skipped.\n");
   exit 0;
}


my ($ev, $sth);

eval {
    local $dbh->{PrintWarn} = 0;
    local $dbh->{PrintError} = 0;
    $dbh->do('drop table PERL_DBD_drop_me');
};

eval {
    $dbh->do('create table PERL_DBD_drop_me (a integer)');
};
$ev = $@;
#2
diag($ev) if $ev;
ok(!$ev, 'create test table with integer');

BAIL_OUT("Failed to create test table") if $ev;

sub default
{
    eval {
        $sth = $dbh->prepare('INSERT into PERL_DBD_drop_me VALUES (?)');
    };
    $ev = $@;
    diag($ev) if $ev;
    #3
    ok($sth && !$@, "prepare insert");

  SKIP: {
        skip "Failed to prepare", 1 if ($ev);

        eval {
            $sth->execute(1);
        };
        $ev = $@;
        diag($ev) if $ev;
        #4
        ok(!$@, "execute ok");
    };

  SKIP: {
        skip "Failed to execute", 1 if ($ev);

        my $pts = $sth->{ParamTypes};
        #5
        is(ref($pts), 'HASH', 'ParamTypes is a hash');
        my @params = keys %$pts;
        #6
        is(scalar(@params), 1, 'one parameter');
        #use Data::Dumper;
        #diag(Dumper($pts->{$params[0]}));
        #7
        # for drivers which don't have SQLDescribeParam the type will
        # be defaulted to SQL_VARCHAR or SQL_WVARCHAR
        ok(($pts->{$params[0]}->{TYPE} == SQL_INTEGER) ||
           ($pts->{$params[0]}->{TYPE} == SQL_LONGVARCHAR) ||
           ($pts->{$params[0]}->{TYPE} == SQL_WLONGVARCHAR) ||
           ($pts->{$params[0]}->{TYPE} == SQL_WVARCHAR) ||
           ($pts->{$params[0]}->{TYPE} == SQL_VARCHAR), 'integer parameter')
            or diag("Param type: " . $pts->{$params[0]}->{TYPE});
    };


}

sub on_prepare
{
    eval {
        $sth = $dbh->prepare('INSERT into PERL_DBD_drop_me VALUES (?)',
                             {
                                 odbc_describe_parameters => 0});
    };
    $ev = $@;
    diag($ev) if $ev;
    #8
    ok($sth && !$@, "prepare insert");

  SKIP: {
        skip "Failed to prepare", 1 if ($ev);

        eval {
            $sth->execute(1);
        };
        $ev = $@;
        diag($ev) if $ev;
        #9
        ok(!$@, "execute ok");
    };

  SKIP: {
        skip "Failed to execute", 1 if ($ev);

        my $pts = $sth->{ParamTypes};
        #10
        is(ref($pts), 'HASH', 'ParamTypes is a hash');
        my @params = keys %$pts;
        #11
        is(scalar(@params), 1, 'one parameter');
        #use Data::Dumper;
        #diag(Dumper($pts->{$params[0]}));
        #12
        ok(($pts->{$params[0]}->{TYPE} == 12) ||
               ($pts->{$params[0]}->{TYPE} == -9), 'char parameter (prepare)') or
	       diag($pts->{$params[0]}->{TYPE});
    };
}

sub on_connect
{
    $dbh->{odbc_describe_parameters} = 0;

    eval {
        $sth = $dbh->prepare('INSERT into PERL_DBD_drop_me VALUES (?)');
    };
    $ev = $@;
    diag($ev) if $ev;
    #8
    ok($sth && !$@, "prepare insert");

  SKIP: {
        skip "Failed to prepare", 1 if ($ev);

        eval {
            $sth->execute(1);
        };
        $ev = $@;
        diag($ev) if $ev;
        #9
        ok(!$@, "execute ok");
    };

  SKIP: {
        skip "Failed to execute", 1 if ($ev);

        my $pts = $sth->{ParamTypes};
        #10
        is(ref($pts), 'HASH', 'ParamTypes is a hash');
        my @params = keys %$pts;
        #11
        is(scalar(@params), 1, 'one parameter');
        #use Data::Dumper;
        #diag(Dumper($pts->{$params[0]}));
        #12
        ok(($pts->{$params[0]}->{TYPE} == 12) ||
               ($pts->{$params[0]}->{TYPE} == -9), 'char parameter (connect)');
    };
}

default();
on_prepare();
on_connect();