fix regular common tests

[dbsrgits/DBIx-Class-Schema-Loader.git] / lib / DBIx / Class / Schema / Loader / Base.pm

diff --git a/lib/DBIx/Class/Schema/Loader/Base.pm b/lib/DBIx/Class/Schema/Loader/Base.pm
index 2e39d31..e1387e9 100644 (file)
--- a/lib/DBIx/Class/Schema/Loader/Base.pm
+++ b/lib/DBIx/Class/Schema/Loader/Base.pm
@@ -48,6 +48,7 @@ __PACKAGE__->mk_ro_accessors(qw/
                                 _tables
                                 classes
                                 monikers
+                                dynamic
                              /);
 
 __PACKAGE__->mk_accessors(qw/
@@ -336,12 +337,15 @@ sub _check_back_compat {
     my ($self) = @_;
 
 # dynamic schemas will always be in 0.04006 mode
-    if ($self->{dynamic}) {
+    if ($self->dynamic) {
         no strict 'refs';
         my $class = ref $self || $self;
+        require DBIx::Class::Schema::Loader::Compat::v0_040;
         unshift @{"${class}::ISA"},
             'DBIx::Class::Schema::Loader::Compat::v0_040';
         Class::C3::reinitialize;
+# just in case, though no one is likely to dump a dynamic schema
+        $self->version_to_dump('0.04006');
         return;
     }
 
@@ -387,14 +391,26 @@ sub _find_file_in_inc {
     return;
 }
 
-sub _load_external {
+sub _class_path {
     my ($self, $class) = @_;
 
     my $class_path = $class;
     $class_path =~ s{::}{/}g;
     $class_path .= '.pm';
 
-    my $real_inc_path = $self->_find_file_in_inc($class_path);
+    return $class_path;
+}
+
+sub _find_class_in_inc {
+    my ($self, $class) = @_;
+
+    return $self->_find_file_in_inc($self->_class_path($class));
+}
+
+sub _load_external {
+    my ($self, $class) = @_;
+
+    my $real_inc_path = $self->_find_class_in_inc($class);
 
     return if !$real_inc_path;
 
@@ -402,9 +418,6 @@ sub _load_external {
     warn qq/# Loaded external class definition for '$class'\n/
         if $self->debug;
 
-    croak 'Failed to locate actual external module file for '
-          . "'$class'"
-              if !$real_inc_path;
     open(my $fh, '<', $real_inc_path)
         or croak "Failed to open '$real_inc_path' for reading: $!";
     $self->_ext_stmt($class,
@@ -424,6 +437,14 @@ sub _load_external {
     );
     close($fh)
         or croak "Failed to close $real_inc_path: $!";
+
+# load the class too
+    {
+        # turn off redefined warnings
+        $SIG{__WARN__} = sub {};
+        do $real_inc_path;
+    }
+    die $@ if $@;
 }
 
 =head2 load
@@ -506,7 +527,7 @@ sub _load_tables {
         # The relationship loader needs a working schema
         $self->{quiet} = 1;
         local $self->{dump_directory} = $self->{temp_directory};
-        $self->_reload_classes(@tables);
+        $self->_reload_classes(\@tables);
         $self->_load_relationships($_) for @tables;
         $self->{quiet} = 0;
 
@@ -517,7 +538,9 @@ sub _load_tables {
     $self->_load_external($_)
         for map { $self->classes->{$_} } @tables;
 
-    $self->_reload_classes(@tables);
+    # Reload without unloading first to preserve any symbols from external
+    # packages.
+    $self->_reload_classes(\@tables, 0);
 
     # Drop temporary cache
     delete $self->{_cache};
@@ -526,7 +549,13 @@ sub _load_tables {
 }
 
 sub _reload_classes {
-    my ($self, @tables) = @_;
+    my ($self, $tables, $unload) = @_;
+
+    my @tables = @$tables;
+    $unload = 1 unless defined $unload;
+
+    # so that we don't repeat custom sections
+    @INC = grep $_ ne $self->dump_directory, @INC;
 
     $self->_dump_to_dir(map { $self->classes->{$_} } @tables);
 
@@ -545,7 +574,7 @@ sub _reload_classes {
             local *Class::C3::reinitialize = sub {};
             use warnings;
 
-            Class::Unload->unload($class);
+            Class::Unload->unload($class) if $unload;
             my ($source, $resultset_class);
             if (
                 ($source = $have_source{$moniker})
@@ -553,10 +582,10 @@ sub _reload_classes {
                 && ($resultset_class ne 'DBIx::Class::ResultSet')
             ) {
                 my $has_file = Class::Inspector->loaded_filename($resultset_class);
-                Class::Unload->unload($resultset_class);
-                $self->ensure_class_loaded($resultset_class) if $has_file;
+                Class::Unload->unload($resultset_class) if $unload;
+                $self->_reload_class($resultset_class) if $has_file;
             }
-            $self->ensure_class_loaded($class);
+            $self->_reload_class($class);
         }
         push @to_register, [$moniker, $class];
     }
@@ -567,6 +596,16 @@ sub _reload_classes {
     }
 }
 
+# We use this instead of ensure_class_loaded when there are package symbols we
+# want to preserve.
+sub _reload_class {
+    my ($self, $class) = @_;
+
+    my $class_path = $self->_class_path($class);
+    delete $INC{ $class_path };
+    eval "require $class;";
+}
+
 sub _get_dump_filename {
     my ($self, $class) = (@_);
 
@@ -1012,6 +1051,15 @@ names, as above in L</monikers>.
 
 L<DBIx::Class::Schema::Loader>
 
+=head1 AUTHOR
+
+See L<DBIx::Class::Schema::Loader/CONTRIBUTORS>.
+
+=head1 LICENSE
+
+This library is free software; you can redistribute it and/or modify it under
+the same terms as Perl itself.
+
 =cut
 
 1;