#!/usr/bin/perl -w -I./t # $Id: odbc_describe_parameter.t 15144 2012-02-13 09:23:24Z mjevans $ # # 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();