@@ -1,5 +1,16 @@
Revision history for Perl extension DBIx::Class::Loader
+0.14 Sat Jan 21 00:05:11 2006
+ - Bugfix to pgsql tests
+ - Bugfix for pause/cpan module version parsing
+
+0.13 Thu Jan 19 06:40:11 2006
+ - Test suite infrastructure overhauled
+ - New advanced relationship testing [chisel]
+ - Several relationship fixes
+ - some minor pod cleanup
+ - misc bugfixes
+
0.12 Fri Jan 13 06:09:04 2006
- Changed "comment" to "Comment" for mysql "SHOW TABLE STATUS"
- Added relationship tests for pg, mysql, and db2
@@ -12,7 +12,8 @@ META.yml
t/01use.t
t/02pod.t
t/03podcoverage.t
-t/04mysql.t
-t/05pg.t
-t/06sqlite.t
-t/07db2.t
+t/10sqlite_common.t
+t/11mysql_common.t
+t/12pg_common.t
+t/13db2_common.t
+t/dbixcl_common_tests.pm
@@ -1,7 +1,7 @@
# http://module-build.sourceforge.net/META-spec.html
#XXXXXXX This is a prototype!!! It will change in the future!!! XXXXX#
name: DBIx-Class-Loader
-version: 0.12
+version: 0.14
version_from: lib/DBIx/Class/Loader.pm
installdirs: site
requires:
@@ -40,7 +40,10 @@ sub _tables {
my %args = @_;
my $schema = uc ($args{schema} || '');
my $dbh = DBI->connect( @{ $self->{_datasource} } ) or croak($DBI::errstr);
- my @tables = $DBD::DB2::VERSION >= 1.14 ?
+
+ # this is split out to avoid version parsing errors...
+ my $is_dbd_db2_gte_114 = ( $DBD::DB2::VERSION >= 1.14 );
+ my @tables = $is_dbd_db2_gte_114 ?
$dbh->tables( { TABLE_SCHEM => '%', TABLE_TYPE => 'TABLE,VIEW' } )
: $dbh->tables;
$dbh->disconnect;
@@ -71,7 +74,8 @@ SQL
$sth->execute($schema, $tabname) or die;
my @cols = map { @$_ } @{$sth->fetchall_arrayref};
- my $sth = $dbh->prepare(<<'SQL') or die;
+
+ $sth = $dbh->prepare(<<'SQL') or die;
SELECT kcu.COLNAME
FROM SYSCAT.TABCONST as tc
JOIN SYSCAT.KEYCOLUSE as kcu ON tc.constname = kcu.constname
@@ -75,6 +75,13 @@ Username.
=cut
+=head3 new
+
+Not intended to be called directly. This is used internally by the
+C<new()> method in L<DBIx::Class::Loader>.
+
+=cut
+
sub new {
my ( $class, %args ) = @_;
if ( $args{debug} ) {
@@ -165,29 +172,47 @@ sub _belongs_to_many {
my ( $self, $table, $column, $other, $other_column ) = @_;
my $table_class = $self->find_class($table);
my $other_class = $self->find_class($other);
+
warn qq/\# Belongs_to relationship\n/ if $self->debug;
+
if($other_column) {
warn qq/$table_class->belongs_to( '$column' => '$other_class',/
- . qq/ { "foreign.$other_column" => "self.$column" } );\n\n/
+ . qq/ { "foreign.$other_column" => "self.$column" },/
+ . qq/ { accessor => 'filter' });\n\n/
if $self->debug;
$table_class->belongs_to( $column => $other_class,
- { "foreign.$other_column" => "self.$column" } );
+ { "foreign.$other_column" => "self.$column" },
+ { accessor => 'filter' }
+ );
}
else {
warn qq/$table_class->belongs_to( '$column' => '$other_class' );\n\n/
if $self->debug;
$table_class->belongs_to( $column => $other_class );
}
+
my ($table_class_base) = $table_class =~ /.*::(.+)/;
my $plural = Lingua::EN::Inflect::PL( lc $table_class_base );
$plural = $self->{_inflect}->{ lc $table_class_base }
if $self->{_inflect}
and exists $self->{_inflect}->{ lc $table_class_base };
+
warn qq/\# Has_many relationship\n/ if $self->debug;
- warn
- qq/$other_class->has_many( '$plural' => '$table_class', '$column' );\n\n/
- if $self->debug;
- $other_class->has_many( $plural => $table_class, $column );
+
+ if($other_column) {
+ warn qq/$other_class->has_many( '$plural' => '$table_class',/
+ . qq/ { "foreign.$column" => "self.$other_column" } );\n\n/
+ if $self->debug;
+ $other_class->has_many( $plural => $table_class,
+ { "foreign.$column" => "self.$other_column" }
+ );
+ }
+ else {
+ warn qq/$other_class->has_many( '$plural' => '$table_class',/
+ . qq/'$other_column' );\n\n/
+ if $self->debug;
+ $other_class->has_many( $plural => $table_class, $column );
+ }
}
# Load and setup classes
@@ -245,15 +270,17 @@ sub _relationships {
my $self = shift;
foreach my $table ( $self->tables ) {
my $dbh = $self->find_class($table)->storage->dbh;
+ my $quoter = $dbh->get_info(29) || q{"};
if ( my $sth = $dbh->foreign_key_info( '', '', '', '', '', $table ) ) {
for my $res ( @{ $sth->fetchall_arrayref( {} ) } ) {
my $column = $res->{FK_COLUMN_NAME};
my $other = $res->{UK_TABLE_NAME};
my $other_column = $res->{UK_COLUMN_NAME};
- $column =~ s/"//g;
- $other =~ s/"//g;
+ $column =~ s/$quoter//g;
+ $other =~ s/$quoter//g;
+ $other_column =~ s/$quoter//g;
eval { $self->_belongs_to_many( $table, $column, $other,
- $other_column ) };
+ $other_column ) };
warn qq/\# belongs_to_many failed "$@"\n\n/
if $@ && $self->debug;
}
@@ -38,9 +38,13 @@ sub _db_classes {
sub _tables {
my $self = shift;
my $dbh = DBI->connect( @{ $self->{_datasource} } ) or croak($DBI::errstr);
- my @tables = $DBD::Pg::VERSION >= 1.31 ?
+
+ # This is split out to avoid version parsing errors...
+ my $is_dbd_pg_gte_131 = ( $DBD::Pg::VERSION >= 1.31 );
+ my @tables = $is_dbd_pg_gte_131 ?
$dbh->tables( undef, $SCHEMA, "", "table", { noprefix => 1, pg_noprefix => 1 } )
: $dbh->tables;
+
$dbh->disconnect;
s/"//g for @tables;
return @tables;
@@ -46,20 +46,25 @@ sub _relationships {
: ( database => $1 );
my $dbname = $conn{database} || $conn{dbname} || $conn{db};
die("Can't figure out the table name automatically.") if !$dbname;
- my $quoter = $dbh->get_info(29);
foreach my $table (@tables) {
- my $query = "SHOW TABLE STATUS FROM $dbname LIKE '$table'";
+ my $query = "SHOW CREATE TABLE ${dbname}.${table}";
my $sth = $dbh->prepare($query)
- or die("Cannot get table status: $table");
+ or die("Cannot get table definition: $table");
$sth->execute;
- my $comment = $sth->fetchrow_hashref->{Comment} || '';
- $comment =~ s/$quoter//g if ($quoter);
- while ( $comment =~ m!\(`?(\w+)`?\)\sREFER\s`?\w+/(\w+)`?\(`?(\w+)`?\)!g )
- {
- eval { $self->_belongs_to_many( $table, $1, $2, $3 ) };
+ my $table_def = $sth->fetchrow_arrayref->[1] || '';
+
+ my (@cols) = ($table_def =~ /CONSTRAINT `.*` FOREIGN KEY \(`(.*)`\) REFERENCES `(.*)` \(`(.*)`\)/g);
+
+ while (scalar @cols > 0) {
+ my $column = shift @cols;
+ my $remote_table = shift @cols;
+ my $remote_column = shift @cols;
+
+ eval { $self->_belongs_to_many( $table, $column, $remote_table, $remote_column) };
warn qq/\# belongs_to_many failed "$@"\n\n/ if $@ && $self->debug;
}
+
$sth->finish;
}
}
@@ -3,7 +3,7 @@ package DBIx::Class::Loader;
use strict;
use UNIVERSAL::require;
-our $VERSION = '0.12';
+our $VERSION = '0.14';
=head1 NAME
@@ -24,7 +24,8 @@ DBIx::Class::Loader - Dynamic definition of DBIx::Class sub classes.
constraint => '^foo.*',
relationships => 1,
options => { AutoCommit => 1 },
- inflect => { child => 'children' }
+ inflect => { child => 'children' },
+ debug => 1,
);
my $class = $loader->find_class('film'); # $class => Data::Film
my $obj = $class->find(1);
@@ -73,6 +74,16 @@ L<Class::DBI::Loader> and L<Class::DBI> are now obsolete, use L<DBIx::Class> and
=cut
+=head1 METHODS
+
+=head2 new
+
+Example in Synopsis above demonstrates the available arguments. For
+detailed information on the arguments, see the
+L<DBIx::Class::Loader::Generic> documentation.
+
+=cut
+
sub new {
my ( $class, %args ) = @_;
my $dsn = $args{dsn};
@@ -1,140 +0,0 @@
-use strict;
-use Test::More tests => 7;
-
-use DBIx::Class::Loader;
-use DBI;
-
-my $dbh;
-my $database = $ENV{MYSQL_NAME};
-my $user = $ENV{MYSQL_USER};
-my $password = $ENV{MYSQL_PASS};
-my $test_innodb = $ENV{MYSQL_TEST_INNODB};
-
-SKIP: {
- skip
-'You need to set the MYSQL_NAME, MYSQL_USER and MYSQL_PASS environment variables',
- 6
- unless ( $database && $user );
-
- my $dsn = "dbi:mysql:$database";
- $dbh = DBI->connect(
- $dsn, $user,
- $password,
- {
- RaiseError => 1,
- PrintError => 1
- }
- );
-
- $dbh->do(<<'SQL');
-CREATE TABLE loader_test1 (
- id INTEGER NOT NULL PRIMARY KEY AUTO_INCREMENT,
- dat VARCHAR(32)
-)
-SQL
-
- my $sth = $dbh->prepare(<<"SQL");
-INSERT INTO loader_test1 (dat) VALUES(?)
-SQL
- for my $dat (qw(foo bar baz)) {
- $sth->execute($dat);
- $sth->finish;
- }
-
- $dbh->do(<<'SQL');
-CREATE TABLE loader_test2 (
- id INTEGER NOT NULL PRIMARY KEY AUTO_INCREMENT,
- dat VARCHAR(32)
-)
-SQL
-
- $sth = $dbh->prepare(<<"SQL");
-INSERT INTO loader_test2 (dat) VALUES(?)
-SQL
- for my $dat (qw(aaa bbb ccc ddd)) {
- $sth->execute($dat);
- $sth->finish;
- }
- $sth->finish;
-
- if($test_innodb) {
- $dbh->do(<<'SQL');
-CREATE TABLE loader_test3 (
- id INTEGER NOT NULL PRIMARY KEY,
- dat VARCHAR(32)
-)
-ENGINE='InnoDB'
-SQL
-
- $sth = $dbh->prepare(<<"SQL");
-INSERT INTO loader_test3 (id,dat) VALUES(?,?)
-SQL
- my $i = 1;
- for my $dat (qw(aaa bbb ccc ddd)) {
- $sth->execute($i++,$dat);
- $sth->finish;
- }
- $sth->finish;
-
- $dbh->do(<<'SQL');
-CREATE TABLE loader_test4 (
- id INTEGER NOT NULL PRIMARY KEY,
- fkid INTEGER NOT NULL,
- dat VARCHAR(32),
- FOREIGN KEY (fkid) REFERENCES loader_test3 (id)
-)
-ENGINE='InnoDB'
-SQL
-
- $sth = $dbh->prepare(<<"SQL");
-INSERT INTO loader_test4 (id,fkid,dat) VALUES(?,?,?)
-SQL
- $i = 1;
- my $j = 123;
- for my $dat (qw(aaa bbb ccc ddd)) {
- $sth->execute($j++,$i++,$dat);
- $sth->finish;
- }
- $sth->finish;
- }
-
- my $loader = DBIx::Class::Loader->new(
- dsn => $dsn,
- user => $user,
- password => $password,
- constraint => '^loader_test.+',
- namespace => 'MysqlTest',
- relationships => 1,
- );
- is( $loader->find_class("loader_test1"), "MysqlTest::LoaderTest1" );
- is( $loader->find_class("loader_test2"), "MysqlTest::LoaderTest2" );
- my $class1 = $loader->find_class("loader_test1");
- my $obj = $class1->find(1);
- is( $obj->id, 1 );
- is( $obj->dat, "foo" );
- my $class2 = $loader->find_class("loader_test2");
- is( $class2->count, 4 );
- my ($obj2) = $class2->find( dat => 'bbb' );
- is( $obj2->id, 2 );
- SKIP: {
- skip 'You need to set the MYSQL_TEST_INNODB environment variable to test relationships', 1
- unless $test_innodb;
-
- my $class3 = $loader->find_class("loader_test3");
- my $class4 = $loader->find_class("loader_test4");
- my $obj4 = $class4->find(123);
- is( ref($obj4->fkid), $class3);
- }
-}
-
-END {
- if ($dbh) {
- $dbh->do("DROP TABLE loader_test1");
- $dbh->do("DROP TABLE loader_test2");
- if($test_innodb) {
- $dbh->do("DROP TABLE loader_test4");
- $dbh->do("DROP TABLE loader_test3");
- }
- $dbh->disconnect;
- }
-}
@@ -1,134 +0,0 @@
-use strict;
-use Test::More tests => 7;
-
-use DBIx::Class::Loader;
-use DBI;
-
-my $dbh;
-my $database = $ENV{PG_NAME};
-my $user = $ENV{PG_USER};
-my $password = $ENV{PG_PASS};
-
-SKIP: {
- skip
- 'You need to set the PG_NAME, PG_USER and PG_PASS environment variables',
- 7
- unless ( $database && $user );
-
- my $dsn = "dbi:Pg:dbname=$database";
- $dbh = DBI->connect(
- $dsn, $user,
- $password,
- {
- RaiseError => 1,
- PrintError => 1,
- AutoCommit => 1
- }
- );
-
- $dbh->do(<<'SQL');
-CREATE TABLE loader_test1 (
- id SERIAL NOT NULL PRIMARY KEY ,
- dat TEXT
-)
-SQL
-
- my $sth = $dbh->prepare(<<"SQL");
-INSERT INTO loader_test1 (dat) VALUES(?)
-SQL
- for my $dat (qw(foo bar baz)) {
- $sth->execute($dat);
- $sth->finish;
- }
-
- $dbh->do(<<'SQL');
-CREATE TABLE loader_test2 (
- id SERIAL NOT NULL PRIMARY KEY,
- dat TEXT
-)
-SQL
-
- $sth = $dbh->prepare(<<"SQL");
-INSERT INTO loader_test2 (dat) VALUES(?)
-SQL
- for my $dat (qw(aaa bbb ccc ddd)) {
- $sth->execute($dat);
- $sth->finish;
- }
-
- $dbh->do(<<'SQL');
-CREATE TABLE loader_test3 (
- id INTEGER NOT NULL PRIMARY KEY,
- dat VARCHAR(32)
-)
-SQL
-
- $sth = $dbh->prepare(<<"SQL");
-INSERT INTO loader_test3 (id,dat) VALUES(?,?)
-SQL
- my $i = 1;
- for my $dat (qw(aaa bbb ccc ddd)) {
- $sth->execute($i++,$dat);
- $sth->finish;
- }
- $sth->finish;
-
- $dbh->do(<<'SQL');
-CREATE TABLE loader_test4 (
- id INTEGER NOT NULL PRIMARY KEY,
- fkid INTEGER NOT NULL,
- dat VARCHAR(32),
- FOREIGN KEY (fkid) REFERENCES loader_test3 (id)
-)
-SQL
-
- $sth = $dbh->prepare(<<"SQL");
-INSERT INTO loader_test4 (id,fkid,dat) VALUES(?,?,?)
-SQL
- $i = 1;
- my $j = 123;
- for my $dat (qw(aaa bbb ccc ddd)) {
- $sth->execute($j++,$i++,$dat);
- $sth->finish;
- }
- $sth->finish;
-
-
- my $loader = DBIx::Class::Loader->new(
- dsn => $dsn,
- user => $user,
- password => $password,
- namespace => 'PgTest',
- constraint => '^loader_test.*',
- relationships => 1,
- );
- is( $loader->find_class("loader_test1"), "PgTest::LoaderTest1" );
- is( $loader->find_class("loader_test2"), "PgTest::LoaderTest2" );
- my $class1 = $loader->find_class("loader_test1");
- my $obj = $class1->find(1);
- is( $obj->id, 1 );
- is( $obj->dat, "foo" );
- my $class2 = $loader->find_class("loader_test2");
- is( $class2->count, 4 );
- my ($obj2) = $class2->find( dat => 'bbb' );
- is( $obj2->id, 2 );
- my $class3 = $loader->find_class("loader_test3");
- my $class4 = $loader->find_class("loader_test4");
- my $obj4 = $class4->find(123);
- is( ref($obj4->fkid), $class3);
-
- $class1->storage->dbh->disconnect;
- $class2->storage->dbh->disconnect;
- $class3->storage->dbh->disconnect;
- $class4->storage->dbh->disconnect;
-}
-
-END {
- if ($dbh) {
- $dbh->do("DROP TABLE loader_test1");
- $dbh->do("DROP TABLE loader_test2");
- $dbh->do("DROP TABLE loader_test4");
- $dbh->do("DROP TABLE loader_test3");
- $dbh->disconnect;
- }
-}
@@ -1,150 +0,0 @@
-use strict;
-use Test::More;
-
-BEGIN {
- plan tests => 15;
-}
-
-use DBIx::Class::Loader;
-use DBI;
-
-eval { require DBD::SQLite };
-my $class = $@ ? 'SQLite2' : 'SQLite';
-
-my $dbh;
-my $database = './t/sqlite_test';
-
-my $dsn = "dbi:$class:dbname=$database";
-$dbh = DBI->connect(
- $dsn, "", "",
- {
- RaiseError => 1,
- PrintError => 1,
- AutoCommit => 1
- }
-);
-
-$dbh->do(<<'SQL');
-CREATE TABLE loader_test1 (
- id INTEGER NOT NULL PRIMARY KEY ,
- dat TEXT
-)
-SQL
-
-my $sth = $dbh->prepare(<<"SQL");
-INSERT INTO loader_test1 (dat) VALUES(?)
-SQL
-for my $dat (qw(foo bar baz)) {
- $sth->execute($dat);
- $sth->finish;
-}
-
-$dbh->do(<<'SQL');
-CREATE TABLE loader_test2 (
- id INTEGER NOT NULL PRIMARY KEY,
- dat TEXT
-)
-SQL
-
-$sth = $dbh->prepare(<<"SQL");
-INSERT INTO loader_test2 (dat) VALUES(?)
-SQL
-for my $dat (qw(aaa bbb ccc ddd)) {
- $sth->execute($dat);
- $sth->finish;
-}
-
-$dbh->do(<<'SQL');
-CREATE TABLE loader_test3 (
- id1 INTEGER,
- id2 INTEGER, --, id2 INTEGER REFERENCES loader_test1,
- dat TEXT,
- PRIMARY KEY (id1,id2)
-)
-SQL
-
-$dbh->do("INSERT INTO loader_test3 (id1,id2,dat) VALUES (1,1,'aaa')");
-
-$dbh->do(<<'SQL');
-CREATE TABLE loader_test4 (
- id INTEGER NOT NULL PRIMARY KEY,
- id2 INTEGER,
- loader_test2 INTEGER REFERENCES loader_test2,
- dat TEXT,
- FOREIGN KEY (id, id2 ) REFERENCES loader_test3 (id1,id2)
-)
-SQL
-
-$dbh->do("INSERT INTO loader_test4 (id2,loader_test2,dat) VALUES (1,1,'aaa')");
-
-$dbh->do(<<'SQL');
-CREATE TABLE loader_test5 (
- id INTEGER NOT NULL PRIMARY KEY,
- id2 TEXT NOT NULL UNIQUE,
- dat TEXT
-)
-SQL
-
-$dbh->do("INSERT INTO loader_test5 (id,id2,dat) VALUES (1,'aaa','bbb')");
-
-$dbh->do(<<'SQL');
-CREATE TABLE loader_test6 (
- id INTEGER NOT NULL PRIMARY KEY,
- loader_test5 TEXT NOT NULL,
- dat TEXT,
- FOREIGN KEY (loader_test5) REFERENCES loader_test5 (id2)
-)
-SQL
-
-$dbh->do("INSERT INTO loader_test6 (id,loader_test5,dat) VALUES (1,'aaa','bbb')");
-
-$dbh->do(<<'SQL');
-CREATE TABLE loader_test7 (
- loader_test7 TEXT NOT NULL
-)
-SQL
-
-my $loader = DBIx::Class::Loader->new(
- dsn => $dsn,
- namespace => 'SQLiteTest',
- constraint => '^loader_test.*',
- relationships => 1,
-);
-
-is( $loader->find_class("loader_test1"), "SQLiteTest::LoaderTest1" );
-is( $loader->find_class("loader_test2"), "SQLiteTest::LoaderTest2" );
-is( $loader->find_class("loader_test3"), "SQLiteTest::LoaderTest3" );
-is( $loader->find_class("loader_test4"), "SQLiteTest::LoaderTest4" );
-is( $loader->find_class("loader_test5"), "SQLiteTest::LoaderTest5" );
-is( $loader->find_class("loader_test6"), "SQLiteTest::LoaderTest6" );
-is( $loader->find_class("loader_test7"), "SQLiteTest::LoaderTest7" );
-
-my $class1 = $loader->find_class("loader_test1");
-my $obj = $class1->find(1);
-is( $obj->id, 1 );
-is( $obj->dat, "foo" );
-my $class2 = $loader->find_class("loader_test2");
-is( $class2->count, 4 );
-my ($obj2) = $class2->search( dat => 'bbb' );
-is( $obj2->id, 2 );
-my $class3 = $loader->find_class("loader_test3");
-my $obj3 = $class3->find( id1 => 1, id2 => 1 );
-is( ref( $obj3->id2 ), '' ); # fk def in comments should not be parsed
-my $class4 = $loader->find_class("loader_test4");
-my $obj4 = $class4->find(1);
-is( $obj4->loader_test2->isa('SQLiteTest::LoaderTest2'), 1 );
-is( ref( $obj4->id2 ), '' ); # mulit-col fk def should not be parsed
-my $class5 = $loader->find_class("loader_test5");
-my $class6 = $loader->find_class("loader_test6");
-my $obj6 = $class6->find(1);
-# fk that references a non-pk
-is( $obj6->loader_test5->isa('SQLiteTest::LoaderTest5'), 1 );
-my $class7 = $loader->find_class("loader_test7");
-
-for ( $class1, $class2, $class3, $class4, $class5, $class6, $class7 ) {
- $_->storage->dbh->disconnect;
-}
-
-END {
- unlink './t/sqlite_test';
-}
@@ -1,133 +0,0 @@
-use strict;
-use Test::More tests => 7;
-
-use DBIx::Class::Loader;
-use DBI;
-
-my $dbh;
-my $database = $ENV{DB2_NAME};
-my $user = $ENV{DB2_USER};
-my $password = $ENV{DB2_PASS};
-
-SKIP: {
- skip
- 'You need to set the DB2_NAME, DB2_USER and DB2_PASS environment variables',
- 7
- unless ( $database && $user );
-
- my $dsn = "dbi:DB2:dbname=$database";
- $dbh = DBI->connect(
- $dsn, $user,
- $password,
- {
- RaiseError => 1,
- PrintError => 1,
- AutoCommit => 1
- }
- );
-
- $dbh->do(<<'SQL');
-CREATE TABLE loader_test1 (
- id SERIAL NOT NULL PRIMARY KEY ,
- dat TEXT
-)
-SQL
-
- my $sth = $dbh->prepare(<<"SQL");
-INSERT INTO loader_test1 (dat) VALUES(?)
-SQL
- for my $dat (qw(foo bar baz)) {
- $sth->execute($dat);
- $sth->finish;
- }
-
- $dbh->do(<<'SQL');
-CREATE TABLE loader_test2 (
- id SERIAL NOT NULL PRIMARY KEY,
- dat TEXT
-)
-SQL
-
- $sth = $dbh->prepare(<<"SQL");
-INSERT INTO loader_test2 (dat) VALUES(?)
-SQL
- for my $dat (qw(aaa bbb ccc ddd)) {
- $sth->execute($dat);
- $sth->finish;
- }
-
- $dbh->do(<<'SQL');
-CREATE TABLE loader_test3 (
- id INTEGER NOT NULL PRIMARY KEY,
- dat VARCHAR(32)
-)
-SQL
-
- $sth = $dbh->prepare(<<"SQL");
-INSERT INTO loader_test3 (id,dat) VALUES(?,?)
-SQL
- my $i = 1;
- for my $dat (qw(aaa bbb ccc ddd)) {
- $sth->execute($i++,$dat);
- $sth->finish;
- }
- $sth->finish;
-
- $dbh->do(<<'SQL');
-CREATE TABLE loader_test4 (
- id INTEGER NOT NULL PRIMARY KEY,
- fkid INTEGER NOT NULL,
- dat VARCHAR(32),
- FOREIGN KEY (fkid) REFERENCES loader_test3 (id)
-)
-SQL
-
- $sth = $dbh->prepare(<<"SQL");
-INSERT INTO loader_test4 (id,fkid,dat) VALUES(?,?,?)
-SQL
- $i = 1;
- my $j = 123;
- for my $dat (qw(aaa bbb ccc ddd)) {
- $sth->execute($j++,$i++,$dat);
- $sth->finish;
- }
- $sth->finish;
-
- my $loader = DBIx::Class::Loader->new(
- dsn => $dsn,
- user => $user,
- password => $password,
- namespace => 'DB2Test',
- constraint => '^loader_test.*',
- relationships => 1,
- );
- is( $loader->find_class("loader_test1"), "DB2Test::LoaderTest1" );
- is( $loader->find_class("loader_test2"), "DB2Test::LoaderTest2" );
- my $class1 = $loader->find_class("loader_test1");
- my $obj = $class1->find(1);
- is( $obj->id, 1 );
- is( $obj->dat, "foo" );
- my $class2 = $loader->find_class("loader_test2");
- is( $class2->count, 4 );
- my ($obj2) = $class2->find( dat => 'bbb' );
- is( $obj2->id, 2 );
- my $class3 = $loader->find_class("loader_test3");
- my $class4 = $loader->find_class("loader_test4");
- my $obj4 = $class4->find(123);
- is( ref($obj4->fkid), $class3 );
-
- $class1->storage->dbh->disconnect;
- $class2->storage->dbh->disconnect;
- $class3->storage->dbh->disconnect;
- $class4->storage->dbh->disconnect;
-}
-
-END {
- if ($dbh) {
- $dbh->do("DROP TABLE loader_test1");
- $dbh->do("DROP TABLE loader_test2");
- $dbh->do("DROP TABLE loader_test4");
- $dbh->do("DROP TABLE loader_test3");
- $dbh->disconnect;
- }
-}
@@ -0,0 +1,23 @@
+use strict;
+use lib qw( ./t );
+use dbixcl_common_tests;
+
+eval { require DBD::SQLite };
+my $class = $@ ? 'SQLite2' : 'SQLite';
+
+{
+ my $tester = dbixcl_common_tests->new(
+ vendor => 'SQLite',
+ auto_inc_pk => 'INTEGER NOT NULL PRIMARY KEY',
+ dsn => "dbi:$class:dbname=./t/sqlite_test",
+ user => '',
+ password => '',
+ multi_fk_broken => 1,
+ );
+
+ $tester->run_tests();
+}
+
+END {
+ unlink './t/sqlite_test';
+}
@@ -0,0 +1,28 @@
+use strict;
+use lib qw( . ./t );
+use dbixcl_common_tests;
+
+my $database = $ENV{MYSQL_NAME} || '';
+my $user = $ENV{MYSQL_USER} || '';
+my $password = $ENV{MYSQL_PASS} || '';
+my $test_innodb = $ENV{MYSQL_TEST_INNODB} || 0;
+
+my $skip_rels_msg = 'You need to set the MYSQL_TEST_INNODB environment variable to test relationships';
+
+my $tester = dbixcl_common_tests->new(
+ vendor => 'Mysql',
+ auto_inc_pk => 'INTEGER NOT NULL PRIMARY KEY AUTO_INCREMENT',
+ innodb => q{Engine='InnoDB'},
+ dsn => "dbi:mysql:$database",
+ user => $user,
+ password => $password,
+ skip_rels => $test_innodb ? 0 : $skip_rels_msg,
+ multi_fk_broken => 1,
+);
+
+if( !$database || !$user ) {
+ $tester->skip_tests('You need to set the MYSQL_NAME, MYSQL_USER and MYSQL_PASS environment variables');
+}
+else {
+ $tester->run_tests();
+}
@@ -0,0 +1,22 @@
+use strict;
+use lib qw( . ./t );
+use dbixcl_common_tests;
+
+my $database = $ENV{PG_NAME} || '';
+my $user = $ENV{PG_USER} || '';
+my $password = $ENV{PG_PASS} || '';
+
+my $tester = dbixcl_common_tests->new(
+ vendor => 'Pg',
+ auto_inc_pk => 'SERIAL NOT NULL PRIMARY KEY',
+ dsn => "dbi:Pg:dbname=$database",
+ user => $user,
+ password => $password,
+);
+
+if( !$database || !$user ) {
+ $tester->skip_tests('You need to set the PG_NAME, PG_USER and PG_PASS environment variables');
+}
+else {
+ $tester->run_tests();
+}
@@ -0,0 +1,22 @@
+use strict;
+use lib qw( . ./t );
+use dbixcl_common_tests;
+
+my $database = $ENV{DB2_NAME} || '';
+my $user = $ENV{DB2_USER} || '';
+my $password = $ENV{DB2_PASS} || '';
+
+my $tester = dbixcl_common_tests->new(
+ vendor => 'DB2',
+ auto_inc_pk => 'SERIAL NOT NULL PRIMARY KEY',
+ dsn => "dbi:DB2:$database",
+ user => $user,
+ password => $password,
+);
+
+if( !$database || !$user ) {
+ $tester->skip_tests('You need to set the DB2_NAME, DB2_USER and DB2_PASS environment variables');
+}
+else {
+ $tester->run_tests();
+}
@@ -0,0 +1,372 @@
+package dbixcl_common_tests;
+
+use strict;
+
+use Test::More;
+use DBIx::Class::Loader;
+use DBI;
+
+sub new {
+ my $class = shift;
+
+ my $self;
+
+ if( ref($_[0]) eq 'HASH') {
+ my $args = shift;
+ $self = { (%$args) };
+ }
+ else {
+ $self = { @_ };
+ }
+
+ # Only MySQL uses this
+ $self->{innodb} ||= '';
+
+ return bless $self => $class;
+}
+
+sub skip_tests {
+ my ($self, $why) = @_;
+
+ plan skip_all => $why;
+}
+
+sub run_tests {
+ my $self = shift;
+
+ plan tests => 26;
+
+ $self->create();
+
+ my $namespace = 'DBIXCL_Test_' . $self->{vendor};
+
+ my $loader = DBIx::Class::Loader->new(
+ dsn => $self->{dsn},
+ user => $self->{user},
+ password => $self->{password},
+ namespace => $namespace,
+ constraint => '^loader_test.*',
+ relationships => 1,
+ );
+
+ my $class1 = $loader->find_class("loader_test1");
+ my $class2 = $loader->find_class("loader_test2");
+
+ is( $class1, "${namespace}::LoaderTest1" );
+ is( $class2, "${namespace}::LoaderTest2" );
+
+ my $obj = $class1->find(1);
+ is( $obj->id, 1 );
+ is( $obj->dat, "foo" );
+ is( $class2->count, 4 );
+
+ my ($obj2) = $class2->find( dat => 'bbb' );
+ is( $obj2->id, 2 );
+
+ SKIP: {
+ skip $self->{skip_rels}, 20 if $self->{skip_rels};
+
+ my $class3 = $loader->find_class("loader_test3");
+ my $class4 = $loader->find_class("loader_test4");
+ my $class5 = $loader->find_class("loader_test5");
+ my $class6 = $loader->find_class("loader_test6");
+ my $class7 = $loader->find_class("loader_test7");
+ my $class8 = $loader->find_class("loader_test8");
+ my $class9 = $loader->find_class("loader_test9");
+
+ is( $class3, "${namespace}::LoaderTest3" );
+ is( $class4, "${namespace}::LoaderTest4" );
+ is( $class5, "${namespace}::LoaderTest5" );
+ is( $class6, "${namespace}::LoaderTest6" );
+ is( $class7, "${namespace}::LoaderTest7" );
+ is( $class8, "${namespace}::LoaderTest8" );
+ is( $class9, "${namespace}::LoaderTest9" );
+
+ # basic rel test
+ my $obj4 = $class4->find(123);
+ is( ref($obj4->fkid), $class3);
+
+ # fk def in comments should not be parsed
+ my $obj5 = $class5->find( id1 => 1, id2 => 1 );
+ is( ref( $obj5->id2 ), '' );
+
+ # mulit-col fk def (works halfway for some, not others...)
+ my $obj6 = $class6->find(1);
+ isa_ok( $obj6->loader_test2, $class2 );
+ SKIP: {
+ skip "Multi-column FKs are only half-working for this vendor", 1
+ unless $self->{multi_fk_broken};
+ is( ref( $obj6->id2 ), '' );
+ }
+
+ # fk that references a non-pk key (UNIQUE)
+ my $obj8 = $class8->find(1);
+ isa_ok( $obj8->loader_test7, $class7 );
+
+ # from Chisel's tests...
+ SKIP: {
+ if($self->{vendor} =~ /sqlite/i) {
+ skip 'SQLite cannot do the advanced tests', 8;
+ }
+
+ my $class10 = $loader->find_class('loader_test10');
+ my $class11 = $loader->find_class('loader_test11');
+
+ is( $class10, "${namespace}::LoaderTest10" );
+ is( $class11, "${namespace}::LoaderTest11" );
+
+ my $obj10 = $class10->create({ subject => 'xyzzy' });
+
+ $obj10->update();
+ ok( defined $obj10, '$obj10 is defined' );
+
+ my $obj11 = $class11->create({ loader_test10 => $obj10->id() });
+ $obj11->update();
+ ok( defined $obj11, '$obj11 is defined' );
+
+ eval {
+ my $obj10_2 = $obj11->loader_test10;
+ $obj10_2->loader_test11( $obj11->id11() );
+ $obj10_2->update();
+ };
+ is($@, '', 'No errors after eval{}');
+
+ SKIP: {
+ skip 'Previous eval block failed', 3
+ unless ($@ eq '');
+
+ my $results = $class10->search({ subject => 'xyzzy' });
+ is( $results->count(), 1,
+ 'One $class10 returned from search' );
+
+ my $obj10_3 = $results->first();
+ isa_ok( $obj10_3, $class10 );
+ is( $obj10_3->loader_test11()->id(), $obj11->id(),
+ 'found same $class11 object we expected' );
+ }
+
+ for ( $class10, $class11 ) {
+ $_->storage->dbh->disconnect;
+ }
+ }
+
+ for ( $class3, $class4, $class5, $class6, $class7,
+ $class8, $class9 ) {
+ $_->storage->dbh->disconnect;
+ }
+ }
+
+ for ( $class1, $class2 ) {
+ $_->storage->dbh->disconnect;
+ }
+}
+
+sub dbconnect {
+ my ($self, $complain) = @_;
+
+ DBI->connect(
+ $self->{dsn}, $self->{user},
+ $self->{password},
+ {
+ RaiseError => $complain,
+ PrintError => $complain,
+ AutoCommit => 1,
+ }
+ );
+}
+
+sub create {
+ my $self = shift;
+
+ my @statements = (
+ qq{
+ CREATE TABLE loader_test1 (
+ id $self->{auto_inc_pk},
+ dat VARCHAR(32)
+ ) $self->{innodb};
+ },
+
+ q{ INSERT INTO loader_test1 (dat) VALUES('foo'); },
+ q{ INSERT INTO loader_test1 (dat) VALUES('bar'); },
+ q{ INSERT INTO loader_test1 (dat) VALUES('baz'); },
+
+ qq{
+ CREATE TABLE loader_test2 (
+ id $self->{auto_inc_pk},
+ dat VARCHAR(32)
+ ) $self->{innodb};
+ },
+
+ q{ INSERT INTO loader_test2 (dat) VALUES('aaa'); },
+ q{ INSERT INTO loader_test2 (dat) VALUES('bbb'); },
+ q{ INSERT INTO loader_test2 (dat) VALUES('ccc'); },
+ q{ INSERT INTO loader_test2 (dat) VALUES('ddd'); },
+ );
+
+ my @statements_reltests = (
+ qq{
+ CREATE TABLE loader_test3 (
+ id INTEGER NOT NULL PRIMARY KEY,
+ dat VARCHAR(32)
+ ) $self->{innodb};
+ },
+
+ q{ INSERT INTO loader_test3 (id,dat) VALUES(1,'aaa'); },
+ q{ INSERT INTO loader_test3 (id,dat) VALUES(2,'bbb'); },
+ q{ INSERT INTO loader_test3 (id,dat) VALUES(3,'ccc'); },
+ q{ INSERT INTO loader_test3 (id,dat) VALUES(4,'ddd'); },
+
+ qq{
+ CREATE TABLE loader_test4 (
+ id INTEGER NOT NULL PRIMARY KEY,
+ fkid INTEGER NOT NULL,
+ dat VARCHAR(32),
+ FOREIGN KEY (fkid) REFERENCES loader_test3 (id)
+ ) $self->{innodb};
+ },
+
+ q{ INSERT INTO loader_test4 (id,fkid,dat) VALUES(123,1,'aaa'); },
+ q{ INSERT INTO loader_test4 (id,fkid,dat) VALUES(124,2,'bbb'); },
+ q{ INSERT INTO loader_test4 (id,fkid,dat) VALUES(125,3,'ccc'); },
+ q{ INSERT INTO loader_test4 (id,fkid,dat) VALUES(126,4,'ddd'); },
+
+ qq{
+ CREATE TABLE loader_test5 (
+ id1 INTEGER,
+ id2 INTEGER, -- , id2 INTEGER REFERENCES loader_test1,
+ dat TEXT,
+ PRIMARY KEY (id1,id2)
+ ) $self->{innodb};
+ },
+
+ q{ INSERT INTO loader_test5 (id1,id2,dat) VALUES (1,1,'aaa'); },
+
+ qq{
+ CREATE TABLE loader_test6 (
+ id $self->{auto_inc_pk},
+ id2 INTEGER,
+ loader_test2 INTEGER,
+ dat TEXT,
+ FOREIGN KEY (loader_test2) REFERENCES loader_test2 (id),
+ FOREIGN KEY (id, id2 ) REFERENCES loader_test5 (id1,id2)
+ ) $self->{innodb};
+ },
+
+ (q{ INSERT INTO loader_test6 (id2,loader_test2,dat) } .
+ q{ VALUES (1,1,'aaa'); }),
+
+ qq{
+ CREATE TABLE loader_test7 (
+ id INTEGER NOT NULL PRIMARY KEY,
+ id2 VARCHAR(8) NOT NULL UNIQUE,
+ dat TEXT
+ ) $self->{innodb};
+ },
+
+ q{ INSERT INTO loader_test7 (id,id2,dat) VALUES (1,'aaa','bbb'); },
+
+ qq{
+ CREATE TABLE loader_test8 (
+ id INTEGER NOT NULL PRIMARY KEY,
+ loader_test7 VARCHAR(8) NOT NULL,
+ dat TEXT,
+ FOREIGN KEY (loader_test7) REFERENCES loader_test7 (id2)
+ ) $self->{innodb};
+ },
+
+ (q{ INSERT INTO loader_test8 (id,loader_test7,dat) } .
+ q{ VALUES (1,'aaa','bbb'); }),
+
+ qq{
+ CREATE TABLE loader_test9 (
+ loader_test9 TEXT NOT NULL
+ ) $self->{innodb};
+ },
+ );
+
+ my @statements_advanced = (
+ qq{
+ CREATE TABLE loader_test10 (
+ id10 $self->{auto_inc_pk},
+ subject VARCHAR(8),
+ loader_test11 INTEGER
+ ) $self->{innodb};
+ },
+
+ qq{
+ CREATE TABLE loader_test11 (
+ id11 $self->{auto_inc_pk},
+ message VARCHAR(8) DEFAULT 'foo',
+ loader_test10 INTEGER NOT NULL,
+ FOREIGN KEY (loader_test10) REFERENCES loader_test10 (id10)
+ ) $self->{innodb};
+ },
+
+ (q{ ALTER TABLE loader_test10 ADD CONSTRAINT } .
+ q{ loader_test11_fk FOREIGN KEY (loader_test11) } .
+ q{ REFERENCES loader_test11 (id11); }),
+ );
+
+ $self->{created} = 1;
+
+ my $dbh = $self->dbconnect(1);
+ $dbh->do($_) for (@statements);
+ unless($self->{skip_rels}) {
+ $dbh->do($_) for (@statements_reltests);
+ unless($self->{vendor} =~ /sqlite/i) {
+ $dbh->do($_) for (@statements_advanced);
+ }
+ }
+ $dbh->disconnect();
+}
+
+sub DESTROY {
+ my $self = shift;
+
+ return unless $self->{created};
+
+ my @tables = qw/
+ loader_test1
+ loader_test2
+ /;
+
+ my @tables_reltests = qw/
+ loader_test4
+ loader_test3
+ loader_test6
+ loader_test5
+ loader_test8
+ loader_test7
+ loader_test9
+ /;
+
+ my @tables_advanced = qw/
+ loader_test11
+ loader_test10
+ /;
+
+ my $drop_fk_mysql =
+ q{ALTER TABLE loader_test10 DROP FOREIGN KEY loader_test11_fk;};
+
+ my $drop_fk =
+ q{ALTER TABLE loader_test10 DROP CONSTRAINT loader_test11_fk;};
+
+ my $dbh = $self->dbconnect(0);
+
+ unless($self->{skip_rels}) {
+ $dbh->do("DROP TABLE $_") for (@tables_reltests);
+ unless($self->{vendor} =~ /sqlite/i) {
+ if($self->{vendor} =~ /mysql/i) {
+ $dbh->do($drop_fk_mysql);
+ }
+ else {
+ $dbh->do($drop_fk);
+ }
+ $dbh->do("DROP TABLE $_") for (@tables_advanced);
+ }
+ }
+ $dbh->do("DROP TABLE $_") for (@tables);
+ $dbh->disconnect();
+}
+
+1;