load custom content from external un-singularized classes, tested for dynamic schema...
Rafael Kitover [Tue, 29 Dec 2009 14:38:40 +0000 (14:38 +0000)]
TODO-BACKCOMPAT
lib/DBIx/Class/Schema/Loader/Base.pm
t/25backcompat_v4.t

index 1141078..fd763d6 100644 (file)
@@ -2,9 +2,8 @@ SL Backcompat Plan:
 
 *** 0.04006 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
+* test getting custom content from un-singularized classes in _load_external
+  for a static schema
 
 * make use_namespaces the default, and upgrade to it properly
 
index 0997ad7..516a402 100644 (file)
@@ -478,39 +478,94 @@ sub _find_class_in_inc {
 sub _load_external {
     my ($self, $class) = @_;
 
+    # so that we don't load our own classes, under any circumstances
+    local *INC = [ grep $_ ne $self->dump_directory, @INC ];
+
     my $real_inc_path = $self->_find_class_in_inc($class);
 
-    return if !$real_inc_path;
-
-    # If we make it to here, we loaded an external definition
-    warn qq/# Loaded external class definition for '$class'\n/
-        if $self->debug;
-
-    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, $_);
+    my $old_class = $self->_upgrading_classes->{$class}
+        if $self->_upgrading_from;
+
+    my $old_real_inc_path = $self->_find_class_in_inc($old_class)
+        if $old_class && $old_class ne $class;
+
+    return unless $real_inc_path || $old_real_inc_path;
+
+    if ($real_inc_path) {
+        # If we make it to here, we loaded an external definition
+        warn qq/# Loaded external class definition for '$class'\n/
+            if $self->debug;
+
+        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' |
+        );
+        close($fh)
+            or croak "Failed to close $real_inc_path: $!";
+
+        if ($self->dynamic) { # load the class too
+            # kill redefined warnings
+            local $SIG{__WARN__} = sub {
+                warn @_ unless $_[0] =~ /^Subroutine \S+ redefined/;
+            };
+            do $real_inc_path;
+            die $@ if $@;
+        }
     }
-    $self->_ext_stmt($class,
-        qq|# End of lines loaded from '$real_inc_path' |
-    );
-    close($fh)
-        or croak "Failed to close $real_inc_path: $!";
 
