more use_namespaces upgrade stuff, fix _table_filter

diff --git a/Changes b/Changes
index 44686d3..9a99ed6 100644 (file)
--- a/Changes
+++ b/Changes
@@ -1,5 +1,6 @@
 Revision history for Perl extension DBIx::Class::Schema::Loader
 
+        - filter out un-selectable tables/views
         - fix NUMERIC/DECIMAL size column_info for postgres
         - now mentions skip_load_external feature in comments (jhannah)
         - moniker_map POD correction (jhannah)

diff --git a/TODO-BACKCOMPAT b/TODO-BACKCOMPAT
deleted file mode 100644 (file)
index 08eda1c..0000000
--- a/TODO-BACKCOMPAT
+++ /dev/null
@@ -1,13 +0,0 @@
-SL Backcompat Plan:
-
-* make use_namespaces the default, and upgrade to it properly
-
-*** Catalyst Helper
-
-* Add 'upgrade=1' option that upgrades from both old S::L and old helper,
-  whichever or both.
-* Warn when old helper output or 0.04000 S::L output is detected, that refers to
-  the upgrade option.
-
-Release dev S::L, announce to catalyst, dbic lists and #catalyst that testing of
-backcompat mode is needed, wait 2-3 weeks, then release 0.05000.

diff --git a/lib/DBIx/Class/Schema/Loader/Base.pm b/lib/DBIx/Class/Schema/Loader/Base.pm
index 25b8f86..8329e22 100644 (file)
--- a/lib/DBIx/Class/Schema/Loader/Base.pm
+++ b/lib/DBIx/Class/Schema/Loader/Base.pm
@@ -437,6 +437,8 @@ Dynamic schema detected, will run in 0.04006 mode.
 Set the 'naming' attribute or the SCHEMA_LOADER_BACKCOMPAT environment variable
 to disable this warning.
 
+Also consider setting 'use_namespaces => 1' if/when upgrading.
+
 See perldoc DBIx::Class::Schema::Loader::Manual::UpgradingFromV4 for more
 details.
 EOF
@@ -448,7 +450,12 @@ EOF
         $self->naming->{relationships} ||= 'v4';
         $self->naming->{monikers}      ||= 'v4';
 
-        $self->use_namespaces(0) unless defined $self->use_namespaces;
+        if ($self->use_namespaces) {
+            $self->_upgrading_from_load_classes(1);
+        }
+        else {
+            $self->use_namespaces(0);
+        }
 
         return;
     }
