mirror of
https://github.com/DBD-SQLite/DBD-SQLite
synced 2025-06-07 14:19:10 -04:00
support for foreign_key_info
This commit is contained in:
Laurent Dami
parent
76f28f4f3a
commit
2c8c79b2f4
3 changed files with 310 additions and 1 deletions
2
Changes
2
Changes
|
|
@ -1,5 +1,7 @@
|
|||
Changes for Perl extension DBD-SQLite
|
||||
|
||||
- added support for foreign_key_info (DAMI)
|
||||
|
||||
1.38_01 to be released
|
||||
- Updated to SQLite 3.17.13 (ISHIGAKI)
|
||||
|
||||
|
|
|
|||
|
|
@ -29,6 +29,7 @@ __PACKAGE__->bootstrap($VERSION);
|
|||
# New or old API?
|
||||
use constant NEWAPI => ($DBI::VERSION >= 1.608);
|
||||
|
||||
# global registry of collation functions, initialized with 2 builtins
|
||||
tie %COLLATION, 'DBD::SQLite::_WriteOnceHash';
|
||||
$COLLATION{perl} = sub { $_[0] cmp $_[1] };
|
||||
$COLLATION{perllocale} = sub { use locale; $_[0] cmp $_[1] };
|
||||
|
|
@ -38,7 +39,7 @@ my $methods_are_installed = 0;
|
|||
sub driver {
|
||||
return $drh if $drh;
|
||||
|
||||
if (!$methods_are_installed && $DBI::VERSION >= 1.608) {
|
||||
if (!$methods_are_installed && DBD::SQLite::NEWAPI ) {
|
||||
DBI->setup_driver('DBD::SQLite');
|
||||
|
||||
DBD::SQLite::db->install_method('sqlite_last_insert_rowid');
|
||||
|
|
@ -417,6 +418,120 @@ sub primary_key_info {
|
|||
return $sth;
|
||||
}
|
||||
|
||||
|
||||
our %DBI_code_for_rule = ( # from DBI doc; curiously, they are not exported
|
||||
# by the DBI module.
|
||||
# codes for update/delete constraints
|
||||
'CASCADE' => 0,
|
||||
'RESTRICT' => 1,
|
||||
'SET NULL' => 2,
|
||||
'NO ACTION' => 3,
|
||||
'SET DEFAULT' => 4,
|
||||
|
||||
# codes for deferrability
|
||||
'INITIALLY DEFERRED' => 5,
|
||||
'INITIALLY IMMEDIATE' => 6,
|
||||
'NOT DEFERRABLE' => 7,
|
||||
);
|
||||
|
||||
|
||||
my @FOREIGN_KEY_INFO_ODBC = (
|
||||
'PKTABLE_CAT', # The primary (unique) key table catalog identifier.
|
||||
'PKTABLE_SCHEM', # The primary (unique) key table schema identifier.
|
||||
'PKTABLE_NAME', # The primary (unique) key table identifier.
|
||||
'PKCOLUMN_NAME', # The primary (unique) key column identifier.
|
||||
'FKTABLE_CAT', # The foreign key table catalog identifier.
|
||||
'FKTABLE_SCHEM', # The foreign key table schema identifier.
|
||||
'FKTABLE_NAME', # The foreign key table identifier.
|
||||
'FKCOLUMN_NAME', # The foreign key column identifier.
|
||||
'KEY_SEQ', # The column sequence number (starting with 1).
|
||||
'UPDATE_RULE', # The referential action for the UPDATE rule.
|
||||
'DELETE_RULE', # The referential action for the DELETE rule.
|
||||
'FK_NAME', # The foreign key name.
|
||||
'PK_NAME', # The primary (unique) key name.
|
||||
'DEFERRABILITY', # The deferrability of the foreign key constraint.
|
||||
'UNIQUE_OR_PRIMARY', # qualifies the key referenced by the foreign key
|
||||
);
|
||||
|
||||
# Column names below are not used, but listed just for completeness's sake.
|
||||
# Maybe we could add an option so that the user can choose which field
|
||||
# names will be returned; the DBI spec is not very clear about ODBC vs. CLI.
|
||||
my @FOREIGN_KEY_INFO_SQL_CLI = 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
|
||||
UPDATE_RULE
|
||||
DELETE_RULE
|
||||
FK_NAME
|
||||
UK_NAME
|
||||
DEFERABILITY
|
||||
UNIQUE_OR_PRIMARY
|
||||
);
|
||||
|
||||
sub foreign_key_info {
|
||||
my $dbh = shift;
|
||||
my %arg;
|
||||
@arg{qw/PK_CATALOG PK_SCHEMA PK_TABLE
|
||||
FK_CATALOG FK_SCHEMA FK_TABLE/} = @_;
|
||||
|
||||
# check arguments
|
||||
$arg{FK_TABLE}
|
||||
or return $dbh->DBI::set_err($DBI::stderr, '6th arg FK_TABLE is mandatory');
|
||||
foreach my $arg_name (qw/PK_CATALOG PK_SCHEMA FK_CATALOG FK_SCHEMA/) {
|
||||
!$arg{$arg_name} || $arg{$arg_name} eq '%'
|
||||
or $dbh->DBI::set_err(0, "arg $arg_name will be ignored");
|
||||
}
|
||||
|
||||
# get info from a PRAGMA statement
|
||||
my $fk_sth = $dbh->prepare("PRAGMA foreign_key_list($arg{FK_TABLE})");
|
||||
$fk_sth->execute;
|
||||
|
||||
# accumulate results (create rows of appropriate structure)
|
||||
my @rows;
|
||||
while (my $row = $fk_sth->fetchrow_hashref) {
|
||||
next if $arg{PK_TABLE} && $arg{PK_TABLE} ne $row->{table};
|
||||
push @rows, [
|
||||
undef, # PKTABLE_CAT
|
||||
undef, # PKTABLE_SCHEM
|
||||
$row->{table}, # PKTABLE_NAME
|
||||
$row->{to}, # PKCOLUMN_NAME
|
||||
undef, # FKTABLE_CAT
|
||||
undef, # FKTABLE_SCHEM
|
||||
$arg{FK_TABLE}, # FKTABLE_NAME
|
||||
$row->{from}, # FKCOLUMN_NAME
|
||||
$row->{seq} + 1, # KEY_SEQ
|
||||
$DBI_code_for_rule{$row->{on_update}}, # UPDATE_RULE
|
||||
$DBI_code_for_rule{$row->{on_delete}}, # DELETE_RULE
|
||||
undef, # FK_NAME
|
||||
undef, # PK_NAME
|
||||
undef, # DEFERRABILITY
|
||||
undef, # UNIQUE_OR_PRIMARY
|
||||
];
|
||||
# not used: $row->{id}, $row->{match}
|
||||
# CAVEAT : the PRAGMA does not report about DEFERRABILITY clauses
|
||||
}
|
||||
|
||||
# return rows as a 'sponge' statement handle
|
||||
my $sponge_dbh = DBI->connect("DBI:Sponge:", '','')
|
||||
or return $dbh->DBI::set_err($DBI::err, "DBI::Sponge: $DBI::errstr");
|
||||
my $sponge_sth = $sponge_dbh->prepare( "foreign_key_info $arg{FK_TABLE}", {
|
||||
NAME => \@FOREIGN_KEY_INFO_ODBC,
|
||||
rows => \@rows,
|
||||
NUM_OF_FIELDS => scalar(@FOREIGN_KEY_INFO_ODBC),
|
||||
}) or return $dbh->DBI::set_err(
|
||||
$sponge_dbh->err,
|
||||
$sponge_dbh->errstr,
|
||||
);
|
||||
return $sponge_sth;
|
||||
};
|
||||
|
||||
|
||||
sub type_info_all {
|
||||
return; # XXX code just copied from DBD::Oracle, not yet thought about
|
||||
# return [
|
||||
|
|
@ -1150,6 +1265,79 @@ first argument of the mothods is usually C<undef>, and you'll usually
|
|||
set C<undef> for the second one (unless you want to know the primary
|
||||
keys of temporary tables).
|
||||
|
||||
|
||||
=head2 foreign_key_info
|
||||
|
||||
$sth = $dbh->foreign_key_info(undef, undef, $optional_pk_table,
|
||||
undef, undef, $fk_table);
|
||||
|
||||
Returns information about foreign key constraints, as specified in
|
||||
L<DBI/foreign_key_info>, but with some limitations :
|
||||
|
||||
=over
|
||||
|
||||
=item *
|
||||
|
||||
argument C<$fk_table> is mandatory (this is name of the table that contains
|
||||
the foreign key(s))
|
||||
|
||||
=item *
|
||||
|
||||
all other arguments are unused, except the optional C<$pk_table>
|
||||
that may act as an additional filter (the result will only contain
|
||||
the foreign keys in C<$fk_table> which correspond to C<$pk_table>'s
|
||||
primary key).
|
||||
|
||||
=item *
|
||||
|
||||
information in rows returned by the C<$sth> is incomplete with
|
||||
respect to the L<DBI/foreign_key_info> specification. All requested fields
|
||||
are present, but the content is C<undef> for some of them.
|
||||
|
||||
=back
|
||||
|
||||
The following nonempty fields are returned :
|
||||
|
||||
B<PKTABLE_NAME>:
|
||||
The primary (unique) key table identifier.
|
||||
|
||||
B<PKCOLUMN_NAME>:
|
||||
The primary (unique) key column identifier.
|
||||
|
||||
B<FKTABLE_NAME>:
|
||||
The foreign key table identifier.
|
||||
|
||||
B<FKCOLUMN_NAME>:
|
||||
The foreign key column identifier.
|
||||
|
||||
B<KEY_SEQ>:
|
||||
The column sequence number (starting with 1), when
|
||||
several columns belong to a same constraint.
|
||||
|
||||
B<UPDATE_RULE>:
|
||||
The referential action for the UPDATE rule.
|
||||
The following codes are defined:
|
||||
|
||||
CASCADE 0
|
||||
RESTRICT 1
|
||||
SET NULL 2
|
||||
NO ACTION 3
|
||||
SET DEFAULT 4
|
||||
|
||||
Default is 3 ('NO ACTION').
|
||||
|
||||
B<DELETE_RULE>:
|
||||
The referential action for the DELETE rule.
|
||||
The codes are the same as for UPDATE_RULE.
|
||||
|
||||
Unfortunately, the B<DEFERRABILITY> field is always C<undef>;
|
||||
as a matter of fact, deferrability clauses are supported by SQLite,
|
||||
but they can't be reported because the C<PRAGMA foreign_key_list>
|
||||
tells nothing about them.
|
||||
|
||||
B<Note>: foreign key support in SQLite must be explicitly turned on through
|
||||
a C<PRAGMA> command; see L</"Foreign keys"> earlier in this manual.
|
||||
|
||||
=head1 DRIVER PRIVATE METHODS
|
||||
|
||||
The following methods can be called via the func() method with a little
|
||||
|
|
|
|||
119
t/50_foreign_key_info.t
Executable file
119
t/50_foreign_key_info.t
Executable file
|
|
@ -0,0 +1,119 @@
|
|||
#!/usr/bin/perl
|
||||
|
||||
use strict;
|
||||
BEGIN {
|
||||
$| = 1;
|
||||
$^W = 1;
|
||||
}
|
||||
|
||||
use t::lib::Test;
|
||||
use Test::More;
|
||||
|
||||
BEGIN {
|
||||
use DBD::SQLite;
|
||||
unless ($DBD::SQLite::sqlite_version_number && $DBD::SQLite::sqlite_version_number >= 3006019) {
|
||||
plan skip_all => "this test requires SQLite 3.6.19 and newer";
|
||||
exit;
|
||||
}
|
||||
}
|
||||
|
||||
use Test::NoWarnings;
|
||||
|
||||
# SQL below freely adapted from http://www.sqlite.org/foreignkeys.htm ...
|
||||
# not the best datamodel in the world, but good enough for our tests.
|
||||
|
||||
my @sql_statements = split /\n\n/, <<__EOSQL__;
|
||||
PRAGMA foreign_keys = ON;
|
||||
|
||||
CREATE TABLE artist (
|
||||
artistid INTEGER PRIMARY KEY AUTOINCREMENT,
|
||||
artistname TEXT
|
||||
);
|
||||
|
||||
CREATE TABLE editor (
|
||||
editorid INTEGER PRIMARY KEY AUTOINCREMENT,
|
||||
editorname TEXT
|
||||
);
|
||||
|
||||
CREATE TABLE album (
|
||||
albumartist INTEGER NOT NULL REFERENCES artist(artistid)
|
||||
ON DELETE RESTRICT
|
||||
ON UPDATE CASCADE,
|
||||
albumname TEXT,
|
||||
albumcover BINARY,
|
||||
albumeditor INTEGER NOT NULL REFERENCES editor(editorid),
|
||||
PRIMARY KEY(albumartist, albumname)
|
||||
);
|
||||
|
||||
CREATE TABLE song(
|
||||
songid INTEGER PRIMARY KEY AUTOINCREMENT,
|
||||
songartist INTEGER,
|
||||
songalbum TEXT,
|
||||
songname TEXT,
|
||||
FOREIGN KEY(songartist, songalbum) REFERENCES album(albumartist, albumname)
|
||||
);
|
||||
__EOSQL__
|
||||
|
||||
|
||||
plan tests => @sql_statements + 17;
|
||||
|
||||
my $dbh = connect_ok( RaiseError => 1, PrintError => 0, AutoCommit => 1 );
|
||||
my $sth;
|
||||
my $fk_data;
|
||||
my $R = \%DBD::SQLite::db::DBI_code_for_rule;
|
||||
|
||||
ok ($dbh->do($_), $_) foreach @sql_statements;
|
||||
|
||||
$sth = $dbh->foreign_key_info(undef, undef, undef,
|
||||
undef, undef, 'album');
|
||||
$fk_data = $sth->fetchall_hashref('FKCOLUMN_NAME');
|
||||
|
||||
for ($fk_data->{albumartist}) {
|
||||
is($_->{PKTABLE_NAME}, "artist" , "FK albumartist, table name");
|
||||
is($_->{PKCOLUMN_NAME}, "artistid", "FK albumartist, column name");
|
||||
is($_->{KEY_SEQ}, 1, "FK albumartist, key seq");
|
||||
is($_->{DELETE_RULE}, $R->{RESTRICT}, "FK albumartist, delete rule");
|
||||
is($_->{UPDATE_RULE}, $R->{CASCADE}, "FK albumartist, update rule");
|
||||
}
|
||||
for ($fk_data->{albumeditor}) {
|
||||
is($_->{PKTABLE_NAME}, "editor", "FK albumeditor, table name");
|
||||
is($_->{PKCOLUMN_NAME}, "editorid", "FK albumeditor, column name");
|
||||
is($_->{KEY_SEQ}, 1, "FK albumeditor, key seq");
|
||||
# rules are 'NO ACTION' by default
|
||||
is($_->{DELETE_RULE}, $R->{'NO ACTION'}, "FK albumeditor, delete rule");
|
||||
is($_->{UPDATE_RULE}, $R->{'NO ACTION'}, "FK albumeditor, update rule");
|
||||
}
|
||||
|
||||
|
||||
$sth = $dbh->foreign_key_info(undef, undef, 'artist',
|
||||
undef, undef, 'album');
|
||||
$fk_data = $sth->fetchall_hashref('FKCOLUMN_NAME');
|
||||
is_deeply([keys %$fk_data], ['albumartist'], "FK album with PK, only 1 result");
|
||||
|
||||
|
||||
$sth = $dbh->foreign_key_info(undef, undef, 'foobar',
|
||||
undef, undef, 'album');
|
||||
$fk_data = $sth->fetchall_hashref('FKCOLUMN_NAME');
|
||||
is_deeply([keys %$fk_data], [], "FK album with PK foobar, 0 result");
|
||||
|
||||
|
||||
$sth = $dbh->foreign_key_info(undef, undef, undef,
|
||||
undef, undef, 'song');
|
||||
$fk_data = $sth->fetchall_hashref('FKCOLUMN_NAME');
|
||||
for ($fk_data->{songartist}) {
|
||||
is($_->{KEY_SEQ}, 1, "FK song, key seq 1");
|
||||
}
|
||||
for ($fk_data->{songalbum}) {
|
||||
is($_->{KEY_SEQ}, 2, "FK song, key seq 2");
|
||||
}
|
||||
|
||||
dies(sub {$dbh->foreign_key_info(undef, undef, 'artist',
|
||||
undef, undef, undef)}, qr/mandatory/,
|
||||
"6th arg is mandatory");
|
||||
|
||||
# use YAML;
|
||||
# print STDERR Dump $fk_data;
|
||||
|
||||
|
||||
|
||||
|
||||
Loading…
Add table
Reference in a new issue