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 de54546..e1387e9 100644 (file)
--- a/lib/DBIx/Class/Schema/Loader/Base.pm
+++ b/lib/DBIx/Class/Schema/Loader/Base.pm
@@ -33,7 +33,6 @@ __PACKAGE__->mk_ro_accessors(qw/
                                 moniker_map
                                 inflect_singular
                                 inflect_plural
-                                naming
                                 debug
                                 dump_directory
                                 dump_overwrite
@@ -49,8 +48,13 @@ __PACKAGE__->mk_ro_accessors(qw/
                                 _tables
                                 classes
                                 monikers
+                                dynamic
                              /);
 
+__PACKAGE__->mk_accessors(qw/
+                                version_to_dump
+/);
+
 =head1 NAME
 
 DBIx::Class::Schema::Loader::Base - Base DBIx::Class::Schema::Loader Implementation.
@@ -322,6 +326,8 @@ sub new {
 
     $self->{dump_directory} ||= $self->{temp_directory};
 
+    $self->version_to_dump($DBIx::Class::Schema::Loader::VERSION);
+
     $self->_check_back_compat;
 
     $self;
@@ -330,6 +336,20 @@ sub new {
 sub _check_back_compat {
     my ($self) = @_;
 
+# dynamic schemas will always be in 0.04006 mode
+    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;
+    }
+
+# otherwise check if we need backcompat mode for a static schema
     my $filename = $self->_get_dump_filename($self->schema_class);
     return unless -e $filename;
 
@@ -337,14 +357,17 @@ sub _check_back_compat {
         or croak "Cannot open '$filename' for reading: $!";
 
     while (<$fh>) {
-        if (/^# Created by DBIx::Class::Schema::Loader (v\d+)\.(\d+)/) {
-            my $ver = "${1}_${2}";
+        if (/^# Created by DBIx::Class::Schema::Loader v((\d+)\.(\d+))/) {
+            my $real_ver = $1;
+            my $ver      = "v${2}_${3}";
             while (1) {
                 my $compat_class = "DBIx::Class::Schema::Loader::Compat::${ver}";
                 if ($self->load_optional_class($compat_class)) {
                     no strict 'refs';
                     my $class = ref $self || $self;
                     unshift @{"${class}::ISA"}, $compat_class;
+                    Class::C3::reinitialize;
+                    $self->version_to_dump($real_ver);
                     last;
                 }
                 $ver =~ s/\d\z// or last;
@@ -368,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;
 
@@ -383,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,
@@ -405,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
@@ -487,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;
 
@@ -498,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};
@@ -507,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);
 
@@ -526,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})
@@ -534,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];
     }
@@ -548,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) = (@_);
 
@@ -663,7 +721,7 @@ sub _write_classfile {
     }
 
     $text .= $self->_sig_comment(
-      $DBIx::Class::Schema::Loader::VERSION, 
+      $self->version_to_dump,
       POSIX::strftime('%Y-%m-%d %H:%M:%S', localtime)
     );
 
@@ -993,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;