From: Rafael Kitover <rkitover@cpan.org>
Date: Tue, 12 Jan 2010 06:44:49 +0000 (+0000)
Subject: use_namespaces upgrade is fully tested, need to implement downgrade
X-Git-Tag: 0.04999_14~6
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=a1a91c420b11ce257dfad4f2323cb7c006ab285b;p=dbsrgits%2FDBIx-Class-Schema-Loader.git

use_namespaces upgrade is fully tested, need to implement downgrade
---

diff --git a/TODO b/TODO
index ee048c4..3506b5b 100644
--- a/TODO
+++ b/TODO
@@ -23,3 +23,5 @@ Relationship stuff:
    Re-scan relations/tables after initial relation setup to find ->many_to_many() relations to be set up?
    While scanning for many-to-many, scan for implied rels as well? (if foo->belongs_to('bar') and baz->belongs_to('bar'), does that impliy foo->might_have('baz') and the reverse?)
    ...
+
+unregister sources for dropped tables on rescan
diff --git a/lib/DBIx/Class/Schema/Loader/Base.pm b/lib/DBIx/Class/Schema/Loader/Base.pm
index 8329e22..1856903 100644
--- a/lib/DBIx/Class/Schema/Loader/Base.pm
+++ b/lib/DBIx/Class/Schema/Loader/Base.pm
@@ -478,7 +478,7 @@ EOF
             if ($load_classes && (not defined $self->use_namespaces)) {
                 warn <<"EOF"  unless $ENV{SCHEMA_LOADER_BACKCOMPAT};
 
-'load_classes;' static schema detected, turning off use_namespaces.
+'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.
@@ -489,7 +489,6 @@ EOF
                 $self->use_namespaces(0);
             }
             elsif ($load_classes && $self->use_namespaces) {
-                $self->use_namespaces(1);
                 $self->_upgrading_from_load_classes(1);
             }
 
@@ -521,8 +520,6 @@ EOF
 
             $self->schema_version_to_dump($real_ver);
 
-            $self->use_namespaces(0) unless defined $self->use_namespaces;
-
             last;
         }
     }
