X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=dbsrgits%2FDBIx-Class.git;a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FResultSourceProxy.pm;h=b8f0082580c16d2a23de21e0d137036cf66f41f4;hp=cd18d2e3ed6f0263eda66f9b2b17116f533554fc;hb=28ef9468343a356954f0e4dc6bba1b834a8b3c3c;hpb=09d8fb4a05e6cd025924cc08e41484f17a116695

diff --git a/lib/DBIx/Class/ResultSourceProxy.pm b/lib/DBIx/Class/ResultSourceProxy.pm
index cd18d2e..b8f0082 100644
--- a/lib/DBIx/Class/ResultSourceProxy.pm
+++ b/lib/DBIx/Class/ResultSourceProxy.pm
@@ -6,12 +6,25 @@ use warnings;
 
 use base 'DBIx::Class';
 
+# ! LOAD ORDER SENSITIVE !
 # needs to be loaded early to query method attributes below
+# and to do the around()s properly
 use DBIx::Class::ResultSource;
+my @wrap_rsrc_methods = qw(
+  add_columns
+  add_relationship
+);
 
-use DBIx::Class::_Util qw( quote_sub fail_on_internal_call );
+use DBIx::Class::_Util qw(
+  quote_sub perlstring fail_on_internal_call describe_class_methods
+);
 use namespace::clean;
 
+# FIXME: this is truly bizarre, not sure why it is this way since 93405cf0
+# This value *IS* *DIFFERENT* from source_name in the underlying rsrc
+# instance, and there is *ZERO EFFORT* made to synchronize them...
+# FIXME: Due to the above marking this as a rsrc_proxy method is also out
+# of the question...
 __PACKAGE__->mk_group_accessors('inherited_ro_instance' => 'source_name');
 
 sub get_inherited_ro_instance { $_[0]->get_inherited($_[1]) }
@@ -23,10 +36,11 @@ sub set_inherited_ro_instance {
   $_[0]->set_inherited( $_[1], $_[2] );
 }
 
