#!/usr/bin/env perl
#
# tabinfo
#
# Usage: tabinfo base user password table
#
# Displays the structure of the specified table.
# Note that the field names are restricted to the length of the field.
# This is mainly to show the use of &ora_lengths, &ora_titles and &ora_types.
#
use DBI;
use strict;
# Set trace level if '-# trace_level' option is given
DBI->trace( shift ) if 1 < @ARGV && $ARGV[0] =~ /^-#/ && shift;
# read the compulsory arguments
die "syntax: $0 base user password table ...\n" if 4 > @ARGV;
my ( $base, $user, $pass, @table ) = @ARGV;
my ( $table, @name, @length, @type, %type_name, $i );
format STDOUT_TOP =
Structure of @<<<<<<<<<<<<<<<<<<<<<<<
$table
Field name | Length | Type | Type Name
----------------------------------------------+--------+------+-----------------
.
format STDOUT =
@<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< | @>>>>> | @>>> | @<<<<<<<<<<<<<<<
$name[$i], $length[$i], $type[$i], $type_name{$type[$i]}
.
# Connect to database
my $dbh = DBI->connect( "dbi:Oracle:$base", $user, $pass,
{ AutoCommit => 0, RaiseError => 1, PrintError => 0 } )
or die $DBI::errstr;
# Associate type names to types
{
my $type_info_all = $dbh->type_info_all;
my $iname = $type_info_all->[0]{TYPE_NAME};
my $itype = $type_info_all->[0]{DATA_TYPE};
my $rtype;
shift @$type_info_all;
foreach $rtype ( @$type_info_all ) {
$type_name{$$rtype[$itype]} = $$rtype[$iname]
if ! exists $type_name{$$rtype[$itype]};
}
}
my $sth;
foreach $table ( @table ) {
$sth = $dbh->prepare( "SELECT * FROM $table WHERE 1 = 2");
@name = @{$sth->{NAME}};
@length = @{$sth->{PRECISION}};
@type = @{$sth->{TYPE}};
foreach $i ( 0 .. $#name ) {
write;
}
$- = 0;
$sth->finish;
}
$dbh->disconnect;