File: coltest.pl

package info (click to toggle)
libdbd-odbc-perl 1.24-1
  • links: PTS, VCS
  • area: main
  • in suites: squeeze
  • size: 1,012 kB
  • ctags: 398
  • sloc: perl: 6,314; ansic: 4,875; makefile: 29; sql: 8
file content (31 lines) | stat: -rwxr-xr-x 764 bytes parent folder | download
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
#!perl -w
# $Id: coltest.pl 11680 2008-08-28 08:23:27Z mjevans $

use strict;
use DBI;

my $dbh = DBI->connect() or die "Can't connect";

$dbh->{RaiseError} = 1;
$dbh->{LongReadLen} = 800;

my @tables = $dbh->tables;

my @mtable = grep(/foo/, @tables);
my ($catalog, $schema, $table) = split(/\./, $mtable[0]);
$catalog =~ s/"//g;
$schema =~ s/"//g;
$table =~ s/"//g;
print "Getting column info for: $catalog, $schema, $table\n";
my $sth = $dbh->column_info($catalog, $schema, $table, undef);
my @row;

print join(', ', @{$sth->{NAME}}), "\n";
while (@row = $sth->fetchrow_array) {

   # join prints nasty warning messages with -w. There's gotta be a better way...
   foreach (@row) { $_ = "" if (!defined); }

   print join(", ", @row), "\n";
}
$dbh->disconnect;