@@ -465,16 +472,31 @@ EOF
     while (<$fh>) {
         if (/^__PACKAGE__->load_classes;/) {
             $load_classes = 1;
-        } elsif (/^# Created by DBIx::Class::Schema::Loader v((\d+)\.(\d+))/) {
-            my $real_ver = $1;
+        } elsif (my ($real_ver) =
+                /^# Created by DBIx::Class::Schema::Loader v(\d+\.\d+)/) {
+
+            if ($load_classes && (not defined $self->use_namespaces)) {
+                warn <<"EOF"  unless $ENV{SCHEMA_LOADER_BACKCOMPAT};
+
+'load_classes;' static schema detected, turning off use_namespaces.
+
+Set the 'use_namespaces' attribute or the SCHEMA_LOADER_BACKCOMPAT environment
+variable to disable this warning.
+
+See perldoc DBIx::Class::Schema::Loader::Manual::UpgradingFromV4 for more
+details.
+EOF
+                $self->use_namespaces(0);
+            }
+            elsif ($load_classes && $self->use_namespaces) {
+                $self->use_namespaces(1);
+                $self->_upgrading_from_load_classes(1);
+            }
 
             # XXX when we go past .0 this will need fixing
             my ($v) = $real_ver =~ /([1-9])/;
             $v = "v$v";
 
-            $self->_upgrading_from_load_classes($load_classes)
-                unless defined $self->use_namespaces;
-
             last if $v eq CURRENT_V || $real_ver =~ /^0\.\d\d999/;
 
             if (not %{ $self->naming }) {
@@ -1079,8 +1101,14 @@ sub _make_src_class {
     }
     my $table_class = join(q{::}, @result_namespace, $table_moniker);
 
-    if (my $upgrading_v = $self->_upgrading_from) {
-        local $self->naming->{monikers} = $upgrading_v;
+    if ((my $upgrading_v = $self->_upgrading_from)
+            || $self->_upgrading_from_load_classes) {
+        local $self->naming->{monikers} = $upgrading_v
+            if $upgrading_v;
+
+        my @result_namespace = @result_namespace;
+        @result_namespace = ($schema_class)
+            if $self->_upgrading_from_load_classes;
 
         my $old_class = join(q{::}, @result_namespace,
             $self->_table2moniker($table));

diff --git a/lib/DBIx/Class/Schema/Loader/DBI.pm b/lib/DBIx/Class/Schema/Loader/DBI.pm
index 8a06554..726599c 100644 (file)
--- a/lib/DBIx/Class/Schema/Loader/DBI.pm
+++ b/lib/DBIx/Class/Schema/Loader/DBI.pm
@@ -109,8 +109,10 @@ sub _filter_tables {
     my @filtered_tables;
 
     for my $table (@tables) {
-        my $sth = $self->_sth_for($table, undef, \'1 = 0');
-        eval { $sth->execute };
+        eval {
+            my $sth = $self->_sth_for($table, undef, \'1 = 0');
+            $sth->execute;
+        };
         if (not $@) {
             push @filtered_tables, $table;
         }

diff --git a/t/25backcompat_v4.t b/t/25backcompat_v4.t
index bffba74..60362aa 100644 (file)
--- a/t/25backcompat_v4.t
+++ b/t/25backcompat_v4.t
@@ -114,6 +114,66 @@ EOF
     pop @INC;
 }
 
+# test upgraded dynamic schema with use_namespaces with external content loaded
+{
+    my $temp_dir = tempdir;
+    push @INC, $temp_dir;
+
+    my $external_result_dir = join '/', $temp_dir, split /::/, $SCHEMA_CLASS;
+    make_path $external_result_dir;
+
+    # make external content for Result that will be singularized
+    IO::File->new(">$external_result_dir/Quuxs.pm")->print(<<"EOF");
+package ${SCHEMA_CLASS}::Quuxs;
+sub a_method { 'hlagh' }
+
+__PACKAGE__->has_one('bazrel', 'DBIXCSL_Test::Schema::Bazs',
+    { 'foreign.baz_num' => 'self.baz_id' });
+
+1;
+EOF
+
+    # make external content for Result that will NOT be singularized
+    IO::File->new(">$external_result_dir/Bar.pm")->print(<<"EOF");
+package ${SCHEMA_CLASS}::Bar;
+
+__PACKAGE__->has_one('foorel', 'DBIXCSL_Test::Schema::Foos',
+    { 'foreign.fooid' => 'self.foo_id' });
+
+1;
+EOF
+
+    my $res = run_loader(naming => 'current', use_namespaces => 1);
+    my $schema = $res->{schema};
+
+    is scalar @{ $res->{warnings} }, 2,
+'correct nummber of warnings for upgraded dynamic schema with external ' .
+'content for unsingularized Result with use_namespaces.';
+
+    my $warning = $res->{warnings}[0];
+    like $warning, qr/Detected external content/i,
+        'detected external content warning';
+
+    lives_and { is $schema->resultset('Quux')->find(1)->a_method, 'hlagh' }
+'external custom content for unsingularized Result was loaded by upgraded ' .
+'dynamic Schema';
+
+    lives_and { isa_ok $schema->resultset('Quux')->find(1)->bazrel,
+        $res->{classes}{bazs} }
+        'unsingularized class names in external content are translated';
+
+    lives_and { isa_ok $schema->resultset('Bar')->find(1)->foorel,
+        $res->{classes}{foos} }
+'unsingularized class names in external content from unchanged Result class ' .
+'names are translated';
+
+    run_v5_tests($res);
+
+    rmtree $temp_dir;
+    pop @INC;
+}
+
+
 # test upgraded static schema with external content loaded
 {
     my $temp_dir = tempdir;
@@ -365,7 +425,8 @@ sub run_loader {
     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}";
+        $classes{$table_name}  = "${SCHEMA_CLASS}::" . (
+            $loader_opts{use_namespaces} ? 'Result::' : '') . $source_name;
     }
 
     return {