-    if ($self->dynamic) { # load the class too
-        # turn off redefined warnings
-        local $SIG{__WARN__} = sub {};
-        do $real_inc_path;
-        die $@ if $@;
+    if ($old_real_inc_path) {
+        open(my $fh, '<', $old_real_inc_path)
+            or croak "Failed to open '$old_real_inc_path' for reading: $!";
+        $self->_ext_stmt($class, <<"EOF");
+
+# These lines were loaded from '$old_real_inc_path', based on the Result class
+# name that would have been created by an 0.04006 version of the Loader. For a
+# static schema, this happens only once during upgrade.
+EOF
+        if ($self->dynamic) {
+            warn <<"EOF";
+
+Detected external content in '$old_real_inc_path', a class name that would have
+been used by an 0.04006 version of the Loader.
+
+* PLEASE RENAME THIS CLASS: from '$old_class' to '$class', as that is the
+new name of the Result.
+EOF
+            # kill redefined warnings
+            local $SIG{__WARN__} = sub {
+                warn @_ 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;
+            $self->_ext_stmt($class, $_);
+        }
+        $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: $!";
     }
 }
 
@@ -608,7 +663,7 @@ sub _load_tables {
         $self->{quiet} = 0;
 
         # Remove that temp dir from INC so it doesn't get reloaded
-        @INC = grep { $_ ne $self->{dump_directory} } @INC;
+        @INC = grep $_ ne $self->dump_directory, @INC;
     }
 
     $self->_load_external($_)
@@ -797,11 +852,15 @@ sub _write_classfile {
             my $old_filename = $self->_get_dump_filename($old_class);
 
             my ($old_custom_content) = $self->_get_custom_content(
-                $old_class, $old_filename
+                $old_class, $old_filename, 0 # do not add default comment
             );
 
-            $custom_content .= "\n" . $old_custom_content
-                if $old_custom_content;
+            $old_custom_content =~ s/\n\n# You can replace.*\n1;\n//;
+
+            if ($old_custom_content) {
+                $custom_content =
+                    "\n" . $old_custom_content . "\n" . $custom_content;
+            }
 
             unlink $old_filename;
         }
@@ -851,7 +910,9 @@ sub _default_custom_content {
 }
 
 sub _get_custom_content {
-    my ($self, $class, $filename) = @_;
+    my ($self, $class, $filename, $add_default) = @_;
+
+    $add_default = 1 unless defined $add_default;
 
     return ($self->_default_custom_content) if ! -f $filename;
 
@@ -887,7 +948,7 @@ sub _get_custom_content {
             if !$md5;
 
     # Default custom content:
-    $buffer ||= $self->_default_custom_content;
+    $buffer ||= $self->_default_custom_content if $add_default;
 
     return ($buffer, $md5, $ver, $ts);
 }
@@ -1195,6 +1256,13 @@ sub _quote_table_name {
 
 sub _is_case_sensitive { 0 }
 
+# remove the dump dir from @INC on destruction
+sub DESTROY {
+    my $self = shift;
+
+    @INC = grep $_ ne $self->dump_directory, @INC;
+}
+
 =head2 monikers
 
 Returns a hashref of loaded table to moniker mappings.  There will
index c67c7fb..b4a6f74 100644 (file)
@@ -3,6 +3,8 @@ use warnings;
 use Test::More;
 use File::Path qw/rmtree make_path/;
 use Class::Unload;
+use File::Temp qw/tempfile tempdir/;
+use IO::File;
 use lib qw(t/lib);
 use make_dbictest_db2;
 
@@ -59,7 +61,9 @@ sub run_v4_tests {
         [qw/Foos Bar Bazs Quuxs/],
         'correct monikers in 0.04006 mode';
 
-    ok my $bar = eval { $schema->resultset('Bar')->find(1) };
+    isa_ok ((my $bar = eval { $schema->resultset('Bar')->find(1) }),
+        $res->{classes}{bar},
+        'found a bar');
 
     isa_ok eval { $bar->foo_id }, $res->{classes}{foos},
         'correct rel name in 0.04006 mode';
@@ -130,6 +134,41 @@ sub run_v5_tests {
     run_v5_tests($res);
 }
 
+# test upgraded dynamic schema 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;
+
+    IO::File->new(">$external_result_dir/Quuxs.pm")->print(<<"EOF");
+package ${SCHEMA_CLASS}::Quuxs;
+sub a_method { 'hlagh' }
+1;
+EOF
+
+    my $res = run_loader(naming => 'current');
+    my $schema = $res->{schema};
+
+    is scalar @{ $res->{warnings} }, 1,
+'correct nummber of warnings for upgraded dynamic schema with external ' .
+'content for unsingularized Result.';
+
+    my $warning = $res->{warnings}[0];
+    like $warning, qr/Detected external content/i,
+        'detected external content warning';
+
+    is eval { $schema->resultset('Quux')->find(1)->a_method }, 'hlagh',
+'external custom content for unsingularized Result was loaded by upgraded ' .
+'dynamic Schema';
+
+    run_v5_tests($res);
+
+    rmtree $temp_dir;
+    pop @INC;
+}
+
 # test running against v4 schema without upgrade
 {
     # write out the 0.04006 Schema.pm we have in __DATA__
@@ -153,6 +192,9 @@ sub run_v5_tests {
     like $warning, qr/DBIx::Class::Schema::Loader::Manual::UpgradingFromV4/,
         'refers to upgrading doc';
 
+    is scalar @{ $res->{warnings} }, 3,
+        '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
@@ -201,7 +243,9 @@ sub run_v5_tests {
 
 done_testing;
 
-END { rmtree $DUMP_DIR }
+END {
+    rmtree $DUMP_DIR unless $ENV{SCHEMA_LOADER_TESTS_NOCLEANUP};
+}
 
 # a Schema.pm made with 0.04006