-
-sub add_columns {
+sub add_columns :DBIC_method_is_bypassable_resultsource_proxy {
   my ($class, @cols) = @_;
   my $source = $class->result_source;
+  local $source->{__callstack_includes_rsrc_proxy_method} = "add_columns";
+
   $source->add_columns(@cols);
 
   my $colinfos;
@@ -46,10 +60,11 @@ sub add_column :DBIC_method_is_indirect_sugar {
   shift->add_columns(@_)
 }
 
-
-sub add_relationship {
+sub add_relationship :DBIC_method_is_bypassable_resultsource_proxy {
   my ($class, $rel, @rest) = @_;
   my $source = $class->result_source;
+  local $source->{__callstack_includes_rsrc_proxy_method} = "add_relationship";
+
   $source->add_relationship($rel => @rest);
   $class->register_relationship($rel => $source->relationship_info($rel));
 }
@@ -92,18 +107,272 @@ for my $method_to_proxy (qw/
   relationship_info
   has_relationship
 /) {
+  my $qsub_opts = { attributes => [
+    do {
+      no strict 'refs';
+      attributes::get( \&{"DBIx::Class::ResultSource::$method_to_proxy"} );
+    }
+  ] };
 
-  my $qsub_opts = { attributes => [ do {
-    no strict 'refs';
-    attributes::get( \&{"DBIx::Class::ResultSource::$method_to_proxy"} )
-  } ] };
+  # bypassable default for backcompat, except for indirect methods
+  # ( those will simply warn during the sanheck )
+  if(! grep
+    { $_ eq 'DBIC_method_is_indirect_sugar' }
+    @{ $qsub_opts->{attributes} }
+  ) {
+    push @wrap_rsrc_methods, $method_to_proxy;
+    push @{ $qsub_opts->{atributes} }, 'DBIC_method_is_bypassable_resultsource_proxy';
+  }
 
   quote_sub __PACKAGE__."::$method_to_proxy", sprintf( <<'EOC', $method_to_proxy ), {}, $qsub_opts;
     DBIx::Class::_ENV_::ASSERT_NO_INTERNAL_INDIRECT_CALLS and DBIx::Class::_Util::fail_on_internal_call;
 
-    shift->result_source->%s (@_);
+    my $rsrc = shift->result_source;
+    local $rsrc->{__callstack_includes_rsrc_proxy_method} = q(%1$s);
+    $rsrc->%1$s (@_);
+EOC
+
+}
+
+# This is where the "magic" of detecting/invoking the proper overridden
+# Result method takes place. It isn't implemented as a stateless out-of-band
+# SanityCheck as invocation requires certain state in the $rsrc object itself
+# in order not to loop over itself. It is not in ResultSource.pm either
+# because of load order and because the entire stack is just terrible :/
+#
+# The code is not easily readable, as it it optimized for execution time
+# (this stuff will be run all the time across the entire install base :/ )
+#
+{
+  our %__rsrc_proxy_meta_cache;
+
+  sub DBIx::Class::__RsrcProxy_iThreads_handler__::CLONE {
+    # recreating this cache is pretty cheap: just blow it away
+    %__rsrc_proxy_meta_cache = ();
+  }
+
+  for my $method_to_wrap (@wrap_rsrc_methods) {
+
+    my @src_args = (
+      perlstring $method_to_wrap,
+    );
+
+    my $orig = do {
+      no strict 'refs';
+      \&{"DBIx::Class::ResultSource::$method_to_wrap"}
+    };
+
+    my %unclassified_override_warn_emitted;
+
+    my @qsub_args = (
+      {
+        # ref to hashref, this is how S::Q works
+        '$rsrc_proxy_meta_cache' => \\%__rsrc_proxy_meta_cache,
+        '$unclassified_override_warn_emitted' => \\%unclassified_override_warn_emitted,
+        '$orig' => \$orig,
+      },
+      { attributes => [ attributes::get($orig) ] }
+    );
+
+    quote_sub "DBIx::Class::ResultSource::$method_to_wrap", sprintf( <<'EOC', @src_args ), @qsub_args;
+
+      my $overridden_proxy_cref;
+
+      # fall through except when...
+      return &$orig unless (
+
+        # FIXME - this may be necessary some day, but skip the hit for now
+        # Scalar::Util::reftype $_[0] eq 'HASH'
+        #   and
+
+        # there is a class to check in the first place
+        defined $_[0]->{result_class}
+
+          and
+        # we are not in a reinvoked callstack
+        (
+          ( $_[0]->{__callstack_includes_rsrc_proxy_method} || '' )
+            ne
+          %1$s
+        )
+
+          and
+        # there is a proxied method in the first place
+        (
+          ( $rsrc_proxy_meta_cache->{address}{%1$s} ||= 0 + (
+            DBIx::Class::ResultSourceProxy->can(%1$s)
+              ||
+            -1
+          ) )
+            >
+          0
+        )
+
+          and
+        # the proxied method *is overridden*
+        (
+          $rsrc_proxy_meta_cache->{address}{%1$s}
+            !=
+          # the can() should not be able to fail in theory, but the
+          # result class may not inherit from ::Core *at all*
+          # hence we simply ||ourselves to paper over this eventuality
+          (
+            ( $overridden_proxy_cref = $_[0]->{result_class}->can(%1$s) )
+              ||
+            $rsrc_proxy_meta_cache->{address}{%1$s}
+          )
+        )
+
+          and
+        # no short-circuiting atributes
+        (! grep
+          {
+            # checking that:
+            #
+            # - Override is not something DBIC plastered on top of things
+            #   One would think this is crazy, yet there it is... sigh:
+            #   https://metacpan.org/source/KARMAN/DBIx-Class-RDBOHelpers-0.12/t/lib/MyDBIC/Schema/Cd.pm#L26-27
+            #
+            # - And is not an m2m crapfest
+            #
+            # - And is not something marked as bypassable
+
+            $_ =~ / ^ DBIC_method_is_ (?:
+              generated_from_resultsource_metadata
+                |
+              m2m_ (?: extra_)? sugar (?:_with_attrs)?
+                |
+              bypassable_resultsource_proxy
+            ) $ /x
+          }
+          keys %%{ $rsrc_proxy_meta_cache->{attrs}{$overridden_proxy_cref} ||= {
+            map { $_ => 1 } attributes::get($overridden_proxy_cref)
+          }}
+        )
+      );
+
+      # Getting this far means that there *is* an override
+      # and it is *not* marked for a skip
+
+      # we were asked to loop back through the Result override
+      if (
+        $rsrc_proxy_meta_cache->{attrs}
+                                 {$overridden_proxy_cref}
+                                  {DBIC_method_is_mandatory_resultsource_proxy}
+      ) {
+        local $_[0]->{__callstack_includes_rsrc_proxy_method} = %1$s;
+
+        # replace $self without compromising aliasing
+        splice @_, 0, 1, $_[0]->{result_class};
+
+        return &$overridden_proxy_cref;
+      }
+      # complain (sparsely) and carry on
+      else {
+
+        # FIXME!!! - terrible, need to swap for something saner later
+        my ($cs) = DBIx::Class::Carp::__find_caller( __PACKAGE__ );
+
+        my $key = $cs . $overridden_proxy_cref;
+
+        unless( $unclassified_override_warn_emitted->{$key} ) {
+
+          # find the real origin
+          my @meth_stack = @{ DBIx::Class::_Util::describe_class_methods(
+            ref $_[0]->{result_class} || $_[0]->{result_class}
+          )->{methods}{%1$s} };
+
+          my $in_class = (shift @meth_stack)->{via_class};
+
+          my $possible_supers;
+          while (
+            @meth_stack
+              and
+            $meth_stack[0]{via_class} ne __PACKAGE__
+          ) {
+            push @$possible_supers, (shift @meth_stack)->{via_class};
+          }
+
+          $possible_supers = $possible_supers
+            ? sprintf(
+              ' ( and possible SUPERs: %%s )',
+              join ', ', map
+                { join '::', $_, %1$s }
+                @$possible_supers
+            )
+            : ''
+          ;
+
+          my $fqmeth = $in_class . '::' . %1$s . '()';
+
+          DBIx::Class::_Util::emit_loud_diag(
+          # Repurpose the assertion envvar ( the override-check is independent
+          # from the schema san-checker, but the spirit is the same )
+            confess => $ENV{DBIC_ASSERT_NO_FAILING_SANITY_CHECKS},
+            msg =>
+              "The override method $fqmeth$possible_supers has been bypassed "
+            . "$cs\n"
+            . "In order to silence this warning you must tag the "
+            . "definition of $fqmeth with one of the attributes "
+            . "':DBIC_method_is_bypassable_resultsource_proxy' or "
+            . "':DBIC_method_is_mandatory_resultsource_proxy' ( see "
+            . "https://is.gd/dbic_rsrcproxy_methodattr for more info )\n"
+          );
+
+          # only set if we didn't throw
+          $unclassified_override_warn_emitted->{$key} = 1;
+        }
+
+        return &$orig;
+      }
 EOC
 
+  }
+
+  Class::C3->reinitialize() if DBIx::Class::_ENV_::OLD_MRO;
+}
+
+# CI sanity check that all annotations make sense
+if(
+  DBIx::Class::_ENV_::ASSERT_NO_ERRONEOUS_METAINSTANCE_USE
+    and
+  # no point taxing 5.8 with this
+  ! DBIx::Class::_ENV_::OLD_MRO
+) {
+
+  my ( $rsrc_methods, $rsrc_proxy_methods, $base_methods ) = map {
+    describe_class_methods($_)->{methods}
+  } qw(
+    DBIx::Class::ResultSource
+    DBIx::Class::ResultSourceProxy
+    DBIx::Class
+  );
+
+  delete $rsrc_methods->{$_}, delete $rsrc_proxy_methods->{$_}
+    for keys %$base_methods;
+
+  (
+    $rsrc_methods->{$_}
+      and
+    ! $rsrc_proxy_methods->{$_}[0]{attributes}{DBIC_method_is_indirect_sugar}
+  )
+    or
+  delete $rsrc_proxy_methods->{$_}
+    for keys %$rsrc_proxy_methods;
+
+  # see fat FIXME at top of file
+  delete @{$rsrc_proxy_methods}{qw( source_name _source_name_accessor )};
+
+  if (
+    ( my $proxied = join "\n", map "\t$_", sort keys %$rsrc_proxy_methods )
+      ne
+    ( my $wrapped = join "\n", map "\t$_", sort @wrap_rsrc_methods )
+  ) {
+    Carp::confess(
+      "Unexpected mismatch between the list of proxied methods:\n\n$proxied"
+    . "\n\nand the list of wrapped rsrc methods:\n\n$wrapped\n\n"
+    );
+  }
 }
 
 1;