Attached is a possible implementation for DBD::ADO.
Steffen
*** DBD-ADO-2.4/lib/DBD/ADO.pm Wed Oct 24 04:41:30 2001
--- ADO.pm Thu Oct 25 15:30:12 2001
***************
*** 719,724 ****
--- 719,768 ----
[ qw( TABLE_CAT TABLE_SCHEM TABLE_NAME COLUMN_NAME KEY_SEQ
PK_NAME ) ]});
}
+ sub foreign_key_info {
+ my( $dbh, @Criteria ) = @_;
+ my $Criteria = \@Criteria if @Criteria;
+ my $QueryType = 'adSchemaForeignKeys';
+ my $RefActions = {
+ 'CASCADE' => 0,
+ 'RESTRICT' => 1,
+ 'SET NULL' => 2,
+ 'NO ACTION' => 3,
+ 'SET DEFAULT' => 4,
+ };
+ my @Rows;
+ my $conn = $dbh->{ado_conn};
+ my $tmpCursorLocation = $conn->{CursorLocation};
+ $conn->{CursorLocation} = $ado_consts->{adUseClient};
+
+ my $RecSet = $conn->OpenSchema( $ado_consts->{$QueryType}, $Criteria );
+ my $lastError = DBD::ADO::errors($conn);
+ return DBI::set_err($dbh, $DBD::ADO::err,
+ "Error occurred with call to OpenSchema ($QueryType):
+$lastError")
+ if $lastError;
+
+ $RecSet->{Sort} = 'PK_TABLE_CATALOG, PK_TABLE_SCHEMA, PK_TABLE_NAME,
+FK_TABLE_CATALOG, FK_TABLE_SCHEMA, FK_TABLE_NAME';
+ $lastError = DBD::ADO::errors($conn);
+ return DBI::set_err($dbh, $DBD::ADO::err,
+ "Error occurred defining sort order : $lastError")
+ if $lastError;
+
+ while ( ! $RecSet->{EOF} ) {
+ my @Fields = (map { $_->{Value} }
+Win32::OLE::in($RecSet->Fields) ) [ 0..3,6..9,12..14,16,15,17 ];
+ $Fields[ 9] = $RefActions->{$Fields[ 9]};
+ $Fields[10] = $RefActions->{$Fields[10]};
+ $Fields[13] += 4 if $Fields[13];
+ push( @Rows, \@Fields );
+ $RecSet->MoveNext;
+ }
+ $RecSet->Close; undef $RecSet;
+ $conn->{CursorLocation} = $tmpCursorLocation;
+
+ DBI->connect('dbi:Sponge:','','', { RaiseError => 1 })->prepare(
+ $QueryType, { rows => \@Rows, NAME =>
+ [ qw( PKTABLE_CAT PKTABLE_SCHEM PKTABLE_NAME PKCOLUMN_NAME
+FKTABLE_CAT FKTABLE_SCHEM FKTABLE_NAME FKCOLUMN_NAME KEY_SEQ UPDATE_RULE DELETE_RULE
+FK_NAME PK_NAME DEFERRABILITY ) ]});
+ }
+
sub type_info_all {
my ($dbh) = @_;
my $names = {
