I needed column_info, primary_key_info and foreign_key_info for
DBD::Oracle, so I put together a partial implementation. I figured
someone with more time available (and better understanding of some of
the attributes) might be interested in finishing it.
Let me know if you have any problems/questions.
Note that, in column_info, for attributes I wasn't sure about, I fill in
NULL. If someone who is familiar with how those columns map to Oracle
metadata wants to fill me in on the mapping, I can make the changes.
++t
{
package DBD::Oracle::db;
sub column_info {
my($dbh, $catalog, $schema, $table, $column) = @_;
# XXX add qualification
# XXX add knowledge of public synonmys views etc
# The SYS/SYSTEM should probably be a decode that
# prepends 'SYSTEM ' to TABLE_TYPE.
my @args;
push @args, uc($schema) if $schema;
push @args, uc($table) if $table;
push @args, uc($column) if $column;
my $query =
"select
NULL as TABLE_CAT,
atc.OWNER as TABLE_SCHEM,
atc.TABLE_NAME as TABLE_NAME,
atc.COLUMN_NAME as COLUMN_NAME,
NULL as DATA_TYPE,
NULL as TYPE_NAME,
atc.DATA_LENGTH as COLUMN_SIZE,
NULL as BUFFER_LENGTH,
atc.DATA_PRECISION as DECIMAL_DIGITS,
NULL as NUM_PREC_RADIX,
DECODE(atc.NULLABLE, 'Y', 1, 'N', 0, 2) as NULLABLE,
acc.COMMENTS as REMARKS,
atc.DATA_DEFAULT as COLUMN_DEF,
NULL as SQL_DATA_TYPE,
NULL as SQL_DATETIME_SUB,
NULL as CHAR_OCTET_LENGTH,
atc.COLUMN_ID as ORDINAL_POSITION,
DECODE(atc.NULLABLE, 'Y', 'YES', 'N', 'NO', '') as IS_NULLABLE
from ALL_TAB_COLUMNS atc, ALL_COL_COMMENTS acc
where atc.OWNER = acc.OWNER (+)
and atc.TABLE_NAME = acc.TABLE_NAME (+)
and atc.OWNER <> 'SYS' and atc.OWNER <> 'SYSTEM' " .
($schema ? 'and atc.OWNER = ? ' :
'and atc.OWNER=(SELECT USER FROM DUAL)') .
($table ? 'and atc.TABLE_NAME like ? ' : '') .
($column ? 'and atc.COLUMN_NAME like ? ' : '') .
"and atc.COLUMN_NAME = acc.COLUMN_NAME (+)
order by atc.OWNER, atc.TABLE_NAME, atc.COLUMN_ID
";
my $sth = $dbh->prepare($query) or return undef;
$sth->execute(@args) or return undef;
$sth;
}
sub primary_key_info {
my($dbh, $catalog, $schema, $table) = @_;
# XXX add qualification
# XXX add knowledge of public synonmys views etc
# The SYS/SYSTEM should probably be a decode that
# prepends 'SYSTEM ' to TABLE_TYPE.
my $query =
"select
NULL as TABLE_CAT,
acc.OWNER as TABLE_SCHEM,
acc.TABLE_NAME as TABLE_NAME,
acc.COLUMN_NAME as COLUMN_NAME,
acc.POSITION as KEY_SEQ,
acc.CONSTRAINT_NAME as PK_NAME
from ALL_CONS_COLUMNS acc, ALL_CONSTRAINTS ac
where ac.constraint_name = acc.constraint_name
and ac.owner = acc.owner
and ac.table_name = acc.table_name
and ac.constraint_type = 'P'
and acc.OWNER <> 'SYS' and acc.OWNER <> 'SYSTEM' " .
($schema ? 'and acc.OWNER = ? ' :
'and acc.OWNER=(SELECT USER FROM DUAL)') .
"and acc.TABLE_NAME like ?
order by acc.OWNER, acc.TABLE_NAME, acc.POSITION
";
my $sth = $dbh->prepare($query) or return undef;
$sth->execute(($schema ? uc($schema) : ()), uc($table)) or return undef;
$sth;
}
sub foreign_key_info {
my($dbh, $pkt_cat, $pkt_schema, $pkt_table,
$fkt_cat, $fkt_schema, $fkt_table) = @_;
# XXX add qualification
# XXX add knowledge of public synonmys views etc
# The SYS/SYSTEM should probably be a decode that
# prepends 'SYSTEM ' to TABLE_TYPE.
my @args = ();
my $query =
"select
NULL as PKTABLE_CAT,
pkc.OWNER as PKTABLE_SCHEM,
pkc.TABLE_NAME as PKTABLE_NAME,
pkacc.COLUMN_NAME as PKCOLUMN_NAME,
NULL as FKTABLE_CAT,
fkc.OWNER as FKTABLE_SCHEM,
fkc.TABLE_NAME as FKTABLE_NAME,
fkacc.COLUMN_NAME as FKCOLUMN_NAME,
pkacc.POSITION as KEY_SEQ,
DECODE(fkc.DELETE_RULE,
'CASCADE', 0,
'RESTRICT', 1,
'SET NULL', 2,
'NO ACTION', 3,
'SET DEFAULT', 4,
5) as UPDATE_RULE,
DECODE(fkc.DELETE_RULE,
'CASCADE', 0,
'RESTRICT', 1,
'SET NULL', 2,
'NO ACTION', 3,
'SET DEFAULT', 4,
8) as DELETE_RULE,
fkc.constraint_name as FK_NAME,
pkc.constraint_name as PK_NAME,
DECODE(fkc.deferrable,
'INITIALLY DEFERRED', 5,
'INITIALLY IMMEDIATE', 6,
'NOT DEFERRABLE', 7,
9) as DEFERRABILITY,
DECODE(pkc.constraint_type,
'P', 'PRIMARY',
'UNIQUE') as UNIQUE_OR_PRIMARY
from ALL_CONS_COLUMNS pkacc, ALL_CONS_COLUMNS fkacc,
ALL_CONSTRAINTS pkc, ALL_CONSTRAINTS fkc
where pkacc.constraint_name = pkc.constraint_name
and pkacc.owner = pkc.owner
and pkacc.table_name = pkc.table_name
and fkacc.constraint_name = fkc.constraint_name
and fkacc.owner = fkc.owner
and fkacc.table_name = fkc.table_name
and pkacc.position = fkacc.position
and pkc.constraint_name = fkc.r_constraint_name
and pkc.owner = fkc.r_owner
and pkc.constraint_type in ('U', 'P')
and fkc.constraint_type = 'R' ";
if($pkt_schema) {
$query .= "
and pkc.owner = ? ";
push @args, uc($pkt_schema);
} elsif (!$fkt_table) {
$query .= "
and pkc.owner = (SELECT user from dual) ";
}
if($fkt_schema) {
$query .= "
and fkc.owner = ? ";
push @args, uc($fkt_schema);
} else {
$query .= "
and fkc.owner = (SELECT user from dual) ";
}
if($pkt_table) {
$query .= "
and pkc.table_name = ? ";
push @args, uc($pkt_table);
}
if($fkt_table) {
$query .= "
and fkc.table_name = ? ";
push @args, uc($fkt_table);
}
$query .= "
order by fkc.OWNER, fkc.TABLE_NAME, fkacc.POSITION,
pkc.OWNER, pkc.TABLE_NAME, pkacc.POSITION";
print STDERR "$query\n";
my $sth = $dbh->prepare($query) or return undef;
$sth->execute(@args) or return undef;
$sth;
}
}
