Merge 'current' into 'back-compat'
[dbsrgits/DBIx-Class-Schema-Loader.git] / lib / DBIx / Class / Schema / Loader / Base.pm
index b0cba0c..e8ee87b 100644 (file)
@@ -16,7 +16,7 @@ use File::Temp qw//;
 use Class::Unload;
 require DBIx::Class;
 
-our $VERSION = '0.04999_10';
+our $VERSION = '0.04999_11';
 
 __PACKAGE__->mk_ro_accessors(qw/
                                 schema
@@ -48,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.
@@ -73,6 +78,55 @@ L<DBIx::Class::Schema::Loader/loader_options>.  Available constructor options ar
 Skip setting up relationships.  The default is to attempt the loading
 of relationships.
 
+=head2 naming
+
+Static schemas (ones dumped to disk) will, by default, use the new-style 0.05XXX
+relationship names and singularized Results, unless you're overwriting an
+existing dump made by a 0.04XXX version of L<DBIx::Class::Schema::Loader>, in
+which case the backward compatible RelBuilder will be activated, and
+singularization will be turned off.
+
+Specifying
+
+    naming => 'v5'
+
+will disable the backward-compatible RelBuilder and use
+the new-style relationship names along with singularized Results, even when
+overwriting a dump made with an earlier version.
+
+The option also takes a hashref:
+
+    naming => { relationships => 'v5', results => 'v4' }
+
+The values can be:
+
+=over 4
+
+=item current
+
+Latest default style, whatever that happens to be.
+
+=item v5
+
+Version 0.05XXX style.
+
+=item v4
+
+Version 0.04XXX style.
+
+=back
+
+Dynamic schemas will always default to the 0.04XXX relationship names and won't
+singularize Results for backward compatibility, to activate the new RelBuilder
+and singularization put this in your C<Schema.pm> file:
+
+    __PACKAGE__->naming('current');
+
+Or if you prefer to use 0.05XXX features but insure that nothing breaks in the
+next major version upgrade:
+
+    __PACKAGE__->naming('v5');
+
 =head2 debug
 
 If set to true, each constructive L<DBIx::Class> statement the loader
@@ -272,13 +326,58 @@ sub new {
 
     $self->{dump_directory} ||= $self->{temp_directory};
 
-    $self->{relbuilder} = DBIx::Class::Schema::Loader::RelBuilder->new(
-        $self->schema, $self->inflect_plural, $self->inflect_singular
-    ) if !$self->{skip_relationships};
+    $self->version_to_dump($DBIx::Class::Schema::Loader::VERSION);
+
+    $self->_check_back_compat;
 
     $self;
 }
 
+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;
+
+    open(my $fh, '<', $filename)
+        or croak "Cannot open '$filename' for reading: $!";
+
+    while (<$fh>) {
+        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;
+            }
+            last;
+        }
+    }
+    close $fh;
+}
+
 sub _find_file_in_inc {
     my ($self, $file) = @_;
 
@@ -292,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;
 
@@ -307,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,
@@ -329,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
@@ -362,7 +478,7 @@ sub rescan {
     my ($self, $schema) = @_;
 
     $self->{schema} = $schema;
-    $self->{relbuilder}{schema} = $schema;
+    $self->_relbuilder->{schema} = $schema;
 
     my @created;
     my @current = $self->_tables_list;
@@ -377,6 +493,16 @@ sub rescan {
     return map { $self->monikers->{$_} } @$loaded;
 }
 
+sub _relbuilder {
+    my ($self) = @_;
+
+    return if $self->{skip_relationships};
+
+    $self->{relbuilder} ||= DBIx::Class::Schema::Loader::RelBuilder->new(
+        $self->schema, $self->inflect_plural, $self->inflect_singular
+    );
+}
+
 sub _load_tables {
     my ($self, @tables) = @_;
 
@@ -401,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;
 
@@ -412,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};
@@ -421,7 +549,10 @@ 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;
@@ -443,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})
@@ -451,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];
     }
@@ -465,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) = (@_);
 
@@ -580,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)
     );
 
@@ -821,7 +962,7 @@ sub _load_relationships {
     my $tbl_uniq_info = $self->_table_uniq_info($table);
 
     my $local_moniker = $self->monikers->{$table};
-    my $rel_stmts = $self->{relbuilder}->generate_code($local_moniker, $tbl_fk_info, $tbl_uniq_info);
+    my $rel_stmts = $self->_relbuilder->generate_code($local_moniker, $tbl_fk_info, $tbl_uniq_info);
 
     foreach my $src_class (sort keys %$rel_stmts) {
         my $src_stmts = $rel_stmts->{$src_class};