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