X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FSchema.pm;h=d5a8f35832bc3ca135f1f3b2b0b35cdc8b1360ef;hb=f064a2abb15858bb39a141ad50391d4191988d2c;hp=c0cba10c2c4d3651b7debd54f78300821df37b99;hpb=e50536940adf2ebaef907a0c29ae37fbd5ce95b1;p=dbsrgits%2FDBIx-Class.git

diff --git a/lib/DBIx/Class/Schema.pm b/lib/DBIx/Class/Schema.pm
index c0cba10..d5a8f35 100644
--- a/lib/DBIx/Class/Schema.pm
+++ b/lib/DBIx/Class/Schema.pm
@@ -4,7 +4,6 @@ use strict;
 use warnings;
 
 use base 'DBIx::Class';
-use mro 'c3';
 
 use DBIx::Class::Carp;
 use Try::Tiny;
@@ -12,18 +11,22 @@ use Scalar::Util qw/weaken blessed/;
 use DBIx::Class::_Util qw(
   refcount quote_sub scope_guard
   is_exception dbic_internal_try
-  fail_on_internal_call
+  fail_on_internal_call emit_loud_diag
 );
 use Devel::GlobalDestruction;
 use namespace::clean;
 
 __PACKAGE__->mk_group_accessors( inherited => qw( storage exception_action ) );
-__PACKAGE__->mk_classaccessor('class_mappings' => {});
-__PACKAGE__->mk_classaccessor('source_registrations' => {});
 __PACKAGE__->mk_classaccessor('storage_type' => '::DBI');
 __PACKAGE__->mk_classaccessor('stacktrace' => $ENV{DBIC_TRACE} || 0);
 __PACKAGE__->mk_classaccessor('default_resultset_attributes' => {});
 
+# These two should have been private from the start but too late now
+# Undocumented on purpose, hopefully it won't ever be necessary to
+# screw with them
+__PACKAGE__->mk_classaccessor('class_mappings' => {});
+__PACKAGE__->mk_classaccessor('source_registrations' => {});
+
 =head1 NAME
 
 DBIx::Class::Schema - composable schemas
@@ -427,6 +430,30 @@ both types of refs here in order to play nice with your
 Config::[class] or your choice. See
 L<DBIx::Class::Storage::DBI::Replicated> for an example of this.
 
+=head2 default_resultset_attributes
+
+=over 4
+
+=item Arguments: L<\%attrs|DBIx::Class::ResultSet/ATTRIBUTES>
+
+=item Return Value: L<\%attrs|DBIx::Class::ResultSet/ATTRIBUTES>
+
+=item Default value: None
+
+=back
+
+Like L<DBIx::Class::ResultSource/resultset_attributes> stores a collection
+of resultset attributes, to be used as defaults for B<every> ResultSet
+instance schema-wide. The same list of CAVEATS and WARNINGS applies, with
+the extra downside of these defaults being practically inescapable: you will
+B<not> be able to derive a ResultSet instance with these attributes unset.
+
+Example:
+
+   package My::Schema;
+   use base qw/DBIx::Class::Schema/;
+   __PACKAGE__->default_resultset_attributes( { software_limit => 1 } );
+
 =head2 exception_action
 
 =over 4
