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 (file)
--- 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<DBIx::Class::Schema::Loader/loader_options>.  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<DBIx::Class::Schema::Loader>, 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<Schema.pm> 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<DBIx::Class> 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 (file)
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 (file)
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 (file)
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 (file)
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 (file)
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 (file)
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 (file)
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 (file)
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 (file)
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 (file)
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 (file)
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 (file)
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 (file)
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 (file)
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 (file)
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 (file)
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 (file)
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;