diff --git a/t/25backcompat_v4.t b/t/25backcompat_v4.t
index 5fc2511..e431f33 100644
--- a/t/25backcompat_v4.t
+++ b/t/25backcompat_v4.t
@@ -240,7 +240,7 @@ EOF
 {
     write_v4_schema_pm();
     my $res = run_loader(dump_directory => $DUMP_DIR);
-    my $warning = $res->{warnings}[0];
+    my $warning = $res->{warnings}[1];
 
     like $warning, qr/static schema/i,
         'static schema in backcompat mode detected';
@@ -249,7 +249,7 @@ EOF
     like $warning, qr/DBIx::Class::Schema::Loader::Manual::UpgradingFromV4/,
         'refers to upgrading doc';
 
-    is scalar @{ $res->{warnings} }, 3,
+    is scalar @{ $res->{warnings} }, 4,
         'correct number of warnings for static schema in backcompat mode';
 
     run_v4_tests($res);
@@ -282,7 +282,11 @@ EOF
     run_v4_tests($res);
 
     # now upgrade the schema
-    $res = run_loader(dump_directory => $DUMP_DIR, naming => 'current');
+    $res = run_loader(
+        dump_directory => $DUMP_DIR,
+        naming => 'current',
+        use_namespaces => 1
+    );
     $schema = $res->{schema};
 
     like $res->{warnings}[0], qr/Dumping manual schema/i,
@@ -297,6 +301,93 @@ EOF
 
     run_v5_tests($res);
 
+    (my $result_dir = "$DUMP_DIR/$SCHEMA_CLASS/Result") =~ s{::}{/}g;
+    my $result_count =()= glob "$result_dir/*";
+
+    is $result_count, 4,
+        'un-singularized results were replaced during upgrade';
+
+    # check that custom content was preserved
+    lives_and { is $schema->resultset('Quux')->find(1)->a_method, 'mtfnpy' }
+        'custom content was carried over from un-singularized Result';
+
+    lives_and { isa_ok $schema->resultset('Quux')->find(1)->bazrel3,
+        $res->{classes}{bazs} }
+        'unsingularized class names in custom content are translated';
+
+    my $file = $schema->_loader->_get_dump_filename($res->{classes}{quuxs});
+    my $code = do { local ($/, @ARGV) = (undef, $file); <> };
+
+    like $code, qr/sub a_method { 'mtfnpy' }/,
+'custom content from unsingularized Result loaded into static dump correctly';
+}
+
+# test running against v4 schema without upgrade, then upgrade with
+# use_namespaces not explicitly set
+{
+    write_v4_schema_pm();
+    my $res = run_loader(dump_directory => $DUMP_DIR);
+    my $warning = $res->{warnings}[1];
+
+    like $warning, qr/static schema/i,
+        'static schema in backcompat mode detected';
+    like $warning, qr/0.04006/,
+        'correct version detected';
+    like $warning, qr/DBIx::Class::Schema::Loader::Manual::UpgradingFromV4/,
+        'refers to upgrading doc';
+
+    is scalar @{ $res->{warnings} }, 4,
+        'correct number of warnings for static schema in backcompat mode';
+
+    run_v4_tests($res);
+
+    # add some custom content to a Result that will be replaced
+    my $schema   = $res->{schema};
+    my $quuxs_pm = $schema->_loader
+        ->_get_dump_filename($res->{classes}{quuxs});
+    {
+        local ($^I, @ARGV) = ('', $quuxs_pm);
+        while (<>) {
+            if (/DO NOT MODIFY THIS OR ANYTHING ABOVE/) {
+                print;
+                print <<EOF;
+sub a_method { 'mtfnpy' }
+
+__PACKAGE__->has_one('bazrel3', 'DBIXCSL_Test::Schema::Bazs',
+    { 'foreign.baz_num' => 'self.baz_id' });
+EOF
+            }
+            else {
+                print;
+            }
+        }
+    }
+
+    # now upgrade the schema
+    $res = run_loader(
+        dump_directory => $DUMP_DIR,
+        naming => 'current'
+    );
+    $schema = $res->{schema};
+
+    like $res->{warnings}[0], qr/load_classes/i,
+'correct warnings on upgrading static schema (with "naming" set and ' .
+'use_namespaces not set)';
+
+    like $res->{warnings}[1], qr/Dumping manual schema/i,
+'correct warnings on upgrading static schema (with "naming" set and ' .
+'use_namespaces not set)';
+
+    like $res->{warnings}[2], qr/dump completed/i,
+'correct warnings on upgrading static schema (with "naming" set and ' .
+'use_namespaces not set)';
+
+    is scalar @{ $res->{warnings} }, 3,
+'correct number of warnings on upgrading static schema (with "naming" set)'
+        or diag @{ $res->{warnings} };
+
+    run_v5_tests($res);
+
     (my $result_dir = "$DUMP_DIR/$SCHEMA_CLASS") =~ s{::}{/}g;
     my $result_count =()= glob "$result_dir/*";
 
@@ -395,9 +486,6 @@ END {
 sub run_loader {
     my %loader_opts = @_;
 
-    $loader_opts{use_namespaces} = 0
-        unless exists $loader_opts{use_namespaces};
-
     eval {
         foreach my $source_name ($SCHEMA_CLASS->clone->sources) {
             Class::Unload->unload("${SCHEMA_CLASS}::${source_name}");
diff --git a/t/backcompat/0.04006/lib/dbixcsl_common_tests.pm b/t/backcompat/0.04006/lib/dbixcsl_common_tests.pm
index 6947cb7..3a64bc3 100644
--- a/t/backcompat/0.04006/lib/dbixcsl_common_tests.pm
+++ b/t/backcompat/0.04006/lib/dbixcsl_common_tests.pm
@@ -184,10 +184,7 @@ sub run_tests {
         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;
-        }
+        can_ok( $rsobj1, 'loader_test1_rsmeth' ) or $skip_rsmeth = 1;
 
         SKIP: {
             skip "Pre-requisite test failed", 1 if $skip_tab;
diff --git a/t/lib/dbixcsl_common_tests.pm b/t/lib/dbixcsl_common_tests.pm
index 85f0c78..1bec30b 100644
--- a/t/lib/dbixcsl_common_tests.pm
+++ b/t/lib/dbixcsl_common_tests.pm
@@ -123,7 +123,8 @@ sub setup_schema {
 
        my $expected_count = 34;
 
-       $expected_count += @{ $self->{extra}{create} || [] };
+       $expected_count += grep /CREATE (?:TABLE|VIEW)/i,
+           @{ $self->{extra}{create} || [] };
 
        $expected_count -= grep /CREATE TABLE/, @statements_inline_rels
            if $self->{no_inline_rels};