@@ -588,21 +615,58 @@ source name.
 =cut
 
 sub source {
-  my $self = shift;
+  my ($self, $source_name) = @_;
 
   $self->throw_exception("source() expects a source name")
-    unless @_;
+    unless $source_name;
 
-  my $source_name = shift;
+  my $source_registrations;
 
-  my $sreg = $self->source_registrations;
-  return $sreg->{$source_name} if exists $sreg->{$source_name};
+  my $rsrc =
+    ( $source_registrations = $self->source_registrations )->{$source_name}
+      ||
+    # if we got here, they probably passed a full class name
+    $source_registrations->{ $self->class_mappings->{$source_name} || '' }
+      ||
+    $self->throw_exception( "Can't find source for ${source_name}" )
+  ;
 
-  # if we got here, they probably passed a full class name
-  my $mapped = $self->class_mappings->{$source_name};
-  $self->throw_exception("Can't find source for ${source_name}")
-    unless $mapped && exists $sreg->{$mapped};
-  return $sreg->{$mapped};
+  # DO NOT REMOVE:
+  # We need to prevent alterations of pre-existing $@ due to where this call
+  # sits in the overall stack ( *unless* of course there is an actual error
+  # to report ). set_mro does alter $@ (and yes - it *can* throw an exception)
+  # We do not use local because set_mro *can* throw an actual exception
+  # We do not use a try/catch either, as on one hand it would slow things
+  # down for no reason (we would always rethrow), but also because adding *any*
+  # try/catch block below will segfault various threading tests on older perls
+  # ( which in itself is a FIXME but ENOTIMETODIG )
+  my $old_dollarat = $@;
+
+  no strict 'refs';
+  mro::set_mro($_, 'c3') for
+    grep
+      {
+        # some pseudo-sources do not have a result/resultset yet
+        defined $_
+          and
+        (
+          (
+            ${"${_}::__INITIAL_MRO_UPON_DBIC_LOAD__"}
+              ||= mro::get_mro($_)
+          )
+            ne
+          'c3'
+        )
+      }
+      map
+        { length ref $_ ? ref $_ : $_ }
+        ( $rsrc, $rsrc->result_class, $rsrc->resultset_class )
+  ;
+
+  # DO NOT REMOVE - see comment above
+  $@ = $old_dollarat;
+
+  $rsrc;
 }
 
 =head2 class
@@ -787,13 +851,13 @@ sub populate {
 
 =item Arguments: @args
 
-=item Return Value: $new_schema
+=item Return Value: $self
 
 =back
 
 Similar to L</connect> except sets the storage object and connection
-data in-place on the Schema class. You should probably be calling
-L</connect> to get a proper Schema object instead.
+data B<in-place> on C<$self>. You should probably be calling
+L</connect> to get a properly L<cloned|/clone> Schema object instead.
 
 =head3 Overloading
 
@@ -893,30 +957,45 @@ sub compose_namespace {
       my $target_class = "${target}::${source_name}";
       $self->inject_base($target_class, $orig_source->result_class, ($base || ()) );
 
-      # register_source examines result_class, and then returns us a clone
-      my $new_source = $schema->register_source($source_name, bless
-        { %$orig_source, result_class => $target_class },
-        ref $orig_source,
+      $schema->register_source(
+        $source_name,
+        $orig_source->clone(
+          result_class => $target_class
+        ),
       );
-
-      if ($target_class->can('result_source_instance')) {
-        # give the class a schema-less source copy
-        $target_class->result_source_instance( bless
-          { %$new_source, schema => ref $new_source->{schema} || $new_source->{schema} },
-          ref $new_source,
-        );
-      }
     }
 
+    # Legacy stuff, not inserting INDIRECT assertions
     quote_sub "${target}::${_}" => "shift->schema->$_(\@_)"
       for qw(class source resultset);
   }
 
   Class::C3->reinitialize() if DBIx::Class::_ENV_::OLD_MRO;
 
+  # Give each composed class yet another *schema-less* source copy
+  # this is used for the freeze/thaw cycle
+  #
+  # This is not covered by any tests directly, but is indirectly exercised
+  # in t/cdbi/sweet/08pager by re-setting the schema on an existing object
+  # FIXME - there is likely a much cheaper way to take care of this
+  for my $source_name ($self->sources) {
+
+    my $target_class = "${target}::${source_name}";
+
+    $target_class->result_source_instance(
+      $self->source($source_name)->clone(
+        result_class => $target_class,
+        schema => ( ref $schema || $schema ),
+      )
+    );
+  }
+
   return $schema;
 }
 
