start of backcompat tests

diff --git a/lib/DBIx/Class/Schema/Loader/Base.pm b/lib/DBIx/Class/Schema/Loader/Base.pm
index ea22c4f..5403cc2 100644 (file)
--- a/lib/DBIx/Class/Schema/Loader/Base.pm
+++ b/lib/DBIx/Class/Schema/Loader/Base.pm
@@ -291,6 +291,8 @@ can also be found via standard L<DBIx::Class::Schema> methods somehow.
 
 =cut
 
+use constant CURRENT_V => 'v5';
+
 # ensure that a peice of object data is a valid arrayref, creating
 # an empty one or encapsulating whatever's there.
 sub _ensure_arrayref {
@@ -348,7 +350,7 @@ sub new {
     $self->version_to_dump($DBIx::Class::Schema::Loader::VERSION);
     $self->schema_version_to_dump($DBIx::Class::Schema::Loader::VERSION);
 
-    if (not ref $self->naming && defined $self->naming) {
+    if ((not ref $self->naming) && defined $self->naming) {
         my $naming_ver = $self->naming;
         $self->{naming} = {
             relationships => $naming_ver,
@@ -356,6 +358,13 @@ sub new {
         };
     }
 
+    if ($self->naming) {
+        for (values %{ $self->naming }) {
+            $_ = CURRENT_V if $_ eq 'current';
+        }
+    }
+    $self->{naming} ||= {};
+
     $self->_check_back_compat;
 
     $self;
@@ -369,6 +378,16 @@ sub _check_back_compat {
 # just in case, though no one is likely to dump a dynamic schema
         $self->schema_version_to_dump('0.04006');
 
+        if (not %{ $self->naming }) {
+            warn <<EOF unless $ENV{SCHEMA_LOADER_BACKCOMPAT};
+
+Dynamic schema detected, will run in 0.04006 mode.
+
+Set the 'naming' attribute or the SCHEMA_LOADER_BACKCOMPAT environment variable
+to disable this warning.
+EOF
+        }
+
         $self->naming->{relationships} ||= 'v4';
         $self->naming->{monikers}      ||= 'v4';
 
@@ -516,6 +535,7 @@ sub rescan {
 }
 
 sub _relbuilder {
+    no warnings 'uninitialized';
     my ($self) = @_;
 
     return if $self->{skip_relationships};
@@ -963,6 +983,7 @@ sub tables {
 
 # Make a moniker from a table
 sub _default_table2moniker {
+    no warnings 'uninitialized';
     my ($self, $table) = @_;
 
     if ($self->naming->{monikers} eq 'v4') {

diff --git a/t/25backcompat_v4.t b/t/25backcompat_v4.t
new file mode 100644 (file)
index 0000000..a7e3575
--- /dev/null
+++ b/t/25backcompat_v4.t
@@ -0,0 +1,73 @@
+use strict;
+use warnings;
+use Test::More;
+use File::Path;
+use Class::Unload;
+use lib qw(t/lib);
+use make_dbictest_db2;
+
+my $DUMP_DIR = './t/_common_dump';
+rmtree $DUMP_DIR;
+
+sub run_loader {
+    my %loader_opts = @_;
+
+    my $schema_class = 'DBIXCSL_Test::Schema';
+    Class::Unload->unload($schema_class);
+
+    my @connect_info = $make_dbictest_db2::dsn;
+    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 $schema = $schema_class->clone;
+    my (%monikers, %classes);
+    foreach my $source_name ($schema->sources) {
+        my $table_name = $schema->source($source_name)->from;
+        $monikers{$table_name} = $source_name;
+        $classes{$table_name}  = "${schema_class}::${source_name}";
+    }
+
+    return {
+        schema => $schema,
+        warnings => \@loader_warnings,
+        monikers => \%monikers,
+        classes => \%classes,
+    };
+}
+
+# test dynamic schema in 0.04006 mode
+{
+    my $res = run_loader();
+
+    like $res->{warnings}[0], qr/dynamic schema/i,
+        'dynamic schema in backcompat mode detected';
+    like $res->{warnings}[0], qr/run in 0\.04006 mode/,
+        'dynamic schema in 0.04006 mode warning';
+
+    is_deeply [ @{ $res->{monikers} }{qw/foos bar bazes quuxes/} ],
+        [qw/Foos Bar Bazes Quuxes/],
+        'correct monikers in 0.04006 mode';
+
+    ok my $bar = eval { $res->{schema}->resultset('Bar')->find(1) };
+
+    isa_ok eval { $bar->fooref }, $res->{classes}{foos},
+        'correct rel name';
+
+    ok my $baz  = eval { $res->{schema}->resultset('Bazes')->find(1) };
+
+    isa_ok eval { $baz->quuxes }, 'DBIx::Class::ResultSet',
+        'correct rel type and name for UNIQUE FK';
+}
+
+done_testing;
+
+END { rmtree $DUMP_DIR }

diff --git a/t/lib/make_dbictest_db2.pm b/t/lib/make_dbictest_db2.pm
new file mode 100644 (file)
index 0000000..b16761b
--- /dev/null
+++ b/t/lib/make_dbictest_db2.pm
@@ -0,0 +1,50 @@
+package make_dbictest_db2;
+
+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 foos (
+        fooid INTEGER PRIMARY KEY,
+        footext TEXT
+      )|,
+    q|CREATE TABLE bar (
+        barid INTEGER PRIMARY KEY,
+        fooref INTEGER REFERENCES foos (fooid)
+      )|,
+    q|CREATE TABLE bazes (
+        bazid INTEGER PRIMARY KEY,
+        baz_num INTEGER NOT NULL UNIQUE
+      )|,
+    q|CREATE TABLE quuxes (
+        quuxid INTEGER PRIMARY KEY,
+        bazref INTEGER NOT NULL,
+        FOREIGN KEY (bazref) REFERENCES bazes (baz_num)
+      )|,
+    q|INSERT INTO foos VALUES (1,'Foo text for number 1')|,
+    q|INSERT INTO foos VALUES (2,'Foo record associated with the Bar with barid 3')|,
+    q|INSERT INTO foos VALUES (3,'Foo text for number 3')|,
+    q|INSERT INTO foos 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)|,
+    q|INSERT INTO bazes VALUES (1,20)|,
+    q|INSERT INTO bazes VALUES (2,19)|,
+    q|INSERT INTO quuxes VALUES (1,20)|,
+    q|INSERT INTO quuxes VALUES (2,19)|,
+);
+
+END { unlink($fn); }
+
+1;