X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FSchema%2FLoader%2FBase.pm;h=8c82515b131e6696d021e219383c0a1cb30c8d40;hb=e1373c52a2c94d82334371f5b6bb3bd70ac320c9;hp=39bb01d923275cc379641ee37ccb7ae07b2e3ebc;hpb=30a4c06469a4ab7dbd285cc4d01e43607c503ed3;p=dbsrgits%2FDBIx-Class-Schema-Loader.git

diff --git a/lib/DBIx/Class/Schema/Loader/Base.pm b/lib/DBIx/Class/Schema/Loader/Base.pm
index 39bb01d..8c82515 100644
--- a/lib/DBIx/Class/Schema/Loader/Base.pm
+++ b/lib/DBIx/Class/Schema/Loader/Base.pm
@@ -16,7 +16,7 @@ use File::Temp qw//;
 use Class::Unload;
 require DBIx::Class;
 
-our $VERSION = '0.04999_12';
+our $VERSION = '0.04999_13';
 
 __PACKAGE__->mk_group_ro_accessors('simple', qw/
                                 schema
@@ -460,7 +460,7 @@ EOF
             my ($v) = $real_ver =~ /([1-9])/;
             $v = "v$v";
 
-            last if $v eq CURRENT_V || $real_ver =~ /^0\.04999/;
+            last if $v eq CURRENT_V || $real_ver =~ /^0\.\d\d999/;
 
             if (not %{ $self->naming }) {
                 warn <<"EOF" unless $ENV{SCHEMA_LOADER_BACKCOMPAT};
@@ -476,6 +476,7 @@ EOF
             }
             else {
                 $self->_upgrading_from($v);
+                last;
             }
 
             $self->naming->{relationships} ||= $v;
@@ -518,6 +519,21 @@ sub _find_class_in_inc {
     return $self->_find_file_in_inc($self->_class_path($class));
 }
 
+sub _rewrite_old_classnames {
+    my ($self, $code) = @_;
+
+    return $code unless $self->_upgrading_from;
+
+    my %old_classes = reverse %{ $self->_upgrading_classes };
+
+    my $re = join '|', keys %old_classes;
+    $re = qr/\b($re)\b/;
+
+    $code =~ s/$re/$old_classes{$1} || $1/eg;
+
+    return $code;
+}
+
 sub _load_external {
     my ($self, $class) = @_;
 
@@ -543,23 +559,10 @@ sub _load_external {
 
         open(my $fh, '<', $real_inc_path)
             or croak "Failed to open '$real_inc_path' for reading: $!";
-        $self->_ext_stmt($class,
-          qq|# These lines were loaded from '$real_inc_path' found in \@INC.\n|
-         .qq|# They are now part of the custom portion of this file\n|
-         .qq|# for you to hand-edit.  If you do not either delete\n|
-         .qq|# this section or remove that file from \@INC, this section\n|
-         .qq|# will be repeated redundantly when you re-create this\n|
-         .qq|# file again via Loader!\n|
-        );
-        while(<$fh>) {
-            chomp;
-            $self->_ext_stmt($class, $_);
-        }
-        $self->_ext_stmt($class,
-            qq|# End of lines loaded from '$real_inc_path' |
-        );
+        my $code = do { local $/; <$fh> };
         close($fh)
             or croak "Failed to close $real_inc_path: $!";
+        $code = $self->_rewrite_old_classnames($code);
 
         if ($self->dynamic) { # load the class too
             # kill redefined warnings
@@ -568,9 +571,23 @@ sub _load_external {
                 $warn_handler->(@_)
                     unless $_[0] =~ /^Subroutine \S+ redefined/;
             };
-            do $real_inc_path;
+            eval $code;
             die $@ if $@;
         }
+
+        $self->_ext_stmt($class,
+          qq|# These lines were loaded from '$real_inc_path' found in \@INC.\n|
+         .qq|# They are now part of the custom portion of this file\n|
+         .qq|# for you to hand-edit.  If you do not either delete\n|
+         .qq|# this section or remove that file from \@INC, this section\n|
+         .qq|# will be repeated redundantly when you re-create this\n|
+         .qq|# file again via Loader!\n|
+        );
+        chomp $code;
+        $self->_ext_stmt($class, $code);
+        $self->_ext_stmt($class,
+            qq|# End of lines loaded from '$real_inc_path' |
+        );
     }
 
     if ($old_real_inc_path) {
@@ -583,6 +600,12 @@ sub _load_external {
 # version of the Loader. For a static schema, this happens only once during
 # upgrade.
 EOF
+
+        my $code = do {
+            local ($/, @ARGV) = (undef, $old_real_inc_path); <>
+        };
+        $code = $self->_rewrite_old_classnames($code);
+
         if ($self->dynamic) {
             warn <<"EOF";
 
@@ -598,25 +621,15 @@ EOF
                 $warn_handler->(@_)
                     unless $_[0] =~ /^Subroutine \S+ redefined/;
             };
-            my $code = do {
-                local ($/, @ARGV) = (undef, $old_real_inc_path); <>
-            };
-            $code =~ s/$old_class/$class/g;
             eval $code;
             die $@ if $@;
         }
 
-        while(<$fh>) {
-            chomp;
-            s/$old_class/$class/g;
-            $self->_ext_stmt($class, $_);
-        }
+        chomp $code;
+        $self->_ext_stmt($class, $code);
         $self->_ext_stmt($class,
             qq|# End of lines loaded from '$old_real_inc_path' |
         );
-
-        close($fh)
-            or croak "Failed to close $old_real_inc_path: $!";
     }
 }
 
@@ -858,7 +871,7 @@ sub _dump_to_dir {
 
     {
         local $self->{version_to_dump} = $self->schema_version_to_dump;
-        $self->_write_classfile($schema_class, $schema_text);
+        $self->_write_classfile($schema_class, $schema_text, 1);
     }
 
     my $result_base_class = $self->result_base_class || 'DBIx::Class::Core';
@@ -887,7 +900,7 @@ sub _sig_comment {
 }
 
 sub _write_classfile {
-    my ($self, $class, $text) = @_;
+    my ($self, $class, $text, $is_schema) = @_;
 
     my $filename = $self->_get_dump_filename($class);
     $self->_ensure_dump_subdirs($class);
@@ -900,27 +913,25 @@ sub _write_classfile {
 
     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, 0 # do not add default comment
-            );
+    if (my $old_class = $self->_upgrading_classes->{$class}) {
+        my $old_filename = $self->_get_dump_filename($old_class);
 
-            $old_custom_content =~ s/\n\n# You can replace.*\n1;\n//;
+        my ($old_custom_content) = $self->_get_custom_content(
+            $old_class, $old_filename, 0 # do not add default comment
+        );
 
-            if ($old_custom_content) {
-                $custom_content =
-                    "\n" . $old_custom_content . "\n" . $custom_content;
-            }
+        $old_custom_content =~ s/\n\n# You can replace.*\n1;\n//;
 
-            unlink $old_filename;
+        if ($old_custom_content) {
+            $custom_content =
+                "\n" . $old_custom_content . "\n" . $custom_content;
         }
+
+        unlink $old_filename;
     }
 
+    $custom_content = $self->_rewrite_old_classnames($custom_content);
+
     $text .= qq|$_\n|
         for @{$self->{_dump_storage}->{$class} || []};
 
@@ -932,7 +943,7 @@ sub _write_classfile {
       
 
       if (Digest::MD5::md5_base64($compare_to) eq $old_md5) {
-        return;
+        return unless $self->_upgrading_from && $is_schema;
       }
     }
 
@@ -1056,7 +1067,8 @@ sub _make_src_class {
         my $old_class = join(q{::}, @result_namespace,
             $self->_table2moniker($table));
 
-        $self->_upgrading_classes->{$table_class} = $old_class;
+        $self->_upgrading_classes->{$table_class} = $old_class
+            unless $table_class eq $old_class;
     }
 
     my $table_normalized = lc $table;