X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FSchema.pm;h=3e9d93e7b683a1a961e0fba934f73efbb2999ef4;hb=5b0b4df82267d761f34c606a1f97b6950a2eed4a;hp=05a1b28cae3d653220ea3c6cb6e345c8cb8377d1;hpb=87d4dd9d4a9961d87577dbd1cc227e7765d42945;p=dbsrgits%2FDBIx-Class.git

diff --git a/lib/DBIx/Class/Schema.pm b/lib/DBIx/Class/Schema.pm
index 05a1b28..3e9d93e 100644
--- a/lib/DBIx/Class/Schema.pm
+++ b/lib/DBIx/Class/Schema.pm
@@ -7,6 +7,7 @@ use DBIx::Class::Exception;
 use Carp::Clan qw/^DBIx::Class/;
 use Scalar::Util qw/weaken/;
 use File::Spec;
+use Sub::Name ();
 require Module::Find;
 
 use base qw/DBIx::Class/;
@@ -62,29 +63,6 @@ particular which module inherits off which.
 
 =head1 METHODS
 
-=head2 schema_version
-
-Returns the current schema class' $VERSION
-
-=cut
-
-sub schema_version {
-  my ($self) = @_;
-  my $class = ref($self)||$self;
-
-  # does -not- use $schema->VERSION
-  # since that varies in results depending on if version.pm is installed, and if
-  # so the perl or XS versions. If you want this to change, bug the version.pm
-  # author to make vpp and vxs behave the same.
-
-  my $version;
-  {
-    no strict 'refs';
-    $version = ${"${class}::VERSION"};
-  }
-  return $version;
-}
-
 =head2 register_class
 
 =over 4
@@ -119,7 +97,32 @@ moniker.
 =cut
 
 sub register_source {
-  my ($self, $moniker, $source) = @_;
+  my $self = shift;
+
+  $self->_register_source(@_);
+}
+
+=head2 register_extra_source
+
+=over 4
+
+=item Arguments: $moniker, $result_source
+
+=back
+
+As L</register_source> but should be used if the result class already 
+has a source and you want to register an extra one.
+
+=cut
+
+sub register_extra_source {
+  my $self = shift;
+
+  $self->_register_source(@_, { extra => 1 });
+}
+
+sub _register_source {
+  my ($self, $moniker, $source, $params) = @_;
 
   %$source = %{ $source->new( { %$source, source_name => $moniker }) };
 
@@ -128,10 +131,14 @@ sub register_source {
   $self->source_registrations(\%reg);
 
   $source->schema($self);
-
   weaken($source->{schema}) if ref($self);
+  return if ($params->{extra});
+
   if ($source->result_class) {
     my %map = %{$self->class_mappings};
+    if (exists $map{$source->result_class}) {
+      warn $source->result_class . ' already has a source, use register_extra_source for additional sources';
+    }
     $map{$source->result_class} = $moniker;
     $self->class_mappings(\%map);
   }
@@ -558,7 +565,8 @@ more information.
     my $schema = $self->compose_namespace($target, $base);
     {
       no strict 'refs';
-      *{"${target}::schema"} = sub { $schema };
+      my $name = join '::', $target, 'schema';
+      *$name = Sub::Name::subname $name, sub { $schema };
     }
   
     $schema->connection(@info);
@@ -607,12 +615,31 @@ will produce the output
 
 =cut
 
+# this might be oversimplified
+# sub compose_namespace {
+#   my ($self, $target, $base) = @_;
+
+#   my $schema = $self->clone;
+#   foreach my $moniker ($schema->sources) {
+#     my $source = $schema->source($moniker);
+#     my $target_class = "${target}::${moniker}";
+#     $self->inject_base(
+#       $target_class => $source->result_class, ($base ? $base : ())
+#     );
+#     $source->result_class($target_class);
+#     $target_class->result_source_instance($source)
+#       if $target_class->can('result_source_instance');
+#     $schema->register_source($moniker, $source);
+#   }
+#   return $schema;
+# }
+
 sub compose_namespace {
   my ($self, $target, $base) = @_;
   my $schema = $self->clone;
   {
     no warnings qw/redefine/;
-    local *Class::C3::reinitialize = sub { };
+#    local *Class::C3::reinitialize = sub { };
     foreach my $moniker ($schema->sources) {
       my $source = $schema->source($moniker);
       my $target_class = "${target}::${moniker}";
@@ -622,9 +649,10 @@ sub compose_namespace {
       $source->result_class($target_class);
       $target_class->result_source_instance($source)
         if $target_class->can('result_source_instance');
+     $schema->register_source($moniker, $source);
     }
   }
-  Class::C3->reinitialize();
+#  Class::C3->reinitialize();
   {
     no strict 'refs';
     no warnings 'redefine';
@@ -765,9 +793,10 @@ sub txn_do {
   $self->storage->txn_do(@_);
 }
 
-=head2 txn_scope_guard
+=head2 txn_scope_guard (EXPERIMENTAL)
 
-Runs C<txn_scope_guard> on the schema's storage.
+Runs C<txn_scope_guard> on the schema's storage. See 
+L<DBIx::Class::Storage/txn_scope_guard>.
 
 =cut
 
@@ -900,10 +929,14 @@ sub clone {
   my $clone = { (ref $self ? %$self : ()) };
   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);
     my $new = $source->new($source);
-    $clone->register_source($moniker => $new);
+    # 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);
   }
   $clone->storage->set_schema($clone) if $clone->storage;
   return $clone;
@@ -1145,7 +1178,7 @@ sub create_ddl_dir {
   $self->storage->create_ddl_dir($self, @_);
 }
 
-=head2 ddl_filename (EXPERIMENTAL)
+=head2 ddl_filename
 
 =over 4
 
@@ -1222,6 +1255,29 @@ sub dclone {
   return Storable::dclone($obj);
 }
 
+=head2 schema_version
+
+Returns the current schema class' $VERSION
+
+=cut
+
+sub schema_version {
+  my ($self) = @_;
+  my $class = ref($self)||$self;
+
+  # does -not- use $schema->VERSION
+  # since that varies in results depending on if version.pm is installed, and if
+  # so the perl or XS versions. If you want this to change, bug the version.pm
+  # author to make vpp and vxs behave the same.
+
+  my $version;
+  {
+    no strict 'refs';
+    $version = ${"${class}::VERSION"};
+  }
+  return $version;
+}
+
 1;
 
 =head1 AUTHORS