foreign_key_info() implementation

See below for an implementation of foreign_key_info(). The _version() 
thing is lame, just like in my last patch ;)


sub_foreign_key_info {
     my ($dbh,
         $pk_catalog, $pk_schema, $pk_table,
         undef, $fk_schema, $fk_table,
        ) = @_;

     local $dbh->{FetchHashKeyName} = 'NAME_lc';

     my ($maj, $min, $point) = _version($dbh);

     return unless $maj >= 5 && $point >= 6;

     my @names = qw(
 	UK_TABLE_CAT UK_TABLE_SCHEM UK_TABLE_NAME UK_COLUMN_NAME
 	FK_TABLE_CAT FK_TABLE_SCHEM FK_TABLE_NAME FK_COLUMN_NAME
         ORDINAL_POSITION DELETE_RULE FK_NAME UK_NAME DEFERABILITY
         UNIQUE_OR_PRIMARY
     );

     my $sql = <<'EOF';
SELECT TABLE_CATALOG AS UK_TABLE_CAT,
        TABLE_SCHEMA AS UK_TABLE_SCHEM,
        TABLE_NAME AS UK_TABLE_NAME,
        COLUMN_NAME AS UK_COLUMN_NAME,
        NULL AS FK_TABLE_CAT,
        REFERENCED_TABLE_SCHEMA AS FK_TABLE_SCHEM,
        REFERENCED_TABLE_NAME AS FK_TABLE_NAME,
        REFERENCED_COLUMN_NAME AS FK_COLUMN_NAME,
        ORDINAL_POSITION,
        NULL AS DELETE_RULE,
        CONSTRAINT_NAME AS FK_NAME,
        NULL AS UK_NAME,
        NULL AS DEFERABILITY,
        NULL AS UNIQUE_OR_PRIMARY
   FROM INFORMATION_SCHEMA.KEY_COLUMN_USAGE
  WHERE REFERENCED_TABLE_NAME IS NOT NULL
EOF

     my @where;
     my @bind;

     if ( defined $pk_catalog ) {
         push @where, 'TABLE_CATALOG LIKE ?';
         push @bind, $pk_catalog;
     }

     if ( defined $pk_schema ) {
         push @where, 'TABLE_SCHEMA LIKE ?';
         push @bind, $pk_schema;
     }

     if ( defined $pk_table ) {
         push @where, 'TABLE_NAME LIKE ?';
         push @bind, $pk_table;
     }

     if ( defined $fk_schema ) {
         push @where, 'REFERENCED_TABLE_SCHEMA LIKE ?';
         push @bind,  $fk_schema;
     }

     if ( defined $fk_table ) {
         push @where, 'REFERENCED_TABLE_NAME LIKE ?';
         push @bind,  $fk_table;
     }

     if (@where) {
         $sql .= ' AND ';
         $sql .= join ' AND ', @where;
     }

     local $dbh->{FetchHashKeyName} = 'NAME_uc';
     my $sth = $dbh->prepare($sql);
     $sth->execute(@bind);

     return $sth;
}

sub _version {
     my $dbh = shift;

     return
         $dbh->get_info($DBI::Const::GetInfoType::GetInfoType{SQL_DBMS_VER})
             =~ /(\d+)\.(\d+)\.(\d+)/;
}



/*===================================================
VegGuide.Org                        www.BookIRead.com
Your guide to all that's veg.       My book blog
===================================================*/

-- 
MySQL Perl Mailing List
For list archives: http://lists.mysql.com/perl
To unsubscribe:    http://lists.mysql.com/[email protected]