+# LEGACY: The intra-call to this was removed in 66d9ef6b and then
+# the sub was de-documented way later in 249963d4. No way to be sure
+# nothing on darkpan is calling it directly, so keeping as-is
 sub setup_connection_class {
   my ($class, $target, @info) = @_;
   $class->inject_base($target => 'DBIx::Class::DB');
@@ -1015,13 +1094,10 @@ sub _copy_state_from {
   $self->class_mappings({ %{$from->class_mappings} });
   $self->source_registrations({ %{$from->source_registrations} });
 
-  foreach my $source_name ($from->sources) {
-    my $source = $from->source($source_name);
-    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
-    $self->register_extra_source($source_name => $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
+  $self->register_extra_source( $_ => $from->source($_) )
+    for $from->sources;
 
   if ($from->storage) {
     $self->storage($from->storage);
@@ -1057,8 +1133,8 @@ sub throw_exception {
 
     my $guard = scope_guard {
       return if $guard_disarmed;
-      local $SIG{__WARN__};
-      Carp::cluck("
+      emit_loud_diag( emit_dups => 1, msg => "
+
                     !!! DBIx::Class INTERNAL PANIC !!!
 
 The exception_action() handler installed on '$self'
@@ -1071,7 +1147,7 @@ anything for other software that might be affected by a similar problem.
 
                       !!! FIX YOUR ERROR HANDLING !!!
 
-This guard was activated beginning"
+This guard was activated starting",
       );
     };
 
@@ -1378,41 +1454,53 @@ has a source and you want to register an extra one.
 sub register_extra_source { shift->_register_source(@_, { extra => 1 }) }
 
 sub _register_source {
-  my ($self, $source_name, $source, $params) = @_;
+  my ($self, $source_name, $supplied_rsrc, $params) = @_;
+
+  my $derived_rsrc = $supplied_rsrc->clone({
+    source_name => $source_name,
+  });
 
-  $source = $source->new({ %$source, source_name => $source_name });
+  # Do not move into the clone-hashref above: there are things
+  # on CPAN that do hook 'sub schema' </facepalm>
+  # https://metacpan.org/source/LSAUNDERS/DBIx-Class-Preview-1.000003/lib/DBIx/Class/ResultSource/Table/Previewed.pm#L9-38
+  $derived_rsrc->schema($self);
 
-  $source->schema($self);
-  weaken $source->{schema} if ref($self);
+  weaken $derived_rsrc->{schema}
+    if length ref($self);
 
   my %reg = %{$self->source_registrations};
-  $reg{$source_name} = $source;
+  $reg{$source_name} = $derived_rsrc;
   $self->source_registrations(\%reg);
 
-  return $source if $params->{extra};
+  return $derived_rsrc if $params->{extra};
 
-  my $rs_class = $source->result_class;
-  if ($rs_class and my $rsrc = dbic_internal_try { $rs_class->result_source_instance } ) {
+  my( $result_class, $result_class_level_rsrc );
+  if (
+    $result_class = $derived_rsrc->result_class
+      and
+    # There are known cases where $rs_class is *ONLY* an inflator, without
+    # any hint of a rsrc (e.g. DBIx::Class::KiokuDB::EntryProxy)
+    $result_class_level_rsrc = dbic_internal_try { $result_class->result_source_instance }
+  ) {
     my %map = %{$self->class_mappings};
-    if (
-      exists $map{$rs_class}
+
+    carp (
+      "$result_class already had a registered source which was replaced by "
+    . 'this call. Perhaps you wanted register_extra_source(), though it is '
+    . 'more likely you did something wrong.'
+    ) if (
+      exists $map{$result_class}
         and
-      $map{$rs_class} ne $source_name
+      $map{$result_class} ne $source_name
         and
-      $rsrc ne $_[2]  # orig_source
-    ) {
-      carp
-        "$rs_class already had a registered source which was replaced by this call. "
-      . 'Perhaps you wanted register_extra_source(), though it is more likely you did '
-      . 'something wrong.'
-      ;
-    }
+      $result_class_level_rsrc != $supplied_rsrc
+    );
 
-    $map{$rs_class} = $source_name;
+    $map{$result_class} = $source_name;
     $self->class_mappings(\%map);
   }
 
-  return $source;
+  $derived_rsrc;
 }
 
 my $global_phase_destroy;
@@ -1435,7 +1523,7 @@ sub DESTROY {
     # due to some weird race condition during thread joining :(((
     if (length ref $srcs->{$source_name} and refcount($srcs->{$source_name}) > 1) {
       local $SIG{__DIE__} if $SIG{__DIE__};
-      local $@;
+      local $@ if DBIx::Class::_ENV_::UNSTABLE_DOLLARAT;
       eval {
         $srcs->{$source_name}->schema($self);
         weaken $srcs->{$source_name};
@@ -1537,7 +1625,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);
   }