| Subject: | New feature: PRAGMA foreign_keys = ON |
SQLite has started supporting enforcing of foreign key constraints since
3.6.19, but this enforcement is disabled by default in order not to
break legacy code. To enforce referential integrity of foreign key
constraints, the pragma foreign_keys has to be enabled at the start of
each new connection.
The attached patch adds a new foreign_keys option. When this option is
true, the SQL statement "PRAGMA foreign_keys = ON" is run immediately
after starting each new connection.
I've also added a new test script to test the new option and described
the option in the POD.
Please be free to include the patch verbatin or modified in a next
release of ORLite.
Thanks.
Best regards,
Paulo Custodio
| Subject: | xx_foreign_keys_on.sql |
Message body not shown because it is not plain text.
| Subject: | ORLite-1.96-fk_patch.txt |
diff -c -w -r ORLite-1.96/lib/ORLite.pm ORLite-1.96-fk/lib/ORLite.pm
*** ORLite-1.96/lib/ORLite.pm Mon Feb 27 01:50:26 2012
--- ORLite-1.96-fk/lib/ORLite.pm Mon Apr 30 10:53:20 2012
***************
*** 56,61 ****
--- 56,62 ----
tables => 1,
views => 0,
unicode => 0,
+ foreign_keys => 0,
);
if ( defined Params::Util::_STRING($_[1]) ) {
# Support the short form "use ORLite 'db.sqlite'"
***************
*** 161,166 ****
--- 162,170 ----
my $readonly = $params{readonly} ? "\n\t\tReadOnly => 1," : '';
my $unicode = $params{unicode} ? "\n\t\tsqlite_unicode => 1," : '';
my $version = $unicode ? '5.008005' : '5.006';
+ my $pragma_foreign_keys =
+ $params{foreign_keys} ?
+ '$dbh->do("PRAGMA foreign_keys = ON");' : '';
# Generate the support package code
my $code = <<"END_PERL";
***************
*** 185,194 ****
}
sub connect {
! DBI->connect( \$_[0]->dsn, undef, undef, {
PrintError => 0,
RaiseError => 1,$readonly$unicode
} );
}
sub connected {
--- 189,200 ----
}
sub connect {
! my \$dbh = DBI->connect( \$_[0]->dsn, undef, undef, {
PrintError => 0,
RaiseError => 1,$readonly$unicode
} );
+ $pragma_foreign_keys
+ return \$dbh;
}
sub connected {
***************
*** 894,899 ****
--- 900,906 ----
tables => [ 'table1', 'table2' ],
cleanup => 'VACUUM',
prune => 1,
+ foreign_keys => 1,
};
=head1 DESCRIPTION
***************
*** 1171,1176 ****
--- 1178,1194 ----
At the moment, it just enables the C<sqlite_unicode> option while
connecting to your database. There'll be more in the future.
+ =head2 foreign_keys
+
+ SQLite has started supporting enforcing of foreign key constraints since 3.6.19,
+ but this enforcement is disabled by default in order not to break legacy code.
+
+ To enforce referential integrity of foreign key constraints,
+ the pragma foreign_keys has to be enabled at the start of each new connection.
+
+ When this option is true, the SQL statement "PRAGMA foreign_keys = ON" is
+ run immediately after starting each new connection.
+
=head1 ROOT PACKAGE METHODS
All ORLite root packages receive an identical set of methods for
Only in ORLite-1.96-fk/t: xx_foreign_keys_on.sql
Only in ORLite-1.96-fk/t: xx_foreign_keys_on.t
| Subject: | xx_foreign_keys_on.t |
#!/usr/bin/perl
# Tests relating to foreign keys.
BEGIN {
$| = 1;
$^W = 1;
}
use Test::More tests => 27;
use File::Spec::Functions ':ALL';
use t::lib::Test;
#####################################################################
# Set up for testing
# Connect
my $file = test_db();
my $dbh = create_ok(
file => catfile(qw{ t xx_foreign_keys_on.sql }),
connect => [ "dbi:SQLite:$file" ],
);
# Create the test package
#####################################################################
# PRAGMA foreign_keys = ON;
eval <<"END_PERL"; die $@ if $@;
package Foo::Bar;
use strict;
use ORLite {
file => '$file',
foreign_keys => 1,
};
1;
END_PERL
#####################################################################
# Run the tests
my @album = Foo::Bar::Album->select;
is( scalar(@album), 1, 'Got one album object' );
isa_ok( $album[0], 'Foo::Bar::Album' );
is( $album[0]->album_id, 1, 'Got album.album_id' );
is( $album[0]->name, 'Album 1', 'Got album.name' );
my @track = Foo::Bar::Track->select;
is( scalar(@track), 1, 'Got one track object' );
isa_ok( $track[0], 'Foo::Bar::Track' );
is( $track[0]->track_id, 1, 'Got track.track_id' );
is( $track[0]->name, 'Track 1', 'Got track.name' );
isa_ok( $track[0]->album, 'Foo::Bar::Album' );
is( $track[0]->album->album_id, 1, 'Got track.album' );
# insert must fail
eval {
Foo::Bar::Track->create(
name => 'Track 2',
album => 2,
);
};
like( $@, qr/foreign key constraint failed/, 'insert with fk violation failed' );
@track = Foo::Bar::Track->select;
is( scalar(@track), 1, 'Got one track object' );
#####################################################################
# PRAGMA foreign_keys = OFF;
eval <<"END_PERL"; die $@ if $@;
package Foo::Bar2;
use strict;
use ORLite {
file => '$file',
};
1;
END_PERL
#####################################################################
# Run the tests
@album = Foo::Bar2::Album->select;
is( scalar(@album), 1, 'Got one album object' );
isa_ok( $album[0], 'Foo::Bar2::Album' );
is( $album[0]->album_id, 1, 'Got album.album_id' );
is( $album[0]->name, 'Album 1', 'Got album.name' );
@track = Foo::Bar2::Track->select;
is( scalar(@track), 1, 'Got one track object' );
isa_ok( $track[0], 'Foo::Bar2::Track' );
is( $track[0]->track_id, 1, 'Got track.track_id' );
is( $track[0]->name, 'Track 1', 'Got track.name' );
isa_ok( $track[0]->album, 'Foo::Bar2::Album' );
is( $track[0]->album->album_id, 1, 'Got track.album' );
# insert succeeds
my $track = Foo::Bar2::Track->create(
name => 'Track 2',
album => 2,
);
isa_ok( $track, 'Foo::Bar2::Track' );
is( $track->name, 'Track 2', 'Got track.name' );
is( $track->album, undef, 'no linked album' );
@track = Foo::Bar2::Track->select;
is( scalar(@track), 2, 'Got two track objects' );