Thanks, but Steffen Goeldner <[EMAIL PROTECTED]> has already
implemented all of these (see archives). The real problem is that
I've not got round to doing a release yet. Partly because I don't
have a working Oracle installation at the moment - but I'm working
on that.
Tim.
On Thu, May 16, 2002 at 02:31:23PM -0700, Tony Payne wrote:
> 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;
> }
> }
>
