[Bast-commits] r8178 - in branches/DBIx-Class-Schema-Loader/current: . lib/DBIx/Class/Schema/Loader t

[caelum at dev.catalyst.perl.org]

Author: caelum
Date: 2009-12-28 17:26:59 +0000 (Mon, 28 Dec 2009)
New Revision: 8178

Modified:
   branches/DBIx-Class-Schema-Loader/current/TODO-BACKCOMPAT
   branches/DBIx-Class-Schema-Loader/current/lib/DBIx/Class/Schema/Loader/Base.pm
   branches/DBIx-Class-Schema-Loader/current/t/25backcompat_v4.t
Log:
preserve custom content from un-singularized Results during upgrade

Modified: branches/DBIx-Class-Schema-Loader/current/TODO-BACKCOMPAT
===================================================================
--- branches/DBIx-Class-Schema-Loader/current/TODO-BACKCOMPAT	2009-12-25 09:14:30 UTC (rev 8177)
+++ branches/DBIx-Class-Schema-Loader/current/TODO-BACKCOMPAT	2009-12-28 17:26:59 UTC (rev 8178)
@@ -2,9 +2,12 @@
 
 *** 0.04006 mode
 
-* preserve custom content from un-singularized Results and delete them when in
-  upgrade mode
+* get custom content from un-singularized classes in _load_external, with an
+  appropriate comment that it's during upgrade only, for both static and
+  dynamic schemas
 
+* 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,

Modified: branches/DBIx-Class-Schema-Loader/current/lib/DBIx/Class/Schema/Loader/Base.pm
===================================================================
--- branches/DBIx-Class-Schema-Loader/current/lib/DBIx/Class/Schema/Loader/Base.pm	2009-12-25 09:14:30 UTC (rev 8177)
+++ branches/DBIx-Class-Schema-Loader/current/lib/DBIx/Class/Schema/Loader/Base.pm	2009-12-28 17:26:59 UTC (rev 8178)
@@ -47,15 +47,16 @@
                                 db_schema
                                 _tables
                                 classes
+                                _upgrading_classes
                                 monikers
                                 dynamic
                                 naming
-                                _upgrading_from
                              /);
 
 __PACKAGE__->mk_accessors(qw/
                                 version_to_dump
                                 schema_version_to_dump
+                                _upgrading_from
 /);
 
 =head1 NAME
@@ -331,6 +332,7 @@
 
     $self->{monikers} = {};
     $self->{classes} = {};
+    $self->{_upgrading_classes} = {};
 
     $self->{schema_class} ||= ( ref $self->{schema} || $self->{schema} );
     $self->{schema} ||= $self->{schema_class};
@@ -390,6 +392,9 @@
 details.
 EOF
         }
+        else {
+            $self->_upgrading_from('v4');
+        }
 
         $self->naming->{relationships} ||= 'v4';
         $self->naming->{monikers}      ||= 'v4';
@@ -426,6 +431,9 @@
 details.
 EOF
             }
+            else {
+                $self->_upgrading_from($v);
+            }
 
             $self->naming->{relationships} ||= $v;
             $self->naming->{monikers}      ||= $v;
@@ -671,6 +679,12 @@
 
     my $class_path = $self->_class_path($class);
     delete $INC{ $class_path };
+
+# kill redefined warnings
+    local $SIG{__WARN__} = sub {
+        warn @_ unless $_[0] =~ /^Subroutine \S+ redefined/;
+    };
+
     eval "require $class;";
 }
 
@@ -776,6 +790,23 @@
 
     my ($custom_content, $old_md5, $old_ver, $old_ts) = $self->_get_custom_content($class, $filename);
 
+    if ($self->_upgrading_from) {
+        my $old_class = $self->_upgrading_classes->{$class};
+
+        if ($old_class && ($old_class ne $class)) {
+            my $old_filename = $self->_get_dump_filename($old_class);
+
+            my ($old_custom_content) = $self->_get_custom_content(
+                $old_class, $old_filename
+            );
+
+            $custom_content .= "\n" . $old_custom_content
+                if $old_custom_content;
+
+            unlink $old_filename;
+        }
+    }
+
     $text .= qq|$_\n|
         for @{$self->{_dump_storage}->{$class} || []};
 
@@ -903,6 +934,15 @@
     }
     my $table_class = join(q{::}, @result_namespace, $table_moniker);
 
+    if (my $upgrading_v = $self->_upgrading_from) {
+        local $self->naming->{monikers} = $upgrading_v;
+
+        my $old_class = join(q{::}, @result_namespace,
+            $self->_table2moniker($table));
+
+        $self->_upgrading_classes->{$table_class} = $old_class;
+    }
+
     my $table_normalized = lc $table;
     $self->classes->{$table} = $table_class;
     $self->classes->{$table_normalized} = $table_class;

Modified: branches/DBIx-Class-Schema-Loader/current/t/25backcompat_v4.t
===================================================================
--- branches/DBIx-Class-Schema-Loader/current/t/25backcompat_v4.t	2009-12-25 09:14:30 UTC (rev 8177)
+++ branches/DBIx-Class-Schema-Loader/current/t/25backcompat_v4.t	2009-12-28 17:26:59 UTC (rev 8178)
@@ -13,8 +13,15 @@
 sub run_loader {
     my %loader_opts = @_;
 
-    Class::Unload->unload($SCHEMA_CLASS);
+    eval {
+        foreach my $source_name ($SCHEMA_CLASS->clone->sources) {
+            Class::Unload->unload("${SCHEMA_CLASS}::${source_name}");
+        }
 
+        Class::Unload->unload($SCHEMA_CLASS);
+    };
+    undef $@;
+
     my @connect_info = $make_dbictest_db2::dsn;
     my @loader_warnings;
     local $SIG{__WARN__} = sub { push(@loader_warnings, $_[0]); };
@@ -103,6 +110,8 @@
     my $res = run_loader(naming => 'v4');
 
     is_deeply $res->{warnings}, [], 'no warnings with naming attribute set';
+
+    run_v4_tests($res);
 }
 
 # test upgraded dynamic schema
@@ -121,7 +130,6 @@
     run_v5_tests($res);
 }
 
-
 # test running against v4 schema without upgrade
 {
     # write out the 0.04006 Schema.pm we have in __DATA__
@@ -175,7 +183,8 @@
         'correct warnings on upgrading static schema (with "naming" set)';
 
     is scalar @{ $res->{warnings} }, 2,
-'correct number of warnings on upgrading static schema (with "naming" set)';
+'correct number of warnings on upgrading static schema (with "naming" set)'
+        or diag @{ $res->{warnings} };
 
     run_v5_tests($res);