X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FSchema.pm;h=dbe4cbe171c03c838a2695810750069ae1b8df3d;hb=76031e147d6f0d80ab3ec73a12d373962ade1252;hp=578935d0a837697480b65dc9db09e04c2b255a8e;hpb=a4367b26b7b086d368880cd4d822eb4fb34603e7;p=dbsrgits%2FDBIx-Class.git

diff --git a/lib/DBIx/Class/Schema.pm b/lib/DBIx/Class/Schema.pm
index 578935d..dbe4cbe 100644
--- a/lib/DBIx/Class/Schema.pm
+++ b/lib/DBIx/Class/Schema.pm
@@ -6,7 +6,7 @@ use warnings;
 use DBIx::Class::Exception;
 use DBIx::Class::Carp;
 use Try::Tiny;
-use Scalar::Util 'weaken';
+use Scalar::Util qw/weaken blessed/;
 use Sub::Name 'subname';
 use B 'svref_2object';
 use DBIx::Class::GlobalDestruction;
@@ -1035,18 +1035,33 @@ sub clone {
   };
   bless $clone, (ref $self || $self);
 
-  $clone->class_mappings({ %{$clone->class_mappings} });
-  $clone->source_registrations({ %{$clone->source_registrations} });
-  foreach my $moniker ($self->sources) {
-    my $source = $self->source($moniker);
+  $clone->$_(undef) for qw/class_mappings source_registrations storage/;
+
+  $clone->_copy_state_from($self);
+
+  return $clone;
+}
+
+# Needed in Schema::Loader - if you refactor, please make a compatibility shim
+# -- Caelum
+sub _copy_state_from {
+  my ($self, $from) = @_;
+
+  $self->class_mappings({ %{$from->class_mappings} });
+  $self->source_registrations({ %{$from->source_registrations} });
+
+  foreach my $moniker ($from->sources) {
+    my $source = $from->source($moniker);
     my $new = $source->new($source);
     # we use extra here as we want to leave the class_mappings as they are
     # but overwrite the source_registrations entry with the new source
-    $clone->register_extra_source($moniker => $new);
+    $self->register_extra_source($moniker => $new);
   }
-  $clone->storage->set_schema($clone) if $clone->storage;
 
-  return $clone;
+  if ($from->storage) {
+    $self->storage($from->storage);
+    $self->storage->set_schema($self);
+  }
 }
 
 =head2 throw_exception
@@ -1207,12 +1222,12 @@ sub ddl_filename {
 
   require File::Spec;
 
-  my $filename = ref($self);
-  $filename =~ s/::/-/g;
-  $filename = File::Spec->catfile($dir, "$filename-$version-$type.sql");
-  $filename =~ s/$version/$preversion-$version/ if($preversion);
+  $version = "$preversion-$version" if $preversion;
+
+  my $class = blessed($self) || $self;
+  $class =~ s/::/-/g;
 
-  return $filename;
+  return File::Spec->catfile($dir, "$class-$version-$type.sql");
 }
 
 =head2 thaw