Skip Menu |
 

This queue is for tickets about the DBD-SQLite CPAN distribution.

Report information
The Basics
Id: 50779
Status: resolved
Priority: 0/
Queue: DBD-SQLite

People
Owner: Nobody in particular
Requestors: DOUGW [...] cpan.org
Cc:
AdminCc:

Bug Information
Severity: Wishlist
Broken in: 1.26_05
Fixed in: (no value)



Subject: Feature Request: Implement DBI::foreign_key_info
Download (untitled) / with headers
text/plain 104b
Since SQLite now supports foreign keys, it now would make sense to implement DBI->foreign_key_info(...).
Download (untitled) / with headers
text/plain 464b
On Fri Oct 23 12:39:13 2009, DOUGW wrote: Show quoted text
> Since SQLite now supports foreign keys, it now would make sense to > implement DBI->foreign_key_info(...).
I was just trying to implement this myself with PRAGMA foreign_key_list, but fetching from: my $sth = $dbh->prepare( q(PRAGMA foreign_key_list('foo')) ); returns no rows. And even if that worked, that would only be half the job, because foreign_key_info() lets you specify either or both of the pk or fk tables.
First go at implementing this attached. Tested, but not heavily yet.
Download foreign_key_info.pl
text/x-perl 3.5k
sub foreign_key_info { my ($dbh, $pk_catalog, $pk_schema, $pk_table, $fk_catalog, $fk_schema, $fk_table) = @_; # Escape the schema and table name defined and s/([\\_%])/\\$1/g for $pk_schema, $fk_schema; my $pk_escaped = $pk_table; $pk_escaped =~ s/([\\_%])/\\$1/g if defined $pk_escaped; my $fk_escaped = $fk_table; $fk_escaped =~ s/([\\_%])/\\$1/g if defined $fk_escaped; # If pk arguments are defined, we need to fetch all tables my $sth_tables = (defined($pk_catalog) or defined($pk_schema) or defined($pk_table)) ? $dbh->table_info(undef, undef, undef, undef, {Escape => '\\'}) : $dbh->table_info($fk_catalog, $fk_schema, $fk_table, undef, {Escape => '\\'}); ; my @fk_info; while ( my $row = $sth_tables->fetchrow_hashref ) { my $sql = $row->{sqlite_sql} or next; next unless $sql =~ /FOREIGN\s+KEY\s*\([^)]+\)\s*REFERENCES/si; my $schema = $row->{TABLE_SCHEM}; my $table = $row->{TABLE_NAME}; my $have_fk_table; if ( defined($fk_table) ) { $have_fk_table = 1 if $table eq $fk_table; if ( defined($fk_schema) ) { $have_fk_table = 0 unless $schema eq $fk_schema; } } my $need_both = defined($pk_table) && defined($fk_table); my $fk_seq; while ( $sql =~ /FOREIGN\s+KEY\((.*?)\)\s*REFERENCES\s+(.*?)\s*\((.*?)\)/gsi ) { my ($fk_col_str, $pk_tbl, $pk_col_str) = ($1,$2,$3); my @pk_tbl_sch = split /\./, $pk_tbl; my $pk_sch; if (@pk_tbl_sch > 1) { ($pk_sch, $pk_tbl) = @pk_tbl_sch; } $pk_sch ||= 'main'; my $have_pk_table; if ( defined($pk_table) ) { $have_pk_table = 1 if $pk_table eq $pk_tbl; if ( defined($pk_schema) ) { $have_pk_table = 0 unless $pk_schema eq $pk_sch; } } next unless $have_pk_table or $have_fk_table; next if $need_both and ( !$have_pk_table or !$have_fk_table ); s/^\s+//, s/\s+$// for $pk_col_str, $fk_col_str; my @fk_col = split /\s*,\s*/, $fk_col_str; my @pk_col = split /\s*,\s*/, $pk_col_str; $fk_seq++; for my $i (0..$#fk_col) { push @fk_info, { PKTABLE_SCHEM => $pk_sch, PKTABLE_NAME => $pk_tbl, PKCOLUMN_NAME => $pk_col[$i], FKTABLE_SCHEM => $schema, FKTABLE_NAME => $table, FKCOLUMN_NAME => $fk_col[$i], KEY_SEQ => $i+1, UPDATE_RULE => 3, DELETE_RULE => 3, PK_NAME => 'PRIMARY KEY', FK_NAME => "FK$fk_seq", }; } } } my $sponge = DBI->connect("DBI:Sponge:", '','') or return $dbh->DBI::set_err($DBI::err, "DBI::Sponge: $DBI::errstr"); my @names = qw( PKTABLE_CAT PKTABLE_SCHEM PKTABLE_NAME PKCOLUMN_NAME FKTABLE_CAT FKTABLE_SCHEM FKTABLE_NAME FKCOLUMN_NAME KEY_SEQ UPDATE_RULE DELETE_RULE PK_NAME FK_NAME ); my $sth = $sponge->prepare( "foreign_key_info", { rows => [ map { [ @{$_}{@names} ] } @fk_info ], NUM_OF_FIELDS => scalar @names, NAME => \@names, }) or return $dbh->DBI::set_err( $sponge->err(), $sponge->errstr() ); return $sth; }
Download (untitled) / with headers
text/plain 140b
On Fri Oct 23 16:02:40 2009, DOUGW wrote: Show quoted text
> First go at implementing this attached. Tested, but not heavily yet.
minor correction to logic.
sub foreign_key_info { my ($dbh, $pk_catalog, $pk_schema, $pk_table, $fk_catalog, $fk_schema, $fk_table) = @_; # Escape the schema and table name defined and s/([\\_%])/\\$1/g for $pk_schema, $fk_schema; my $pk_escaped = $pk_table; $pk_escaped =~ s/([\\_%])/\\$1/g if defined $pk_escaped; my $fk_escaped = $fk_table; $fk_escaped =~ s/([\\_%])/\\$1/g if defined $fk_escaped; # If fk arguments are defined, we only need to fetch that table my $sth_tables = (defined($fk_schema) or defined($fk_table)) ? $dbh->table_info($fk_catalog, $fk_schema, $fk_table, undef, {Escape => '\\'}) : $dbh->table_info(undef, undef, undef, undef, {Escape => '\\'}) ; my @fk_info; while ( my $row = $sth_tables->fetchrow_hashref ) { my $sql = $row->{sqlite_sql} or next; next unless $sql =~ /FOREIGN\s+KEY\s*\([^)]+\)\s*REFERENCES/si; my $schema = $row->{TABLE_SCHEM}; my $table = $row->{TABLE_NAME}; my $have_fk_table; if ( defined($fk_table) ) { $have_fk_table = 1 if $table eq $fk_table; if ( defined($fk_schema) ) { $have_fk_table = 0 unless $schema eq $fk_schema; } } my $need_both = defined($pk_table) && defined($fk_table); my $fk_seq; while ( $sql =~ /FOREIGN\s+KEY\((.*?)\)\s*REFERENCES\s+(.*?)\s*\((.*?)\)/gsi ) { my ($fk_col_str, $pk_tbl, $pk_col_str) = ($1,$2,$3); my @pk_tbl_sch = split /\./, $pk_tbl; my $pk_sch; if (@pk_tbl_sch > 1) { ($pk_sch, $pk_tbl) = @pk_tbl_sch; } $pk_sch ||= 'main'; my $have_pk_table; if ( defined($pk_table) ) { $have_pk_table = 1 if $pk_table eq $pk_tbl; if ( defined($pk_schema) ) { $have_pk_table = 0 unless $pk_schema eq $pk_sch; } } next unless $have_pk_table or $have_fk_table; next if $need_both and ( !$have_pk_table or !$have_fk_table ); s/^\s+//, s/\s+$// for $pk_col_str, $fk_col_str; my @fk_col = split /\s*,\s*/, $fk_col_str; my @pk_col = split /\s*,\s*/, $pk_col_str; $fk_seq++; for my $i (0..$#fk_col) { push @fk_info, { PKTABLE_SCHEM => $pk_sch, PKTABLE_NAME => $pk_tbl, PKCOLUMN_NAME => $pk_col[$i], FKTABLE_SCHEM => $schema, FKTABLE_NAME => $table, FKCOLUMN_NAME => $fk_col[$i], KEY_SEQ => $i+1, UPDATE_RULE => 3, DELETE_RULE => 3, PK_NAME => 'PRIMARY KEY', FK_NAME => "FK$fk_seq", }; } } } my $sponge = DBI->connect("DBI:Sponge:", '','') or return $dbh->DBI::set_err($DBI::err, "DBI::Sponge: $DBI::errstr"); my @names = qw( PKTABLE_CAT PKTABLE_SCHEM PKTABLE_NAME PKCOLUMN_NAME FKTABLE_CAT FKTABLE_SCHEM FKTABLE_NAME FKCOLUMN_NAME KEY_SEQ UPDATE_RULE DELETE_RULE PK_NAME FK_NAME ); my $sth = $sponge->prepare( "foreign_key_info", { rows => [ map { [ @{$_}{@names} ] } @fk_info ], NUM_OF_FIELDS => scalar @names, NAME => \@names, }) or return $dbh->DBI::set_err( $sponge->err(), $sponge->errstr() ); return $sth; }
Download (untitled) / with headers
text/plain 543b
On Fri Oct 23 16:09:15 2009, DOUGW wrote: Show quoted text
> On Fri Oct 23 16:02:40 2009, DOUGW wrote:
> > First go at implementing this attached. Tested, but not heavily yet.
> > minor correction to logic.
Gah. Feel like an idiot...PRAGMA foreign_key_list works fine...forgot to execute (since you don't have to execute the sth from foreign_key_info). Still, if you pass in pk arguments to foreign_key_info, the foreign_key_list pragma does not tell you what tables have fk's to that pk. So you still seem to be stuck scanning every table to get that info.
Download (untitled) / with headers
text/plain 127b
Here is yet another version that uses SQLite's foreign_key_list pragma. I am not too clear on how the schema arguments fit in.
package DBD::SQLite::db; sub foreign_key_info { my ($dbh, $pk_catalog, $pk_schema, $pk_table, $fk_catalog, $fk_schema, $fk_table) = @_; # Escape the schema and table name defined and s/([\\_%])/\\$1/g for $pk_schema, $fk_schema; my $pk_escaped = $pk_table; $pk_escaped =~ s/([\\_%])/\\$1/g if defined $pk_escaped; my $fk_escaped = $fk_table; $fk_escaped =~ s/([\\_%])/\\$1/g if defined $fk_escaped; # If fk arguments are defined, we only need to fetch that table my $sth_tables = (defined($fk_schema) or defined($fk_table)) ? $dbh->table_info($fk_catalog, $fk_schema, $fk_table, undef, {Escape => '\\'}) : $dbh->table_info(undef, undef, undef, undef, {Escape => '\\'}) ; my @fk_info; while ( my $row = $sth_tables->fetchrow_hashref ) { my $sql = $row->{sqlite_sql} or next; next unless $sql =~ /FOREIGN\s+KEY\s*\([^)]+\)\s*REFERENCES/si; my $schema = $row->{TABLE_SCHEM}; my $table = $row->{TABLE_NAME}; my $have_fk_table; if ( defined($fk_table) ) { $have_fk_table = 1 if $table eq $fk_table; if ( defined($fk_schema) ) { $have_fk_table = 0 unless $schema eq $fk_schema; } } my $need_both = defined($pk_table) && defined($fk_table); my $fk_seq; my $fk_sth = $dbh->prepare(qq(PRAGMA foreign_key_list("$table"))); $fk_sth->execute(); my %fk_data; while ( my $fk_row = $fk_sth->fetchrow_hashref() ) { my $pk_tbl = $fk_row->{table}; push @{$fk_data{$fk_row->{table}}{$fk_row->{id}}}, [ $fk_row->{from}, $fk_row->{to} ]; } for my $pk_tbl (keys %fk_data) { next if defined($pk_table) and $pk_table ne $pk_tbl; my $pk_data = $fk_data{$pk_tbl}; for my $fk_id (keys %$pk_data) { my $data = $pk_data->{$fk_id}; my @pk_col = map { $_->[0] } @$data; my @fk_col = map { $_->[1] } @$data; for my $i (0..$#fk_col) { push @fk_info, { PKTABLE_SCHEM => $pk_sch, PKTABLE_NAME => $pk_tbl, PKCOLUMN_NAME => $pk_col[$i], FKTABLE_SCHEM => $schema, FKTABLE_NAME => $table, FKCOLUMN_NAME => $fk_col[$i], KEY_SEQ => $i+1, UPDATE_RULE => 3, DELETE_RULE => 3, PK_NAME => 'PRIMARY KEY', FK_NAME => "FK$fk_id", }; } } } } my $sponge = DBI->connect("DBI:Sponge:", '','') or return $dbh->DBI::set_err($DBI::err, "DBI::Sponge: $DBI::errstr"); my @names = qw( PKTABLE_CAT PKTABLE_SCHEM PKTABLE_NAME PKCOLUMN_NAME FKTABLE_CAT FKTABLE_SCHEM FKTABLE_NAME FKCOLUMN_NAME KEY_SEQ UPDATE_RULE DELETE_RULE PK_NAME FK_NAME ); my $sth = $sponge->prepare( "foreign_key_info", { rows => [ map { [ @{$_}{@names} ] } @fk_info ], NUM_OF_FIELDS => scalar @names, NAME => \@names, }) or return $dbh->DBI::set_err( $sponge->err(), $sponge->errstr() ); return $sth; } 1;
Download (untitled) / with headers
text/plain 237b
On Fri Oct 23 18:56:55 2009, DOUGW wrote: Show quoted text
> Here is yet another version that uses SQLite's foreign_key_list pragma. > I am not too clear on how the schema arguments fit in.
And (oops) PKTABLE_SCHEM is not set (default it to 'main'?).
Download (untitled) / with headers
text/plain 539b
Sorry for a late reply. foreign_key_info is now implemented (with a test) by DAMI in a slightly different manner from yours. I hope the current implementation works for you too, but if you find anything wrong, please let us know. Thanks. On Sat Oct 24 08:07:20 2009, DOUGW wrote: Show quoted text
> On Fri Oct 23 18:56:55 2009, DOUGW wrote:
> > Here is yet another version that uses SQLite's foreign_key_list
pragma. Show quoted text
> > I am not too clear on how the schema arguments fit in.
> > And (oops) PKTABLE_SCHEM is not set (default it to 'main'?). > >
Download (untitled) / with headers
text/plain 453b
On Sat Sep 01 09:16:26 2012, ISHIGAKI wrote: Show quoted text
> Sorry for a late reply. foreign_key_info is now implemented (with a > test) by DAMI in a slightly different manner from yours. I hope the > current implementation works for you too, but if you find anything > wrong, please let us know. Thanks.
The FK_TABLE argument should not be mandatory. You should be able to pass in a PK_TABLE and get a sth that returns all FK tables that reference the PK table.
Download (untitled) / with headers
text/plain 663b
Refactored in the trunk. Now FK_TABLE is not mandatory, and you can pass PK_SCHEM, PK_TABLE, FK_SCHEM to filter. Could you test it again? Thanks. On Tue Sep 11 02:34:54 2012, DOUGW wrote: Show quoted text
> On Sat Sep 01 09:16:26 2012, ISHIGAKI wrote:
> > Sorry for a late reply. foreign_key_info is now implemented (with a > > test) by DAMI in a slightly different manner from yours. I hope the > > current implementation works for you too, but if you find anything > > wrong, please let us know. Thanks.
> > The FK_TABLE argument should not be mandatory. You should be able to > pass in a PK_TABLE and get a sth that returns all FK tables that > reference the PK table.
Download (untitled) / with headers
text/plain 302b
On Wed Sep 12 03:30:39 2012, ISHIGAKI wrote: Show quoted text
> Could you test it again? Thanks.
I haven't needed to use this library for years, so I haven't tested. And I just eyeballed the changes in the first place. But the tests you have in t/foreign_key_info.t look good, so if those pass, then it should be good.
Download (untitled) / with headers
text/plain 418b
OK. Then I'll wait for what the CPAN Testers say. Thanks. On Thu Sep 13 07:07:47 2012, DOUGW wrote: Show quoted text
> On Wed Sep 12 03:30:39 2012, ISHIGAKI wrote:
> > Could you test it again? Thanks.
> > I haven't needed to use this library for years, so I haven't tested. And > I just eyeballed the changes in the first place. But the tests you have > in t/foreign_key_info.t look good, so if those pass, then it should be
good.
DBD::SQLite 1.38_01 with foreign_key_info() is released. Thanks.


This service is sponsored and maintained by Best Practical Solutions and runs on Perl.org infrastructure.

Please report any issues with rt.cpan.org to rt-cpan-admin@bestpractical.com.