From: Rafael Kitover Date: Mon, 9 Nov 2009 19:04:52 +0000 (+0000) Subject: this stuff does not work yet X-Git-Tag: 0.04999_13~23^2~19 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=9a95164df15467a6f94d3d74e8f3b508b6607e23;p=dbsrgits%2FDBIx-Class-Schema-Loader.git this stuff does not work yet --- diff --git a/lib/DBIx/Class/Schema/Loader/Base.pm b/lib/DBIx/Class/Schema/Loader/Base.pm index 70602ea..de54546 100644 --- a/lib/DBIx/Class/Schema/Loader/Base.pm +++ b/lib/DBIx/Class/Schema/Loader/Base.pm @@ -33,6 +33,7 @@ __PACKAGE__->mk_ro_accessors(qw/ moniker_map inflect_singular inflect_plural + naming debug dump_directory dump_overwrite @@ -73,6 +74,55 @@ L. Available constructor options ar Skip setting up relationships. The default is to attempt the loading of relationships. +=head2 naming + +Static schemas (ones dumped to disk) will, by default, use the new-style 0.05XXX +relationship names and singularized Results, unless you're overwriting an +existing dump made by a 0.04XXX version of L, in +which case the backward compatible RelBuilder will be activated, and +singularization will be turned off. + +Specifying + + naming => 'v5' + +will disable the backward-compatible RelBuilder and use +the new-style relationship names along with singularized Results, even when +overwriting a dump made with an earlier version. + +The option also takes a hashref: + + naming => { relationships => 'v5', results => 'v4' } + +The values can be: + +=over 4 + +=item current + +Latest default style, whatever that happens to be. + +=item v5 + +Version 0.05XXX style. + +=item v4 + +Version 0.04XXX style. + +=back + +Dynamic schemas will always default to the 0.04XXX relationship names and won't +singularize Results for backward compatibility, to activate the new RelBuilder +and singularization put this in your C file: + + __PACKAGE__->naming('current'); + +Or if you prefer to use 0.05XXX features but insure that nothing breaks in the +next major version upgrade: + + __PACKAGE__->naming('v5'); + =head2 debug If set to true, each constructive L statement the loader diff --git a/t/backcompat/0.04006/10sqlite_common.t b/t/backcompat/0.04006/10sqlite_common.t new file mode 100644 index 0000000..7899cf6 --- /dev/null +++ b/t/backcompat/0.04006/10sqlite_common.t @@ -0,0 +1,22 @@ +use strict; +use lib qw(t/lib); +use dbixcsl_common_tests; + +eval { require DBD::SQLite }; +my $class = $@ ? 'SQLite2' : 'SQLite'; + +{ + my $tester = dbixcsl_common_tests->new( + vendor => 'SQLite', + auto_inc_pk => 'INTEGER NOT NULL PRIMARY KEY', + dsn => "dbi:$class:dbname=./t/sqlite_test", + user => '', + password => '', + ); + + $tester->run_tests(); +} + +END { + unlink './t/sqlite_test'; +} diff --git a/t/backcompat/0.04006/11mysql_common.t b/t/backcompat/0.04006/11mysql_common.t new file mode 100644 index 0000000..c65c7b1 --- /dev/null +++ b/t/backcompat/0.04006/11mysql_common.t @@ -0,0 +1,29 @@ +use strict; +use lib qw(t/lib); +use dbixcsl_common_tests; + +my $dsn = $ENV{DBICTEST_MYSQL_DSN} || ''; +my $user = $ENV{DBICTEST_MYSQL_USER} || ''; +my $password = $ENV{DBICTEST_MYSQL_PASS} || ''; +my $test_innodb = $ENV{DBICTEST_MYSQL_INNODB} || 0; + +my $skip_rels_msg = 'You need to set the DBICTEST_MYSQL_INNODB environment variable to test relationships'; + +my $tester = dbixcsl_common_tests->new( + vendor => 'Mysql', + auto_inc_pk => 'INTEGER NOT NULL PRIMARY KEY AUTO_INCREMENT', + innodb => $test_innodb ? q{Engine=InnoDB} : 0, + dsn => $dsn, + user => $user, + password => $password, + skip_rels => $test_innodb ? 0 : $skip_rels_msg, + no_inline_rels => 1, + no_implicit_rels => 1, +); + +if( !$dsn || !$user ) { + $tester->skip_tests('You need to set the DBICTEST_MYSQL_DSN, _USER, and _PASS environment variables'); +} +else { + $tester->run_tests(); +} diff --git a/t/backcompat/0.04006/12pg_common.t b/t/backcompat/0.04006/12pg_common.t new file mode 100644 index 0000000..21e83ec --- /dev/null +++ b/t/backcompat/0.04006/12pg_common.t @@ -0,0 +1,22 @@ +use strict; +use lib qw(t/lib); +use dbixcsl_common_tests; + +my $dsn = $ENV{DBICTEST_PG_DSN} || ''; +my $user = $ENV{DBICTEST_PG_USER} || ''; +my $password = $ENV{DBICTEST_PG_PASS} || ''; + +my $tester = dbixcsl_common_tests->new( + vendor => 'Pg', + auto_inc_pk => 'SERIAL NOT NULL PRIMARY KEY', + dsn => $dsn, + user => $user, + password => $password, +); + +if( !$dsn || !$user ) { + $tester->skip_tests('You need to set the DBICTEST_PG_DSN, _USER, and _PASS environment variables'); +} +else { + $tester->run_tests(); +} diff --git a/t/backcompat/0.04006/13db2_common.t b/t/backcompat/0.04006/13db2_common.t new file mode 100644 index 0000000..b52fa68 --- /dev/null +++ b/t/backcompat/0.04006/13db2_common.t @@ -0,0 +1,23 @@ +use strict; +use lib qw(t/lib); +use dbixcsl_common_tests; + +my $dsn = $ENV{DBICTEST_DB2_DSN} || ''; +my $user = $ENV{DBICTEST_DB2_USER} || ''; +my $password = $ENV{DBICTEST_DB2_PASS} || ''; + +my $tester = dbixcsl_common_tests->new( + vendor => 'DB2', + auto_inc_pk => 'INTEGER GENERATED BY DEFAULT AS IDENTITY NOT NULL PRIMARY KEY', + dsn => $dsn, + user => $user, + password => $password, + db_schema => uc $user, +); + +if( !$dsn || !$user ) { + $tester->skip_tests('You need to set the DBICTEST_DB2_DSN, _USER, and _PASS environment variables'); +} +else { + $tester->run_tests(); +} diff --git a/t/backcompat/0.04006/14ora_common.t b/t/backcompat/0.04006/14ora_common.t new file mode 100644 index 0000000..2cd05b5 --- /dev/null +++ b/t/backcompat/0.04006/14ora_common.t @@ -0,0 +1,40 @@ +use strict; +use lib qw(t/lib); +use dbixcsl_common_tests; + +my $dsn = $ENV{DBICTEST_ORA_DSN} || ''; +my $user = $ENV{DBICTEST_ORA_USER} || ''; +my $password = $ENV{DBICTEST_ORA_PASS} || ''; + +my $tester = dbixcsl_common_tests->new( + vendor => 'Oracle', + auto_inc_pk => 'INTEGER NOT NULL PRIMARY KEY', + auto_inc_cb => sub { + my ($table, $col) = @_; + return ( + qq{ CREATE SEQUENCE ${table}_${col}_seq START WITH 1 INCREMENT BY 1}, + qq{ + CREATE OR REPLACE TRIGGER ${table}_${col}_trigger + BEFORE INSERT ON ${table} + FOR EACH ROW + BEGIN + SELECT ${table}_${col}_seq.nextval INTO :NEW.${col} FROM dual; + END; + } + ); + }, + auto_inc_drop_cb => sub { + my ($table, $col) = @_; + return qq{ DROP SEQUENCE ${table}_${col}_seq }; + }, + dsn => $dsn, + user => $user, + password => $password, +); + +if( !$dsn || !$user ) { + $tester->skip_tests('You need to set the DBICTEST_ORA_DSN, _USER, and _PASS environment variables'); +} +else { + $tester->run_tests(); +} diff --git a/t/backcompat/0.04006/20invocations.t b/t/backcompat/0.04006/20invocations.t new file mode 100644 index 0000000..c818842 --- /dev/null +++ b/t/backcompat/0.04006/20invocations.t @@ -0,0 +1,102 @@ +use strict; +use Test::More; +use lib qw(t/lib); +use make_dbictest_db; + +# Takes a $schema as input, runs 4 basic tests +sub test_schema { + my ($testname, $schema) = @_; + + $schema = $schema->clone if !ref $schema; + isa_ok($schema, 'DBIx::Class::Schema', $testname); + + my $foo_rs = $schema->resultset('Bar')->search({ barid => 3})->search_related('fooref'); + isa_ok($foo_rs, 'DBIx::Class::ResultSet', $testname); + + my $foo_first = $foo_rs->first; + like(ref $foo_first, qr/DBICTest::Schema::\d+::Foo/, $testname); + + my $foo_first_text = $foo_first->footext; + is($foo_first_text, 'Foo record associated with the Bar with barid 3'); +} + +my @invocations = ( + 'hardcode' => sub { + package DBICTest::Schema::5; + use base qw/ DBIx::Class::Schema::Loader /; + __PACKAGE__->connection($make_dbictest_db::dsn); + __PACKAGE__; + }, + 'normal' => sub { + package DBICTest::Schema::6; + use base qw/ DBIx::Class::Schema::Loader /; + __PACKAGE__->loader_options(); + __PACKAGE__->connect($make_dbictest_db::dsn); + }, + 'make_schema_at' => sub { + use DBIx::Class::Schema::Loader qw/ make_schema_at /; + make_schema_at( + 'DBICTest::Schema::7', + { really_erase_my_files => 1 }, + [ $make_dbictest_db::dsn ], + ); + DBICTest::Schema::7->clone; + }, + 'embedded_options' => sub { + package DBICTest::Schema::8; + use base qw/ DBIx::Class::Schema::Loader /; + __PACKAGE__->connect( + $make_dbictest_db::dsn, + { loader_options => { really_erase_my_files => 1 } } + ); + }, + 'embedded_options_in_attrs' => sub { + package DBICTest::Schema::9; + use base qw/ DBIx::Class::Schema::Loader /; + __PACKAGE__->connect( + $make_dbictest_db::dsn, + undef, + undef, + { AutoCommit => 1, loader_options => { really_erase_my_files => 1 } } + ); + }, + 'embedded_options_make_schema_at' => sub { + use DBIx::Class::Schema::Loader qw/ make_schema_at /; + make_schema_at( + 'DBICTest::Schema::10', + { }, + [ + $make_dbictest_db::dsn, + { loader_options => { really_erase_my_files => 1 } }, + ], + ); + "DBICTest::Schema::10"; + }, + 'almost_embedded' => sub { + package DBICTest::Schema::11; + use base qw/ DBIx::Class::Schema::Loader /; + __PACKAGE__->loader_options( really_erase_my_files => 1 ); + __PACKAGE__->connect( + $make_dbictest_db::dsn, + undef, undef, { AutoCommit => 1 } + ); + }, + 'make_schema_at_explicit' => sub { + use DBIx::Class::Schema::Loader; + DBIx::Class::Schema::Loader::make_schema_at( + 'DBICTest::Schema::12', + { really_erase_my_files => 1 }, + [ $make_dbictest_db::dsn ], + ); + DBICTest::Schema::12->clone; + } +); + +# 4 tests per k/v pair +plan tests => 2 * @invocations; + +while(@invocations >= 2) { + my $style = shift @invocations; + my $subref = shift @invocations; + test_schema($style, &$subref); +} diff --git a/t/backcompat/0.04006/21misc_fatal.t b/t/backcompat/0.04006/21misc_fatal.t new file mode 100644 index 0000000..a1ce752 --- /dev/null +++ b/t/backcompat/0.04006/21misc_fatal.t @@ -0,0 +1,26 @@ +use strict; +use Test::More; +use lib qw(t/lib); +use make_dbictest_db; + +{ + $INC{'DBIx/Class/Storage/xyzzy.pm'} = 1; + package DBIx::Class::Storage::xyzzy; + use base qw/ DBIx::Class::Storage /; + sub new { bless {}, shift } + sub connect_info { @_ } + + package DBICTest::Schema; + use base qw/ DBIx::Class::Schema::Loader /; + __PACKAGE__->loader_options( really_erase_my_files => 1 ); + __PACKAGE__->storage_type( '::xyzzy' ); +} + +plan tests => 1; + +eval { DBICTest::Schema->connect($make_dbictest_db::dsn) }; +like( + $@, + qr/Could not load storage_type loader "DBIx::Class::Schema::Loader::xyzzy": /, + 'Bad storage type dies correctly' +); diff --git a/t/backcompat/0.04006/22dump.t b/t/backcompat/0.04006/22dump.t new file mode 100644 index 0000000..a10c483 --- /dev/null +++ b/t/backcompat/0.04006/22dump.t @@ -0,0 +1,64 @@ +use strict; +use Test::More; +use lib qw(t/lib); +use File::Path; +use make_dbictest_db; + +my $dump_path = './t/_dump'; + +{ + package DBICTest::Schema::1; + use base qw/ DBIx::Class::Schema::Loader /; + __PACKAGE__->loader_options( + dump_directory => $dump_path, + ); +} + +{ + package DBICTest::Schema::2; + use base qw/ DBIx::Class::Schema::Loader /; + __PACKAGE__->loader_options( + dump_directory => $dump_path, + really_erase_my_files => 1, + ); +} + +plan tests => 5; + +rmtree($dump_path, 1, 1); + +eval { DBICTest::Schema::1->connect($make_dbictest_db::dsn) }; +ok(!$@, 'no death with dump_directory set') or diag "Dump failed: $@"; + +DBICTest::Schema::1->_loader_invoked(undef); + +SKIP: { + my @warnings_regexes = ( + qr|Dumping manual schema|, + qr|Schema dump completed|, + ); + + skip "ActiveState perl produces additional warnings", scalar @warnings_regexes + if ($^O eq 'MSWin32'); + + my @warn_output; + { + local $SIG{__WARN__} = sub { push(@warn_output, @_) }; + DBICTest::Schema::1->connect($make_dbictest_db::dsn); + } + + like(shift @warn_output, $_) foreach (@warnings_regexes); + + rmtree($dump_path, 1, 1); +} + +eval { DBICTest::Schema::2->connect($make_dbictest_db::dsn) }; +ok(!$@, 'no death with dump_directory set (overwrite1)') + or diag "Dump failed: $@"; + +DBICTest::Schema::2->_loader_invoked(undef); +eval { DBICTest::Schema::2->connect($make_dbictest_db::dsn) }; +ok(!$@, 'no death with dump_directory set (overwrite2)') + or diag "Dump failed: $@"; + +END { rmtree($dump_path, 1, 1); } diff --git a/t/backcompat/0.04006/23dumpmore.t b/t/backcompat/0.04006/23dumpmore.t new file mode 100644 index 0000000..6455ad0 --- /dev/null +++ b/t/backcompat/0.04006/23dumpmore.t @@ -0,0 +1,269 @@ +use strict; +use Test::More; +use lib qw(t/lib); +use File::Path; +use make_dbictest_db; +require DBIx::Class::Schema::Loader; + +$^O eq 'MSWin32' + ? plan(skip_all => "ActiveState perl produces additional warnings, and this test uses unix paths") + : plan(tests => 85); + +my $DUMP_PATH = './t/_dump'; + +sub do_dump_test { + my %tdata = @_; + + my $schema_class = $tdata{classname}; + + no strict 'refs'; + @{$schema_class . '::ISA'} = ('DBIx::Class::Schema::Loader'); + $schema_class->loader_options(dump_directory => $DUMP_PATH, %{$tdata{options}}); + + my @warns; + eval { + local $SIG{__WARN__} = sub { push(@warns, @_) }; + $schema_class->connect($make_dbictest_db::dsn); + }; + my $err = $@; + $schema_class->storage->disconnect if !$err && $schema_class->storage; + undef *{$schema_class}; + + is($err, $tdata{error}); + + my $check_warns = $tdata{warnings}; + is(@warns, @$check_warns); + for(my $i = 0; $i <= $#$check_warns; $i++) { + like($warns[$i], $check_warns->[$i]); + } + + my $file_regexes = $tdata{regexes}; + my $file_neg_regexes = $tdata{neg_regexes} || {}; + my $schema_regexes = delete $file_regexes->{schema}; + + my $schema_path = $DUMP_PATH . '/' . $schema_class; + $schema_path =~ s{::}{/}g; + dump_file_like($schema_path . '.pm', @$schema_regexes); + foreach my $src (keys %$file_regexes) { + my $src_file = $schema_path . '/' . $src . '.pm'; + dump_file_like($src_file, @{$file_regexes->{$src}}); + } + foreach my $src (keys %$file_neg_regexes) { + my $src_file = $schema_path . '/' . $src . '.pm'; + dump_file_not_like($src_file, @{$file_neg_regexes->{$src}}); + } +} + +sub dump_file_like { + my $path = shift; + open(my $dumpfh, '<', $path) or die "Failed to open '$path': $!"; + my $contents = do { local $/; <$dumpfh>; }; + close($dumpfh); + like($contents, $_) for @_; +} + +sub dump_file_not_like { + my $path = shift; + open(my $dumpfh, '<', $path) or die "Failed to open '$path': $!"; + my $contents = do { local $/; <$dumpfh>; }; + close($dumpfh); + unlike($contents, $_) for @_; +} + +sub append_to_class { + my ($class, $string) = @_; + $class =~ s{::}{/}g; + $class = $DUMP_PATH . '/' . $class . '.pm'; + open(my $appendfh, '>>', $class) or die "Failed to open '$class' for append: $!"; + print $appendfh $string; + close($appendfh); +} + +rmtree($DUMP_PATH, 1, 1); + +do_dump_test( + classname => 'DBICTest::DumpMore::1', + options => { }, + error => '', + warnings => [ + qr/Dumping manual schema for DBICTest::DumpMore::1 to directory /, + qr/Schema dump completed/, + ], + regexes => { + schema => [ + qr/package DBICTest::DumpMore::1;/, + qr/->load_classes/, + ], + Foo => [ + qr/package DBICTest::DumpMore::1::Foo;/, + qr/->set_primary_key/, + qr/1;\n$/, + ], + Bar => [ + qr/package DBICTest::DumpMore::1::Bar;/, + qr/->set_primary_key/, + qr/1;\n$/, + ], + }, +); + +append_to_class('DBICTest::DumpMore::1::Foo',q{# XXX This is my custom content XXX}); + +do_dump_test( + classname => 'DBICTest::DumpMore::1', + options => { }, + error => '', + warnings => [ + qr/Dumping manual schema for DBICTest::DumpMore::1 to directory /, + qr/Schema dump completed/, + ], + regexes => { + schema => [ + qr/package DBICTest::DumpMore::1;/, + qr/->load_classes/, + ], + Foo => [ + qr/package DBICTest::DumpMore::1::Foo;/, + qr/->set_primary_key/, + qr/1;\n# XXX This is my custom content XXX/, + ], + Bar => [ + qr/package DBICTest::DumpMore::1::Bar;/, + qr/->set_primary_key/, + qr/1;\n$/, + ], + }, +); + +do_dump_test( + classname => 'DBICTest::DumpMore::1', + options => { really_erase_my_files => 1 }, + error => '', + warnings => [ + qr/Dumping manual schema for DBICTest::DumpMore::1 to directory /, + qr/Deleting existing file /, + qr/Deleting existing file /, + qr/Deleting existing file /, + qr/Schema dump completed/, + ], + regexes => { + schema => [ + qr/package DBICTest::DumpMore::1;/, + qr/->load_classes/, + ], + Foo => [ + qr/package DBICTest::DumpMore::1::Foo;/, + qr/->set_primary_key/, + qr/1;\n$/, + ], + Bar => [ + qr/package DBICTest::DumpMore::1::Bar;/, + qr/->set_primary_key/, + qr/1;\n$/, + ], + }, + neg_regexes => { + Foo => [ + qr/# XXX This is my custom content XXX/, + ], + }, +); + +do_dump_test( + classname => 'DBICTest::DumpMore::1', + options => { use_namespaces => 1 }, + error => '', + warnings => [ + qr/Dumping manual schema for DBICTest::DumpMore::1 to directory /, + qr/Schema dump completed/, + ], + regexes => { + schema => [ + qr/package DBICTest::DumpMore::1;/, + qr/->load_namespaces/, + ], + 'Result/Foo' => [ + qr/package DBICTest::DumpMore::1::Result::Foo;/, + qr/->set_primary_key/, + qr/1;\n$/, + ], + 'Result/Bar' => [ + qr/package DBICTest::DumpMore::1::Result::Bar;/, + qr/->set_primary_key/, + qr/1;\n$/, + ], + }, +); + +do_dump_test( + classname => 'DBICTest::DumpMore::1', + options => { use_namespaces => 1, + result_namespace => 'Res', + resultset_namespace => 'RSet', + default_resultset_class => 'RSetBase', + }, + error => '', + warnings => [ + qr/Dumping manual schema for DBICTest::DumpMore::1 to directory /, + qr/Schema dump completed/, + ], + regexes => { + schema => [ + qr/package DBICTest::DumpMore::1;/, + qr/->load_namespaces/, + qr/result_namespace => 'Res'/, + qr/resultset_namespace => 'RSet'/, + qr/default_resultset_class => 'RSetBase'/, + ], + 'Res/Foo' => [ + qr/package DBICTest::DumpMore::1::Res::Foo;/, + qr/->set_primary_key/, + qr/1;\n$/, + ], + 'Res/Bar' => [ + qr/package DBICTest::DumpMore::1::Res::Bar;/, + qr/->set_primary_key/, + qr/1;\n$/, + ], + }, +); + +do_dump_test( + classname => 'DBICTest::DumpMore::1', + options => { use_namespaces => 1, + result_namespace => '+DBICTest::DumpMore::1::Res', + resultset_namespace => 'RSet', + default_resultset_class => 'RSetBase', + result_base_class => 'My::ResultBaseClass', + schema_base_class => 'My::SchemaBaseClass', + }, + error => '', + warnings => [ + qr/Dumping manual schema for DBICTest::DumpMore::1 to directory /, + qr/Schema dump completed/, + ], + regexes => { + schema => [ + qr/package DBICTest::DumpMore::1;/, + qr/->load_namespaces/, + qr/result_namespace => '\+DBICTest::DumpMore::1::Res'/, + qr/resultset_namespace => 'RSet'/, + qr/default_resultset_class => 'RSetBase'/, + qr/use base 'My::SchemaBaseClass'/, + ], + 'Res/Foo' => [ + qr/package DBICTest::DumpMore::1::Res::Foo;/, + qr/use base 'My::ResultBaseClass'/, + qr/->set_primary_key/, + qr/1;\n$/, + ], + 'Res/Bar' => [ + qr/package DBICTest::DumpMore::1::Res::Bar;/, + qr/use base 'My::ResultBaseClass'/, + qr/->set_primary_key/, + qr/1;\n$/, + ], + }, +); + +END { rmtree($DUMP_PATH, 1, 1); } diff --git a/t/backcompat/0.04006/lib/DBIXCSL_Test/Schema/LoaderTest1.pm b/t/backcompat/0.04006/lib/DBIXCSL_Test/Schema/LoaderTest1.pm new file mode 100644 index 0000000..b4c3c65 --- /dev/null +++ b/t/backcompat/0.04006/lib/DBIXCSL_Test/Schema/LoaderTest1.pm @@ -0,0 +1,7 @@ +package DBIXCSL_Test::Schema::LoaderTest1; + +sub loader_test1_classmeth { 'all is well' } + +sub loader_test1_rsmeth : ResultSet { 'all is still well' } + +1; diff --git a/t/backcompat/0.04006/lib/DBIx/Class/TestComponent.pm b/t/backcompat/0.04006/lib/DBIx/Class/TestComponent.pm new file mode 100644 index 0000000..48677c7 --- /dev/null +++ b/t/backcompat/0.04006/lib/DBIx/Class/TestComponent.pm @@ -0,0 +1,5 @@ +package DBIx::Class::TestComponent; + +sub dbix_class_testcomponent { 'dbix_class_testcomponent works' } + +1; diff --git a/t/backcompat/0.04006/lib/DBIx/Class/TestRSComponent.pm b/t/backcompat/0.04006/lib/DBIx/Class/TestRSComponent.pm new file mode 100644 index 0000000..e6808ad --- /dev/null +++ b/t/backcompat/0.04006/lib/DBIx/Class/TestRSComponent.pm @@ -0,0 +1,6 @@ +package DBIx::Class::TestRSComponent; +use base qw/DBIx::Class::ResultSet/; + +sub dbix_class_testrscomponent { 'dbix_class_testrscomponent works' } + +1; diff --git a/t/backcompat/0.04006/lib/TestAdditional.pm b/t/backcompat/0.04006/lib/TestAdditional.pm new file mode 100644 index 0000000..d47fddb --- /dev/null +++ b/t/backcompat/0.04006/lib/TestAdditional.pm @@ -0,0 +1,5 @@ +package TestAdditional; + +sub test_additional { return "test_additional"; } + +1; diff --git a/t/backcompat/0.04006/lib/TestAdditionalBase.pm b/t/backcompat/0.04006/lib/TestAdditionalBase.pm new file mode 100644 index 0000000..85159c0 --- /dev/null +++ b/t/backcompat/0.04006/lib/TestAdditionalBase.pm @@ -0,0 +1,7 @@ +package TestAdditionalBase; + +sub test_additional_base { return "test_additional_base"; } +sub test_additional_base_override { return "test_additional_base_override"; } +sub test_additional_base_additional { return TestAdditional->test_additional; } + +1; diff --git a/t/backcompat/0.04006/lib/TestLeftBase.pm b/t/backcompat/0.04006/lib/TestLeftBase.pm new file mode 100644 index 0000000..c836957 --- /dev/null +++ b/t/backcompat/0.04006/lib/TestLeftBase.pm @@ -0,0 +1,5 @@ +package TestLeftBase; + +sub test_additional_base_override { return "test_left_base_override"; } + +1; diff --git a/t/backcompat/0.04006/lib/dbixcsl_common_tests.pm b/t/backcompat/0.04006/lib/dbixcsl_common_tests.pm new file mode 100644 index 0000000..ada0338 --- /dev/null +++ b/t/backcompat/0.04006/lib/dbixcsl_common_tests.pm @@ -0,0 +1,966 @@ +package dbixcsl_common_tests; + +use strict; +use warnings; + +use Test::More; +use DBIx::Class::Schema::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} ||= ''; + + $self->{verbose} = $ENV{TEST_VERBOSE} || 0; + + return bless $self => $class; +} + +sub skip_tests { + my ($self, $why) = @_; + + plan skip_all => $why; +} + +sub _monikerize { + my $name = shift; + return 'LoaderTest2X' if $name =~ /^loader_test2$/i; + return undef; +} + +sub run_tests { + my $self = shift; + + plan tests => 88; + + $self->create(); + + my $schema_class = 'DBIXCSL_Test::Schema'; + + my $debug = ($self->{verbose} > 1) ? 1 : 0; + + my @connect_info = ( $self->{dsn}, $self->{user}, $self->{password} ); + my %loader_opts = ( + constraint => qr/^(?:\S+\.)?loader_test[0-9]+$/i, + relationships => 1, + additional_classes => 'TestAdditional', + additional_base_classes => 'TestAdditionalBase', + left_base_classes => [ qw/TestLeftBase/ ], + components => [ qw/TestComponent/ ], + inflect_plural => { loader_test4 => 'loader_test4zes' }, + inflect_singular => { fkid => 'fkid_singular' }, + moniker_map => \&_monikerize, + debug => $debug, + ); + + $loader_opts{db_schema} = $self->{db_schema} if $self->{db_schema}; + eval { require Class::Inspector }; + if($@) { + $self->{_no_rs_components} = 1; + } + else { + $loader_opts{resultset_components} = [ qw/TestRSComponent/ ]; + } + + { + my @loader_warnings; + local $SIG{__WARN__} = sub { push(@loader_warnings, $_[0]); }; + eval qq{ + package $schema_class; + use base qw/DBIx::Class::Schema::Loader/; + + __PACKAGE__->loader_options(\%loader_opts); + __PACKAGE__->connection(\@connect_info); + }; + ok(!$@, "Loader initialization") or diag $@; + + my $warn_count = 0; + $warn_count++ if grep /ResultSetManager/, @loader_warnings; + + if($self->{skip_rels}) { + is(scalar(@loader_warnings), $warn_count) + or diag "Did not get the expected 0 warnings. Warnings are: " + . join('',@loader_warnings); + ok(1); + } + else { + $warn_count++; + is(scalar(@loader_warnings), $warn_count) + or diag "Did not get the expected 1 warning. Warnings are: " + . join('',@loader_warnings); + is(grep(/loader_test9 has no primary key/, @loader_warnings), 1); + } + } + + my $conn = $schema_class->clone; + my $monikers = {}; + my $classes = {}; + foreach my $source_name ($schema_class->sources) { + my $table_name = $schema_class->source($source_name)->from; + $monikers->{$table_name} = $source_name; + $classes->{$table_name} = $schema_class . q{::} . $source_name; + } + + my $moniker1 = $monikers->{loader_test1}; + my $class1 = $classes->{loader_test1}; + my $rsobj1 = $conn->resultset($moniker1); + + my $moniker2 = $monikers->{loader_test2}; + my $class2 = $classes->{loader_test2}; + my $rsobj2 = $conn->resultset($moniker2); + + my $moniker23 = $monikers->{LOADER_TEST23}; + my $class23 = $classes->{LOADER_TEST23}; + my $rsobj23 = $conn->resultset($moniker1); + + my $moniker24 = $monikers->{LoAdEr_test24}; + my $class24 = $classes->{LoAdEr_test24}; + my $rsobj24 = $conn->resultset($moniker2); + + isa_ok( $rsobj1, "DBIx::Class::ResultSet" ); + isa_ok( $rsobj2, "DBIx::Class::ResultSet" ); + isa_ok( $rsobj23, "DBIx::Class::ResultSet" ); + isa_ok( $rsobj24, "DBIx::Class::ResultSet" ); + + my @columns_lt2 = $class2->columns; + is($columns_lt2[0], 'id', "Column Ordering 0"); + is($columns_lt2[1], 'dat', "Column Ordering 1"); + is($columns_lt2[2], 'dat2', "Column Ordering 2"); + + my %uniq1 = $class1->unique_constraints; + my $uniq1_test = 0; + foreach my $ucname (keys %uniq1) { + my $cols_arrayref = $uniq1{$ucname}; + if(@$cols_arrayref == 1 && $cols_arrayref->[0] eq 'dat') { + $uniq1_test = 1; + last; + } + } + ok($uniq1_test) or diag "Unique constraints not working"; + + my %uniq2 = $class2->unique_constraints; + my $uniq2_test = 0; + foreach my $ucname (keys %uniq2) { + my $cols_arrayref = $uniq2{$ucname}; + if(@$cols_arrayref == 2 + && $cols_arrayref->[0] eq 'dat2' + && $cols_arrayref->[1] eq 'dat') { + $uniq2_test = 2; + last; + } + } + ok($uniq2_test) or diag "Multi-col unique constraints not working"; + + is($moniker2, 'LoaderTest2X', "moniker_map testing"); + + { + my ($skip_tab, $skip_tabo, $skip_taba, $skip_cmeth, + $skip_rsmeth, $skip_tcomp, $skip_trscomp); + + can_ok( $class1, 'test_additional_base' ) or $skip_tab = 1; + can_ok( $class1, 'test_additional_base_override' ) or $skip_tabo = 1; + can_ok( $class1, 'test_additional_base_additional' ) or $skip_taba = 1; + can_ok( $class1, 'dbix_class_testcomponent' ) or $skip_tcomp = 1; + can_ok( $class1, 'loader_test1_classmeth' ) or $skip_cmeth = 1; + + TODO: { + local $TODO = "Not yet supported by ResultSetManger code"; + can_ok( $rsobj1, 'loader_test1_rsmeth' ) or $skip_rsmeth = 1; + } + + SKIP: { + skip "Pre-requisite test failed", 1 if $skip_tab; + is( $class1->test_additional_base, "test_additional_base", + "Additional Base method" ); + } + + SKIP: { + skip "Pre-requisite test failed", 1 if $skip_tabo; + is( $class1->test_additional_base_override, + "test_left_base_override", + "Left Base overrides Additional Base method" ); + } + + SKIP: { + skip "Pre-requisite test failed", 1 if $skip_taba; + is( $class1->test_additional_base_additional, "test_additional", + "Additional Base can use Additional package method" ); + } + + SKIP: { + skip "Pre-requisite test failed", 1 if $skip_tcomp; + is( $class1->dbix_class_testcomponent, + 'dbix_class_testcomponent works' ); + } + + SKIP: { + skip "These two tests need Class::Inspector installed", 2 + if $self->{_no_rs_components}; + can_ok($rsobj1, 'dbix_class_testrscomponent') or $skip_trscomp = 1; + SKIP: { + skip "Pre-requisite test failed", 1 if $skip_trscomp; + is( $rsobj1->dbix_class_testrscomponent, + 'dbix_class_testrscomponent works' ); + } + } + + SKIP: { + skip "Pre-requisite test failed", 1 if $skip_cmeth; + is( $class1->loader_test1_classmeth, 'all is well' ); + } + + # XXX put this back in when the TODO above works... + #SKIP: { + # skip "Pre-requisite test failed", 1 if $skip_rsmeth; + # is( $rsobj1->loader_test1_rsmeth, 'all is still well' ); + #} + } + + + my $obj = $rsobj1->find(1); + is( $obj->id, 1 ); + is( $obj->dat, "foo" ); + is( $rsobj2->count, 4 ); + my $saved_id; + eval { + my $new_obj1 = $rsobj1->create({ dat => 'newthing' }); + $saved_id = $new_obj1->id; + }; + ok(!$@) or diag "Died during create new record using a PK::Auto key: $@"; + ok($saved_id) or diag "Failed to get PK::Auto-generated id"; + + my $new_obj1 = $rsobj1->search({ dat => 'newthing' })->first; + ok($new_obj1) or diag "Cannot find newly inserted PK::Auto record"; + is($new_obj1->id, $saved_id); + + my ($obj2) = $rsobj2->search({ dat => 'bbb' })->first; + is( $obj2->id, 2 ); + + SKIP: { + skip $self->{skip_rels}, 50 if $self->{skip_rels}; + + my $moniker3 = $monikers->{loader_test3}; + my $class3 = $classes->{loader_test3}; + my $rsobj3 = $conn->resultset($moniker3); + + my $moniker4 = $monikers->{loader_test4}; + my $class4 = $classes->{loader_test4}; + my $rsobj4 = $conn->resultset($moniker4); + + my $moniker5 = $monikers->{loader_test5}; + my $class5 = $classes->{loader_test5}; + my $rsobj5 = $conn->resultset($moniker5); + + my $moniker6 = $monikers->{loader_test6}; + my $class6 = $classes->{loader_test6}; + my $rsobj6 = $conn->resultset($moniker6); + + my $moniker7 = $monikers->{loader_test7}; + my $class7 = $classes->{loader_test7}; + my $rsobj7 = $conn->resultset($moniker7); + + my $moniker8 = $monikers->{loader_test8}; + my $class8 = $classes->{loader_test8}; + my $rsobj8 = $conn->resultset($moniker8); + + my $moniker9 = $monikers->{loader_test9}; + my $class9 = $classes->{loader_test9}; + my $rsobj9 = $conn->resultset($moniker9); + + my $moniker16 = $monikers->{loader_test16}; + my $class16 = $classes->{loader_test16}; + my $rsobj16 = $conn->resultset($moniker16); + + my $moniker17 = $monikers->{loader_test17}; + my $class17 = $classes->{loader_test17}; + my $rsobj17 = $conn->resultset($moniker17); + + my $moniker18 = $monikers->{loader_test18}; + my $class18 = $classes->{loader_test18}; + my $rsobj18 = $conn->resultset($moniker18); + + my $moniker19 = $monikers->{loader_test19}; + my $class19 = $classes->{loader_test19}; + my $rsobj19 = $conn->resultset($moniker19); + + my $moniker20 = $monikers->{loader_test20}; + my $class20 = $classes->{loader_test20}; + my $rsobj20 = $conn->resultset($moniker20); + + my $moniker21 = $monikers->{loader_test21}; + my $class21 = $classes->{loader_test21}; + my $rsobj21 = $conn->resultset($moniker21); + + my $moniker22 = $monikers->{loader_test22}; + my $class22 = $classes->{loader_test22}; + my $rsobj22 = $conn->resultset($moniker22); + + my $moniker25 = $monikers->{loader_test25}; + my $class25 = $classes->{loader_test25}; + my $rsobj25 = $conn->resultset($moniker25); + + my $moniker26 = $monikers->{loader_test26}; + my $class26 = $classes->{loader_test26}; + my $rsobj26 = $conn->resultset($moniker26); + + isa_ok( $rsobj3, "DBIx::Class::ResultSet" ); + isa_ok( $rsobj4, "DBIx::Class::ResultSet" ); + isa_ok( $rsobj5, "DBIx::Class::ResultSet" ); + isa_ok( $rsobj6, "DBIx::Class::ResultSet" ); + isa_ok( $rsobj7, "DBIx::Class::ResultSet" ); + isa_ok( $rsobj8, "DBIx::Class::ResultSet" ); + isa_ok( $rsobj9, "DBIx::Class::ResultSet" ); + isa_ok( $rsobj16, "DBIx::Class::ResultSet" ); + isa_ok( $rsobj17, "DBIx::Class::ResultSet" ); + isa_ok( $rsobj18, "DBIx::Class::ResultSet" ); + isa_ok( $rsobj19, "DBIx::Class::ResultSet" ); + isa_ok( $rsobj20, "DBIx::Class::ResultSet" ); + isa_ok( $rsobj21, "DBIx::Class::ResultSet" ); + isa_ok( $rsobj22, "DBIx::Class::ResultSet" ); + isa_ok( $rsobj25, "DBIx::Class::ResultSet" ); + isa_ok( $rsobj26, "DBIx::Class::ResultSet" ); + + # basic rel test + my $obj4 = $rsobj4->find(123); + isa_ok( $obj4->fkid_singular, $class3); + + my $obj3 = $rsobj3->find(1); + my $rs_rel4 = $obj3->search_related('loader_test4zes'); + isa_ok( $rs_rel4->first, $class4); + + # find on multi-col pk + my $obj5 = $rsobj5->find({id1 => 1, id2 => 1}); + is( $obj5->id2, 1 ); + + # mulit-col fk def + my $obj6 = $rsobj6->find(1); + isa_ok( $obj6->loader_test2, $class2); + isa_ok( $obj6->loader_test5, $class5); + + # fk that references a non-pk key (UNIQUE) + my $obj8 = $rsobj8->find(1); + isa_ok( $obj8->loader_test7, $class7); + + # test double-fk 17 ->-> 16 + my $obj17 = $rsobj17->find(33); + + my $rs_rel16_one = $obj17->loader16_one; + isa_ok($rs_rel16_one, $class16); + is($rs_rel16_one->dat, 'y16'); + + my $rs_rel16_two = $obj17->loader16_two; + isa_ok($rs_rel16_two, $class16); + is($rs_rel16_two->dat, 'z16'); + + my $obj16 = $rsobj16->find(2); + my $rs_rel17 = $obj16->search_related('loader_test17_loader16_ones'); + isa_ok($rs_rel17->first, $class17); + is($rs_rel17->first->id, 3); + + # XXX test m:m 18 <- 20 -> 19 + + # XXX test double-fk m:m 21 <- 22 -> 21 + + # test double multi-col fk 26 -> 25 + my $obj26 = $rsobj26->find(33); + + my $rs_rel25_one = $obj26->loader_test25_id_rel1; + isa_ok($rs_rel25_one, $class25); + is($rs_rel25_one->dat, 'x25'); + + my $rs_rel25_two = $obj26->loader_test25_id_rel2; + isa_ok($rs_rel25_two, $class25); + is($rs_rel25_two->dat, 'y25'); + + my $obj25 = $rsobj25->find(3,42); + my $rs_rel26 = $obj25->search_related('loader_test26_id_rel1s'); + isa_ok($rs_rel26->first, $class26); + is($rs_rel26->first->id, 3); + + # from Chisel's tests... + SKIP: { + if($self->{vendor} =~ /sqlite/i) { + skip 'SQLite cannot do the advanced tests', 8; + } + + my $moniker10 = $monikers->{loader_test10}; + my $class10 = $classes->{loader_test10}; + my $rsobj10 = $conn->resultset($moniker10); + + my $moniker11 = $monikers->{loader_test11}; + my $class11 = $classes->{loader_test11}; + my $rsobj11 = $conn->resultset($moniker11); + + isa_ok( $rsobj10, "DBIx::Class::ResultSet" ); + isa_ok( $rsobj11, "DBIx::Class::ResultSet" ); + + my $obj10 = $rsobj10->create({ subject => 'xyzzy' }); + + $obj10->update(); + ok( defined $obj10, '$obj10 is defined' ); + + my $obj11 = $rsobj11->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 = $rsobj10->search({ subject => 'xyzzy' }); + is( $results->count(), 1, + 'One $rsobj10 returned from search' ); + + my $obj10_3 = $results->first(); + isa_ok( $obj10_3, $class10 ); + is( $obj10_3->loader_test11()->id(), $obj11->id(), + 'found same $rsobj11 object we expected' ); + } + } + + SKIP: { + skip 'This vendor cannot do inline relationship definitions', 5 + if $self->{no_inline_rels}; + + my $moniker12 = $monikers->{loader_test12}; + my $class12 = $classes->{loader_test12}; + my $rsobj12 = $conn->resultset($moniker12); + + my $moniker13 = $monikers->{loader_test13}; + my $class13 = $classes->{loader_test13}; + my $rsobj13 = $conn->resultset($moniker13); + + isa_ok( $rsobj12, "DBIx::Class::ResultSet" ); + isa_ok( $rsobj13, "DBIx::Class::ResultSet" ); + + my $obj13 = $rsobj13->find(1); + isa_ok( $obj13->id, $class12 ); + isa_ok( $obj13->loader_test12, $class12); + isa_ok( $obj13->dat, $class12); + } + + SKIP: { + skip 'This vendor cannot do out-of-line implicit rel defs', 3 + if $self->{no_implicit_rels}; + my $moniker14 = $monikers->{loader_test14}; + my $class14 = $classes->{loader_test14}; + my $rsobj14 = $conn->resultset($moniker14); + + my $moniker15 = $monikers->{loader_test15}; + my $class15 = $classes->{loader_test15}; + my $rsobj15 = $conn->resultset($moniker15); + + isa_ok( $rsobj14, "DBIx::Class::ResultSet" ); + isa_ok( $rsobj15, "DBIx::Class::ResultSet" ); + + my $obj15 = $rsobj15->find(1); + isa_ok( $obj15->loader_test14, $class14 ); + } + } + + # rescan test + SKIP: { + skip $self->{skip_rels}, 4 if $self->{skip_rels}; + + my @statements_rescan = ( + qq{ + CREATE TABLE loader_test30 ( + id INTEGER NOT NULL PRIMARY KEY, + loader_test2 INTEGER NOT NULL, + FOREIGN KEY (loader_test2) REFERENCES loader_test2 (id) + ) $self->{innodb} + }, + q{ INSERT INTO loader_test30 (id,loader_test2) VALUES(123, 1) }, + q{ INSERT INTO loader_test30 (id,loader_test2) VALUES(321, 2) }, + ); + + my $dbh = $self->dbconnect(1); + $dbh->do($_) for @statements_rescan; + $dbh->disconnect; + + my @new = $conn->rescan; + is(scalar(@new), 1); + is($new[0], 'LoaderTest30'); + + my $rsobj30 = $conn->resultset('LoaderTest30'); + isa_ok($rsobj30, 'DBIx::Class::ResultSet'); + my $obj30 = $rsobj30->find(123); + isa_ok( $obj30->loader_test2, $class2); + } +} + +sub dbconnect { + my ($self, $complain) = @_; + + my $dbh = DBI->connect( + $self->{dsn}, $self->{user}, + $self->{password}, + { + RaiseError => $complain, + PrintError => $complain, + AutoCommit => 1, + } + ); + + die "Failed to connect to database: $DBI::errstr" if !$dbh; + + return $dbh; +} + +sub create { + my $self = shift; + + $self->{_created} = 1; + + my $make_auto_inc = $self->{auto_inc_cb} || sub {}; + my @statements = ( + qq{ + CREATE TABLE loader_test1 ( + id $self->{auto_inc_pk}, + dat VARCHAR(32) NOT NULL UNIQUE + ) $self->{innodb} + }, + $make_auto_inc->(qw/loader_test1 id/), + + 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) NOT NULL, + dat2 VARCHAR(32) NOT NULL, + UNIQUE (dat2, dat) + ) $self->{innodb} + }, + $make_auto_inc->(qw/loader_test2 id/), + + q{ INSERT INTO loader_test2 (dat, dat2) VALUES('aaa', 'zzz') }, + q{ INSERT INTO loader_test2 (dat, dat2) VALUES('bbb', 'yyy') }, + q{ INSERT INTO loader_test2 (dat, dat2) VALUES('ccc', 'xxx') }, + q{ INSERT INTO loader_test2 (dat, dat2) VALUES('ddd', 'www') }, + + qq{ + CREATE TABLE LOADER_TEST23 ( + ID INTEGER NOT NULL PRIMARY KEY, + DAT VARCHAR(32) NOT NULL UNIQUE + ) $self->{innodb} + }, + + qq{ + CREATE TABLE LoAdEr_test24 ( + iD INTEGER NOT NULL PRIMARY KEY, + DaT VARCHAR(32) NOT NULL UNIQUE + ) $self->{innodb} + }, + ); + + 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 NOT NULL, + iD2 INTEGER NOT NULL, + dat VARCHAR(8), + PRIMARY KEY (id1,id2) + ) $self->{innodb} + }, + + q{ INSERT INTO loader_test5 (id1,id2,dat) VALUES (1,1,'aaa') }, + + qq{ + CREATE TABLE loader_test6 ( + id INTEGER NOT NULL PRIMARY KEY, + Id2 INTEGER, + loader_test2 INTEGER, + dat VARCHAR(8), + FOREIGN KEY (loader_test2) REFERENCES loader_test2 (id), + FOREIGN KEY(id,Id2) REFERENCES loader_test5 (id1,iD2) + ) $self->{innodb} + }, + + (q{ INSERT INTO loader_test6 (id, id2,loader_test2,dat) } . + q{ VALUES (1, 1,1,'aaa') }), + + qq{ + CREATE TABLE loader_test7 ( + id INTEGER NOT NULL PRIMARY KEY, + id2 VARCHAR(8) NOT NULL UNIQUE, + dat VARCHAR(8) + ) $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 VARCHAR(8), + 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 VARCHAR(8) NOT NULL + ) $self->{innodb} + }, + + qq{ + CREATE TABLE loader_test16 ( + id INTEGER NOT NULL PRIMARY KEY, + dat VARCHAR(8) + ) $self->{innodb} + }, + + qq{ INSERT INTO loader_test16 (id,dat) VALUES (2,'x16') }, + qq{ INSERT INTO loader_test16 (id,dat) VALUES (4,'y16') }, + qq{ INSERT INTO loader_test16 (id,dat) VALUES (6,'z16') }, + + qq{ + CREATE TABLE loader_test17 ( + id INTEGER NOT NULL PRIMARY KEY, + loader16_one INTEGER, + loader16_two INTEGER, + FOREIGN KEY (loader16_one) REFERENCES loader_test16 (id), + FOREIGN KEY (loader16_two) REFERENCES loader_test16 (id) + ) $self->{innodb} + }, + + qq{ INSERT INTO loader_test17 (id, loader16_one, loader16_two) VALUES (3, 2, 4) }, + qq{ INSERT INTO loader_test17 (id, loader16_one, loader16_two) VALUES (33, 4, 6) }, + + qq{ + CREATE TABLE loader_test18 ( + id INTEGER NOT NULL PRIMARY KEY, + dat VARCHAR(8) + ) $self->{innodb} + }, + + qq{ INSERT INTO loader_test18 (id,dat) VALUES (1,'x18') }, + qq{ INSERT INTO loader_test18 (id,dat) VALUES (2,'y18') }, + qq{ INSERT INTO loader_test18 (id,dat) VALUES (3,'z18') }, + + qq{ + CREATE TABLE loader_test19 ( + id INTEGER NOT NULL PRIMARY KEY, + dat VARCHAR(8) + ) $self->{innodb} + }, + + qq{ INSERT INTO loader_test19 (id,dat) VALUES (4,'x19') }, + qq{ INSERT INTO loader_test19 (id,dat) VALUES (5,'y19') }, + qq{ INSERT INTO loader_test19 (id,dat) VALUES (6,'z19') }, + + qq{ + CREATE TABLE loader_test20 ( + parent INTEGER NOT NULL, + child INTEGER NOT NULL, + PRIMARY KEY (parent, child), + FOREIGN KEY (parent) REFERENCES loader_test18 (id), + FOREIGN KEY (child) REFERENCES loader_test19 (id) + ) $self->{innodb} + }, + + q{ INSERT INTO loader_test20 (parent, child) VALUES (1,4) }, + q{ INSERT INTO loader_test20 (parent, child) VALUES (2,5) }, + q{ INSERT INTO loader_test20 (parent, child) VALUES (3,6) }, + + qq{ + CREATE TABLE loader_test21 ( + id INTEGER NOT NULL PRIMARY KEY, + dat VARCHAR(8) + ) $self->{innodb} + }, + + q{ INSERT INTO loader_test21 (id,dat) VALUES (7,'a21')}, + q{ INSERT INTO loader_test21 (id,dat) VALUES (11,'b21')}, + q{ INSERT INTO loader_test21 (id,dat) VALUES (13,'c21')}, + q{ INSERT INTO loader_test21 (id,dat) VALUES (17,'d21')}, + + qq{ + CREATE TABLE loader_test22 ( + parent INTEGER NOT NULL, + child INTEGER NOT NULL, + PRIMARY KEY (parent, child), + FOREIGN KEY (parent) REFERENCES loader_test21 (id), + FOREIGN KEY (child) REFERENCES loader_test21 (id) + ) $self->{innodb} + }, + + q{ INSERT INTO loader_test22 (parent, child) VALUES (7,11)}, + q{ INSERT INTO loader_test22 (parent, child) VALUES (11,13)}, + q{ INSERT INTO loader_test22 (parent, child) VALUES (13,17)}, + + qq{ + CREATE TABLE loader_test25 ( + id1 INTEGER NOT NULL, + id2 INTEGER NOT NULL, + dat VARCHAR(8), + PRIMARY KEY (id1,id2) + ) $self->{innodb} + }, + + q{ INSERT INTO loader_test25 (id1,id2,dat) VALUES (33,5,'x25') }, + q{ INSERT INTO loader_test25 (id1,id2,dat) VALUES (33,7,'y25') }, + q{ INSERT INTO loader_test25 (id1,id2,dat) VALUES (3,42,'z25') }, + + qq{ + CREATE TABLE loader_test26 ( + id INTEGER NOT NULL PRIMARY KEY, + rel1 INTEGER NOT NULL, + rel2 INTEGER NOT NULL, + FOREIGN KEY (id, rel1) REFERENCES loader_test25 (id1, id2), + FOREIGN KEY (id, rel2) REFERENCES loader_test25 (id1, id2) + ) $self->{innodb} + }, + + q{ INSERT INTO loader_test26 (id,rel1,rel2) VALUES (33,5,7) }, + q{ INSERT INTO loader_test26 (id,rel1,rel2) VALUES (3,42,42) }, + ); + + my @statements_advanced = ( + qq{ + CREATE TABLE loader_test10 ( + id10 $self->{auto_inc_pk}, + subject VARCHAR(8), + loader_test11 INTEGER + ) $self->{innodb} + }, + $make_auto_inc->(qw/loader_test10 id10/), + + qq{ + CREATE TABLE loader_test11 ( + id11 $self->{auto_inc_pk}, + message VARCHAR(8) DEFAULT 'foo', + loader_test10 INTEGER, + FOREIGN KEY (loader_test10) REFERENCES loader_test10 (id10) + ) $self->{innodb} + }, + $make_auto_inc->(qw/loader_test11 id11/), + + (q{ ALTER TABLE loader_test10 ADD CONSTRAINT } . + q{ loader_test11_fk FOREIGN KEY (loader_test11) } . + q{ REFERENCES loader_test11 (id11) }), + ); + + my @statements_inline_rels = ( + qq{ + CREATE TABLE loader_test12 ( + id INTEGER NOT NULL PRIMARY KEY, + id2 VARCHAR(8) NOT NULL UNIQUE, + dat VARCHAR(8) NOT NULL UNIQUE + ) $self->{innodb} + }, + + q{ INSERT INTO loader_test12 (id,id2,dat) VALUES (1,'aaa','bbb') }, + + qq{ + CREATE TABLE loader_test13 ( + id INTEGER NOT NULL PRIMARY KEY REFERENCES loader_test12, + loader_test12 VARCHAR(8) NOT NULL REFERENCES loader_test12 (id2), + dat VARCHAR(8) REFERENCES loader_test12 (dat) + ) $self->{innodb} + }, + + (q{ INSERT INTO loader_test13 (id,loader_test12,dat) } . + q{ VALUES (1,'aaa','bbb') }), + ); + + + my @statements_implicit_rels = ( + qq{ + CREATE TABLE loader_test14 ( + id INTEGER NOT NULL PRIMARY KEY, + dat VARCHAR(8) + ) $self->{innodb} + }, + + q{ INSERT INTO loader_test14 (id,dat) VALUES (123,'aaa') }, + + qq{ + CREATE TABLE loader_test15 ( + id INTEGER NOT NULL PRIMARY KEY, + loader_test14 INTEGER NOT NULL, + FOREIGN KEY (loader_test14) REFERENCES loader_test14 + ) $self->{innodb} + }, + + q{ INSERT INTO loader_test15 (id,loader_test14) VALUES (1,123) }, + ); + + $self->drop_tables; + + my $dbh = $self->dbconnect(1); + + # Silence annoying but harmless postgres "NOTICE: CREATE TABLE..." + local $SIG{__WARN__} = sub { + my $msg = shift; + print STDERR $msg unless $msg =~ m{^NOTICE:\s+CREATE TABLE}; + }; + + $dbh->do($_) for (@statements); + unless($self->{skip_rels}) { + # hack for now, since DB2 doesn't like inline comments, and we need + # to test one for mysql, which works on everyone else... + # this all needs to be refactored anyways. + $dbh->do($_) for (@statements_reltests); + unless($self->{vendor} =~ /sqlite/i) { + $dbh->do($_) for (@statements_advanced); + } + unless($self->{no_inline_rels}) { + $dbh->do($_) for (@statements_inline_rels); + } + unless($self->{no_implicit_rels}) { + $dbh->do($_) for (@statements_implicit_rels); + } + } + $dbh->disconnect(); +} + +sub drop_tables { + my $self = shift; + + my @tables = qw/ + loader_test1 + loader_test2 + LOADER_TEST23 + LoAdEr_test24 + /; + + my @tables_auto_inc = ( + [ qw/loader_test1 id/ ], + [ qw/loader_test2 id/ ], + ); + + my @tables_reltests = qw/ + loader_test4 + loader_test3 + loader_test6 + loader_test5 + loader_test8 + loader_test7 + loader_test9 + loader_test17 + loader_test16 + loader_test20 + loader_test19 + loader_test18 + loader_test22 + loader_test21 + loader_test26 + loader_test25 + /; + + my @tables_advanced = qw/ + loader_test11 + loader_test10 + /; + + my @tables_advanced_auto_inc = ( + [ qw/loader_test10 id10/ ], + [ qw/loader_test11 id11/ ], + ); + + my @tables_inline_rels = qw/ + loader_test13 + loader_test12 + /; + + my @tables_implicit_rels = qw/ + loader_test15 + loader_test14 + /; + + my @tables_rescan = qw/ loader_test30 /; + + 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); + + my $drop_auto_inc = $self->{auto_inc_drop_cb} || sub {}; + + 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($_) for map { $drop_auto_inc->(@$_) } @tables_advanced_auto_inc; + } + unless($self->{no_inline_rels}) { + $dbh->do("DROP TABLE $_") for (@tables_inline_rels); + } + unless($self->{no_implicit_rels}) { + $dbh->do("DROP TABLE $_") for (@tables_implicit_rels); + } + $dbh->do("DROP TABLE $_") for (@tables_rescan); + } + $dbh->do("DROP TABLE $_") for (@tables); + $dbh->do($_) for map { $drop_auto_inc->(@$_) } @tables_auto_inc; + $dbh->disconnect; +} + +sub DESTROY { + my $self = shift; + $self->drop_tables if $self->{_created}; +} + +1; diff --git a/t/backcompat/0.04006/lib/make_dbictest_db.pm b/t/backcompat/0.04006/lib/make_dbictest_db.pm new file mode 100644 index 0000000..6613288 --- /dev/null +++ b/t/backcompat/0.04006/lib/make_dbictest_db.pm @@ -0,0 +1,37 @@ +package make_dbictest_db; + +use strict; +use warnings; +use DBI; + +eval { require DBD::SQLite }; +my $class = $@ ? 'SQLite2' : 'SQLite'; + +my $fn = './t/dbictest.db'; + +unlink($fn); +our $dsn = "dbi:$class:dbname=$fn"; +my $dbh = DBI->connect($dsn); + +$dbh->do($_) for ( + q|CREATE TABLE foo ( + fooid INTEGER PRIMARY KEY, + footext TEXT + )|, + q|CREATE TABLE bar ( + barid INTEGER PRIMARY KEY, + fooref INTEGER REFERENCES foo(fooid) + )|, + q|INSERT INTO foo VALUES (1,'Foo text for number 1')|, + q|INSERT INTO foo VALUES (2,'Foo record associated with the Bar with barid 3')|, + q|INSERT INTO foo VALUES (3,'Foo text for number 3')|, + q|INSERT INTO foo VALUES (4,'Foo text for number 4')|, + q|INSERT INTO bar VALUES (1,4)|, + q|INSERT INTO bar VALUES (2,3)|, + q|INSERT INTO bar VALUES (3,2)|, + q|INSERT INTO bar VALUES (4,1)|, +); + +END { unlink($fn); } + +1;