An extra bit of diag on incomplete rsrc re-register

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

diff --git a/lib/DBIx/Class/Schema.pm b/lib/DBIx/Class/Schema.pm
index 153d729..45dcd7e 100644 (file)
--- a/lib/DBIx/Class/Schema.pm
+++ b/lib/DBIx/Class/Schema.pm
@@ -199,7 +199,7 @@ sub _ns_get_rsrc_instance {
   my $rs_class = ref ($_[0]) || $_[0];
 
   return dbic_internal_try {
-    $rs_class->result_source_instance
+    $rs_class->result_source
   } catch {
     $me->throw_exception (
       "Attempt to load_namespaces() class $rs_class failed - are you sure this is a real Result Class?: $_"
@@ -1398,13 +1398,13 @@ file). You may also need it to register classes at runtime.
 Registers a class which isa DBIx::Class::ResultSourceProxy. Equivalent to
 calling:
 
-  $schema->register_source($source_name, $component_class->result_source_instance);
+  $schema->register_source($source_name, $component_class->result_source);
 
 =cut
 
 sub register_class {
   my ($self, $source_name, $to_register) = @_;
-  $self->register_source($source_name => $to_register->result_source_instance);
+  $self->register_source($source_name => $to_register->result_source);
 }
 
 =head2 register_source
@@ -1466,7 +1466,7 @@ sub _register_source {
   $derived_rsrc->schema($self);
 
   weaken $derived_rsrc->{schema}
-    if length ref($self);
+    if length( my $schema_class = ref($self) );
 
   my %reg = %{$self->source_registrations};
   $reg{$source_name} = $derived_rsrc;
@@ -1498,6 +1498,44 @@ sub _register_source {
 
     $map{$result_class} = $source_name;
     $self->class_mappings(\%map);
+
+
+    my $schema_class_level_rsrc;
+    if (
+      # we are called on a schema instance, not on the class
+      length $schema_class
+
+        and
+
+      # the schema class also has a registration with the same name
+      $schema_class_level_rsrc = dbic_internal_try { $schema_class->source($source_name) }
+
+        and
+
+      # what we are registering on the schema instance *IS* derived
+      # from the class-level (top) rsrc...
+      ( grep { $_ == $derived_rsrc } $result_class_level_rsrc->__derived_instances )
+
+        and
+
+      # ... while the schema-class-level has stale-markers
+      keys %{ $schema_class_level_rsrc->{__metadata_divergencies} || {} }
+    ) {
+      my $msg =
+        "The ResultSource instance you just registered on '$self' as "
+      . "'$source_name' seems to have no relation to $schema_class->"
+      . "source('$source_name') which in turn is marked stale (likely due "
+      . "to recent $result_class->... direct class calls). This is almost "
+      . "always a mistake: perhaps you forgot a cycle of "
+      . "$schema_class->unregister_source( '$source_name' ) / "
+      . "$schema_class->register_class( '$source_name' => '$result_class' )"
+      ;
+
+      DBIx::Class::_ENV_::ASSERT_NO_ERRONEOUS_METAINSTANCE_USE
+        ? emit_loud_diag( msg => $msg, confess => 1 )
+        : carp_unique($msg)
+      ;
+    }
   }
 
   $derived_rsrc;
@@ -1625,7 +1663,11 @@ sub compose_connection {
     my $source = $schema->source($source_name);
     my $class = $source->result_class;
     #warn "$source_name $class $source ".$source->storage;
-    $class->mk_classaccessor(result_source_instance => $source);
+
+    $class->mk_group_accessors( inherited => [ result_source_instance => '_result_source' ] );
+    # explicit set-call, avoid mro update lag
+    $class->set_inherited( result_source_instance => $source );
+
     $class->mk_classaccessor(resultset_instance => $source->resultset);
     $class->mk_classaccessor(class_resolver => $schema);
   }