Thanks. Currently I'm very close to a DBI release then I hope to get a
working Oracle installation again so I can work on DBD::Oracle.
Tim.
On Fri, May 17, 2002 at 09:01:43AM -0700, Tony Payne wrote:
> Ok. I only saw column_info in the archives: guess I didn't look long
> enough. Let me know if y'all need any help w/ testing.
>
> ++t
>
> On Fri, 2002-05-17 at 05:10, Tim Bunce wrote:
> > 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;
> > > }
> > > }
> > >
>
>
