1#!/usr/bin/perl -w -I./t 2# $Id$ 3 4 5# use strict; 6use DBI qw(:sql_types); 7# use DBD::ODBC::Const qw(:sql_types); 8 9my (@row); 10 11my $dbh = DBI->connect() 12 or exit(0); 13$dbh->{RaiseError} = 1; 14# ------------------------------------------------------------ 15 16# dumb, for now... 17# SQL_DRIVER_VER returns string 18# SQL_CURSOR_COMMIT_BEHAVIOR returns 16 bit value 19# SQL_ALTER_TABLE returns 32 bit value 20# SQL_ACCESSIBLE_PROCEDURES returns short string (Y or N) 21 22my %InfoTests = ( 23 'SQL_DRIVER_NAME', 6, 24 'SQL_DRIVER_VER', 7, 25 'SQL_DRIVER_ODBC_VER', 77, 26 'SQL_DATABASE_NAME', 16, 27 'SQL_DBMS_NAME', 17, 28 'SQL_DBMS_VER', 18, 29 'SQL_IDENTIFIER_QUOTE_CHAR', 29, 30 'SQL_DM_VER', 171, 31 'SQL_CATALOG_NAME_SEPARATOR', 41, 32 'SQL_CATALOG_LOCATION', 114, 33 'SQL_CURSOR_COMMIT_BEHAVIOR', 23, 34 'SQL_ALTER_TABLE', 86, 35 'SQL_ACCESSIBLE_PROCEDURES', 20, 36 'SQL_PROCEDURES', 21, 37 'SQL_MULT_RESULT_SETS', 36, 38 'SQL_PROCEDURE_TERM', 40, 39 ); 40 41my %TypeTests = ( 42 'SQL_ALL_TYPES' => 0, 43 'SQL_VARCHAR' => SQL_VARCHAR, 44 'SQL_CHAR' => SQL_CHAR, 45 'SQL_INTEGER' => SQL_INTEGER, 46 'SQL_SMALLINT' => SQL_SMALLINT, 47 'SQL_NUMERIC' => SQL_NUMERIC, 48 'SQL_LONGVARCHAR' => SQL_LONGVARCHAR, 49 'SQL_LONGVARBINARY' => SQL_LONGVARBINARY, 50 'SQL_WVARCHAR' => SQL_WVARCHAR, 51 'SQL_WCHAR' => SQL_WCHAR, 52 'SQL_WLONGVARCHAR' => SQL_WLONGVARCHAR, 53 ); 54 55my $ret; 56print "\nInformation for DBI_DSN=$ENV{'DBI_DSN'}\n\n"; 57my $SQLInfo; 58foreach $SQLInfo (sort keys %InfoTests) { 59 $ret = 0; 60 $ret = $dbh->get_info($InfoTests{$SQLInfo}); 61 print "$SQLInfo ($InfoTests{$SQLInfo}):\t$ret\n"; 62} 63 64print "\nGetfunctions : ", join(",", $dbh->func(0, GetFunctions)), "\n\n"; 65print "\nGetfunctions v3: ", join(",", $dbh->func(999, GetFunctions)), "\n\n"; 66 67foreach $SQLInfo (sort keys %TypeTests) { 68 print "Listing all $SQLInfo types\n"; 69 $sth = $dbh->func($TypeTests{$SQLInfo}, GetTypeInfo); 70 if ($sth) { 71 my $colcount = $sth->func(1, 0, ColAttributes); # 1 for col (unused) 0 for SQL_COLUMN_COUNT 72 # print "Column count is $colcount\n"; 73 my $i; 74 my @coldescs = (); 75 # column 0 should be an error/blank 76 for ($i = 0; $i <= $colcount; $i++) { 77 # $i is colno (1 based) 2 is for SQL_COLUMN_TYPE 78 # $i == 0 is intentional error...tests error handling. 79 my $stype = $sth->func($i, 2, ColAttributes); 80 my $sname = $sth->func($i, 1, ColAttributes); 81 # print "Col Attributes (TYPE): ", &nullif($stype), "\n"; 82 # print "Col Attributes (NAME): ", &nullif($sname), "\n"; 83 push(@coldescs, $sname); 84 # print "Desc Col: ", join(', ', &nullif($sth->func($i, DescribeCol))), "\n"; 85 } 86 # print join(', ', @coldescs), "\n"; 87 while (@row = $sth->fetchrow()) { 88 89 print "\t$row[0]\n", 90 # &nullif($row[1]), ", " , 91 #&nullif($row[2]), ", " , 92 #&nullif($row[3]), ", " , 93 #&nullif($row[4]), ", " , 94 #&nullif($row[5]), "\n"; 95 # print join(', ', @row), "\n"; 96 } 97 $sth->finish(); 98 } else { 99 # no info on that type... 100 print "no info for this type\n"; 101 } 102} 103 104my $SQL_XOPEN_CLI_YEAR = 10000; 105print "\nSQL_XOPEN_CLI_YEAR = ", $dbh->get_info($SQL_XOPEN_CLI_YEAR), "\n"; 106$dbh->disconnect(); 107 108sub nullif ($) { 109 my $val = shift; 110 $val ? $val : "(null)"; 111} 112