DBIx-QuickORM
view release on metacpan or search on metacpan
t/AI/dialect_sqlite_keys.t view on Meta::CPAN
use Test2::V0;
use DBI;
use File::Temp qw/tempdir/;
# SQLite key introspection: a plain (non-unique) CREATE INDEX must not be
# recorded as a unique constraint. Unique constraints drive link cardinality
# in Schema::_resolve_links, so a plain index on a FK column previously turned
# a one-to-many link into a (wrong) one-to-one link.
BEGIN {
skip_all "DBD::SQLite is required for these tests"
unless eval { require DBD::SQLite; 1 };
}
require DBIx::QuickORM;
my $dir = tempdir(CLEANUP => 1);
my $dsn = "dbi:SQLite:dbname=$dir/keys.sqlite";
{
my $dbh = DBI->connect($dsn, '', '', {RaiseError => 1, PrintError => 0});
$dbh->do('CREATE TABLE foo (id INTEGER PRIMARY KEY, name TEXT)');
$dbh->do(<<' EOT');
CREATE TABLE bar (
id INTEGER PRIMARY KEY,
foo_id INTEGER NOT NULL REFERENCES foo(id),
tag TEXT
)
EOT
$dbh->do('CREATE INDEX bar_foo_idx ON bar(foo_id)');
$dbh->do('CREATE UNIQUE INDEX bar_tag_idx ON bar(tag)');
$dbh->disconnect;
}
my $con = DBIx::QuickORM->quick(credentials => {dsn => $dsn});
my $schema = $con->schema;
my $bar = $schema->table('bar');
subtest unique_constraints => sub {
ok(!$bar->unique->{'foo_id'}, "plain index on foo_id is NOT recorded as a unique constraint");
ok($bar->unique->{'tag'}, "unique index on tag IS recorded as a unique constraint");
ok($bar->unique->{'id'}, "primary key is recorded as a unique constraint");
};
subtest link_cardinality => sub {
my $foo = $schema->table('foo');
my ($to_bar) = grep { $_->other_table eq 'bar' } @{$foo->links};
ok($to_bar, "foo has a link to bar");
ok(!$to_bar->unique, "foo -> bar link is one-to-many (bar.foo_id is not unique)");
my ($to_foo) = grep { $_->other_table eq 'foo' } @{$bar->links};
ok($to_foo, "bar has a link to foo");
ok($to_foo->unique, "bar -> foo link is one-to-one (foo.id is the primary key)");
};
done_testing;
( run in 0.708 second using v1.01-cache-2.11-cpan-f4a522933cf )