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

package # hide from PAUSE
    DBIx::Class::ResultSourceProxy;

use strict;
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 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...
# FIXME: this used to be a sub-type of inherited ( to see run:
# `git log -Sinherited_ro_instance lib/DBIx/Class/ResultSourceProxy.pm` )
# however given the lack of any sync effort as described above *anyway*,
# it makes no sense to guard for erroneous use at a non-trivial cost in
# performance (and may end up in the way of future optimizations as per
# https://github.com/vovkasm/Class-Accessor-Inherited-XS/issues/2#issuecomment-243246924 )
__PACKAGE__->mk_group_accessors( inherited => 'source_name');

# The marking with indirect_sugar will cause warnings to be issued in darkpan code
# (though extremely unlikely)
sub get_inherited_ro_instance :DBIC_method_is_indirect_sugar {
  DBIx::Class::Exception->throw(
    "The 'inherted_ro_instance' CAG group has been retired - use 'inherited' instead"
  );
}
sub set_inherited_ro_instance :DBIC_method_is_indirect_sugar {
  DBIx::Class::Exception->throw(
    "The 'inherted_ro_instance' CAG group has been retired - use 'inherited' instead"
  );
}

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;
  foreach my $c (grep { !ref } @cols) {
    # If this is an augment definition get the real colname.
    $c =~ s/^\+//;

    $class->register_column(
      $c,
      ( $colinfos ||= $source->columns_info )->{$c}
    );
  }
}

sub add_column :DBIC_method_is_indirect_sugar {
  DBIx::Class::_ENV_::ASSERT_NO_INTERNAL_INDIRECT_CALLS and fail_on_internal_call;
  shift->add_columns(@_)
}

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));
}


# legacy resultset_class accessor, seems to be used by cdbi only
sub iterator_class :DBIC_method_is_indirect_sugar {
  DBIx::Class::_ENV_::ASSERT_NO_INTERNAL_INDIRECT_CALLS and fail_on_internal_call;
  shift->result_source->resultset_class(@_)
}

for my $method_to_proxy (qw/
  source_info
  result_class
  resultset_class
  resultset_attributes

  columns
  has_column

  remove_column
  remove_columns

  column_info
  columns_info
  column_info_from_storage

  set_primary_key
  primary_columns
  sequence

  add_unique_constraint
  add_unique_constraints

  unique_constraints
  unique_constraint_names
  unique_constraint_columns

  relationships
  relationship_info
  has_relationship
/) {
  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;

    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;
Commit	Line	Data
75d07914	1	package # hide from PAUSE
c0e7b4e5	2	DBIx::Class::ResultSourceProxy;
b98e75f6	3
	4	use strict;
	5	use warnings;
	6
8d73fcd4	7	use base 'DBIx::Class';
8d73fcd4	8
28ef9468	9	# ! LOAD ORDER SENSITIVE !
1b822bd3	10	# needs to be loaded early to query method attributes below
28ef9468	11	# and to do the around()s properly
1b822bd3	12	use DBIx::Class::ResultSource;
28ef9468	13	my @wrap_rsrc_methods = qw(
	14	add_columns
	15	add_relationship
	16	);
1b822bd3	17
28ef9468	18	use DBIx::Class::_Util qw(
	19	quote_sub perlstring fail_on_internal_call describe_class_methods
	20	);
a93c65f2	21	use namespace::clean;
b98e75f6	22
28ef9468	23	# FIXME: this is truly bizarre, not sure why it is this way since 93405cf0
	24	# This value IS DIFFERENT from source_name in the underlying rsrc
	25	# instance, and there is ZERO EFFORT made to synchronize them...
	26	# FIXME: Due to the above marking this as a rsrc_proxy method is also out
	27	# of the question...
d2308dde	28	# FIXME: this used to be a sub-type of inherited ( to see run:
	29	# `git log -Sinherited_ro_instance lib/DBIx/Class/ResultSourceProxy.pm` )
	30	# however given the lack of any sync effort as described above anyway,
	31	# it makes no sense to guard for erroneous use at a non-trivial cost in
	32	# performance (and may end up in the way of future optimizations as per
	33	# https://github.com/vovkasm/Class-Accessor-Inherited-XS/issues/2#issuecomment-243246924 )
	34	__PACKAGE__->mk_group_accessors( inherited => 'source_name');
a93c65f2	35
d2308dde	36	# The marking with indirect_sugar will cause warnings to be issued in darkpan code
	37	# (though extremely unlikely)
	38	sub get_inherited_ro_instance :DBIC_method_is_indirect_sugar {
	39	DBIx::Class::Exception->throw(
	40	"The 'inherted_ro_instance' CAG group has been retired - use 'inherited' instead"
	41	);
	42	}
	43	sub set_inherited_ro_instance :DBIC_method_is_indirect_sugar {
	44	DBIx::Class::Exception->throw(
	45	"The 'inherted_ro_instance' CAG group has been retired - use 'inherited' instead"
	46	);
93405cf0	47	}
93405cf0	48
28ef9468	49	sub add_columns :DBIC_method_is_bypassable_resultsource_proxy {
b98e75f6	50	my ($class, @cols) = @_;
e570488a	51	my $source = $class->result_source;
28ef9468	52	local $source->{__callstack_includes_rsrc_proxy_method} = "add_columns";
28ef9468	53
1f23a877	54	$source->add_columns(@cols);
b83736a7	55
b83736a7	56	my $colinfos;
1f23a877	57	foreach my $c (grep { !ref } @cols) {
157ce0cf	58	# If this is an augment definition get the real colname.
	59	$c =~ s/^\+//;
	60
b83736a7	61	$class->register_column(
	62	$c,
	63	( $colinfos \|\|= $source->columns_info )->{$c}
	64	);
1f23a877	65	}
b98e75f6	66	}
b98e75f6	67
1b822bd3	68	sub add_column :DBIC_method_is_indirect_sugar {
e5053694	69	DBIx::Class::_ENV_::ASSERT_NO_INTERNAL_INDIRECT_CALLS and fail_on_internal_call;
	70	shift->add_columns(@_)
	71	}
002a359a	72
28ef9468	73	sub add_relationship :DBIC_method_is_bypassable_resultsource_proxy {
a93c65f2	74	my ($class, $rel, @rest) = @_;
e570488a	75	my $source = $class->result_source;
28ef9468	76	local $source->{__callstack_includes_rsrc_proxy_method} = "add_relationship";
28ef9468	77
a93c65f2	78	$source->add_relationship($rel => @rest);
a93c65f2	79	$class->register_relationship($rel => $source->relationship_info($rel));
bc0c9800	80	}
bc0c9800	81
b98e75f6	82
a93c65f2	83	# legacy resultset_class accessor, seems to be used by cdbi only
1b822bd3	84	sub iterator_class :DBIC_method_is_indirect_sugar {
e5053694	85	DBIx::Class::_ENV_::ASSERT_NO_INTERNAL_INDIRECT_CALLS and fail_on_internal_call;
e570488a	86	shift->result_source->resultset_class(@_)
e5053694	87	}
a83cdbf2	88
a93c65f2	89	for my $method_to_proxy (qw/
	90	source_info
	91	result_class
	92	resultset_class
	93	resultset_attributes
bc0c9800	94
a93c65f2	95	columns
a93c65f2	96	has_column
034d0be4	97
a93c65f2	98	remove_column
a93c65f2	99	remove_columns
87f0da6a	100
a93c65f2	101	column_info
52416317	102	columns_info
a93c65f2	103	column_info_from_storage
1bc0b925	104
a93c65f2	105	set_primary_key
a93c65f2	106	primary_columns
89170201	107	sequence
1bc0b925	108
a93c65f2	109	add_unique_constraint
a93c65f2	110	add_unique_constraints
8c49f629	111
a93c65f2	112	unique_constraints
	113	unique_constraint_names
	114	unique_constraint_columns
8c49f629	115
a93c65f2	116	relationships
	117	relationship_info
	118	has_relationship
	119	/) {
28ef9468	120	my $qsub_opts = { attributes => [
	121	do {
	122	no strict 'refs';
	123	attributes::get( \&{"DBIx::Class::ResultSource::$method_to_proxy"} );
	124	}
	125	] };
1b822bd3	126
28ef9468	127	# bypassable default for backcompat, except for indirect methods
	128	# ( those will simply warn during the sanheck )
	129	if(! grep
	130	{ $_ eq 'DBIC_method_is_indirect_sugar' }
	131	@{ $qsub_opts->{attributes} }
	132	) {
	133	push @wrap_rsrc_methods, $method_to_proxy;
	134	push @{ $qsub_opts->{atributes} }, 'DBIC_method_is_bypassable_resultsource_proxy';
	135	}
1b822bd3	136
1b822bd3	137	quote_sub __PACKAGE__."::$method_to_proxy", sprintf( <<'EOC', $method_to_proxy ), {}, $qsub_opts;
4006691d	138	DBIx::Class::_ENV_::ASSERT_NO_INTERNAL_INDIRECT_CALLS and DBIx::Class::_Util::fail_on_internal_call;
e570488a	139
28ef9468	140	my $rsrc = shift->result_source;
	141	local $rsrc->{__callstack_includes_rsrc_proxy_method} = q(%1$s);
	142	$rsrc->%1$s (@_);
	143	EOC
	144
	145	}
	146
	147	# This is where the "magic" of detecting/invoking the proper overridden
	148	# Result method takes place. It isn't implemented as a stateless out-of-band
	149	# SanityCheck as invocation requires certain state in the $rsrc object itself
	150	# in order not to loop over itself. It is not in ResultSource.pm either
	151	# because of load order and because the entire stack is just terrible :/
	152	#
	153	# The code is not easily readable, as it it optimized for execution time
	154	# (this stuff will be run all the time across the entire install base :/ )
	155	#
	156	{
	157	our %__rsrc_proxy_meta_cache;
	158
	159	sub DBIx::Class::__RsrcProxy_iThreads_handler__::CLONE {
	160	# recreating this cache is pretty cheap: just blow it away
	161	%__rsrc_proxy_meta_cache = ();
	162	}
	163
	164	for my $method_to_wrap (@wrap_rsrc_methods) {
	165
	166	my @src_args = (
	167	perlstring $method_to_wrap,
	168	);
	169
	170	my $orig = do {
	171	no strict 'refs';
	172	\&{"DBIx::Class::ResultSource::$method_to_wrap"}
	173	};
	174
	175	my %unclassified_override_warn_emitted;
	176
	177	my @qsub_args = (
	178	{
	179	# ref to hashref, this is how S::Q works
	180	'$rsrc_proxy_meta_cache' => \\%__rsrc_proxy_meta_cache,
	181	'$unclassified_override_warn_emitted' => \\%unclassified_override_warn_emitted,
	182	'$orig' => \$orig,
	183	},
	184	{ attributes => [ attributes::get($orig) ] }
	185	);
	186
	187	quote_sub "DBIx::Class::ResultSource::$method_to_wrap", sprintf( <<'EOC', @src_args ), @qsub_args;
	188
	189	my $overridden_proxy_cref;
	190
	191	# fall through except when...
	192	return &$orig unless (
	193
	194	# FIXME - this may be necessary some day, but skip the hit for now
	195	# Scalar::Util::reftype $_[0] eq 'HASH'
	196	# and
	197
	198	# there is a class to check in the first place
	199	defined $_[0]->{result_class}
	200
	201	and
	202	# we are not in a reinvoked callstack
	203	(
204	( $_[0]->{__callstack_includes_rsrc_proxy_method} \|\| '' )
205	ne
206	%1$s
207	)
208
209	and
210	# there is a proxied method in the first place
211	(
212	( $rsrc_proxy_meta_cache->{address}{%1$s} \|\|= 0 + (
213	DBIx::Class::ResultSourceProxy->can(%1$s)
214	\|\|
215	-1
216	) )
217	>
218	0
219	)
220
221	and
222	# the proxied method is overridden
223	(
224	$rsrc_proxy_meta_cache->{address}{%1$s}
225	!=
226	# the can() should not be able to fail in theory, but the
227	# result class may not inherit from ::Core at all
228	# hence we simply \|\|ourselves to paper over this eventuality
229	(
230	( $overridden_proxy_cref = $_[0]->{result_class}->can(%1$s) )
231	\|\|
232	$rsrc_proxy_meta_cache->{address}{%1$s}
233	)
234	)
235
236	and
237	# no short-circuiting atributes
238	(! grep
239	{
240	# checking that:
241	#
242	# - Override is not something DBIC plastered on top of things
243	# One would think this is crazy, yet there it is... sigh:
244	# https://metacpan.org/source/KARMAN/DBIx-Class-RDBOHelpers-0.12/t/lib/MyDBIC/Schema/Cd.pm#L26-27
245	#
246	# - And is not an m2m crapfest
247	#
248	# - And is not something marked as bypassable
249
250	$_ =~ / ^ DBIC_method_is_ (?:
251	generated_from_resultsource_metadata
252	\|
253	m2m_ (?: extra_)? sugar (?:_with_attrs)?
254	\|
255	bypassable_resultsource_proxy
256	) $ /x
257	}
258	keys %%{ $rsrc_proxy_meta_cache->{attrs}{$overridden_proxy_cref} \|\|= {
259	map { $_ => 1 } attributes::get($overridden_proxy_cref)
260	}}
261	)
262	);
263
264	# Getting this far means that there is an override
265	# and it is not marked for a skip
266
267	# we were asked to loop back through the Result override
268	if (
269	$rsrc_proxy_meta_cache->{attrs}
270	{$overridden_proxy_cref}
271	{DBIC_method_is_mandatory_resultsource_proxy}
272	) {
273	local $_[0]->{__callstack_includes_rsrc_proxy_method} = %1$s;
274
275	# replace $self without compromising aliasing
276	splice @_, 0, 1, $_[0]->{result_class};
277
278	return &$overridden_proxy_cref;
279	}
280	# complain (sparsely) and carry on
281	else {
282
283	# FIXME!!! - terrible, need to swap for something saner later
284	my ($cs) = DBIx::Class::Carp::__find_caller( __PACKAGE__ );
285
286	my $key = $cs . $overridden_proxy_cref;
287
288	unless( $unclassified_override_warn_emitted->{$key} ) {
289
290	# find the real origin
291	my @meth_stack = @{ DBIx::Class::_Util::describe_class_methods(
292	ref $_[0]->{result_class} \|\| $_[0]->{result_class}
293	)->{methods}{%1$s} };
294
295	my $in_class = (shift @meth_stack)->{via_class};
296
297	my $possible_supers;
298	while (
299	@meth_stack
300	and
301	$meth_stack[0]{via_class} ne __PACKAGE__
302	) {
303	push @$possible_supers, (shift @meth_stack)->{via_class};
304	}
305
306	$possible_supers = $possible_supers
307	? sprintf(
308	' ( and possible SUPERs: %%s )',
309	join ', ', map
310	{ join '::', $_, %1$s }
311	@$possible_supers
312	)
313	: ''
314	;
315
316	my $fqmeth = $in_class . '::' . %1$s . '()';
317
318	DBIx::Class::_Util::emit_loud_diag(
91028369	319
	320	# Repurpose the assertion envvar ( the override-check is independent
	321	# from the schema san-checker, but the spirit is the same )
28ef9468	322	confess => $ENV{DBIC_ASSERT_NO_FAILING_SANITY_CHECKS},
91028369	323
28ef9468	324	msg =>
	325	"The override method $fqmeth$possible_supers has been bypassed "
	326	. "$cs\n"
	327	. "In order to silence this warning you must tag the "
	328	. "definition of $fqmeth with one of the attributes "
	329	. "':DBIC_method_is_bypassable_resultsource_proxy' or "
	330	. "':DBIC_method_is_mandatory_resultsource_proxy' ( see "
	331	. "https://is.gd/dbic_rsrcproxy_methodattr for more info )\n"
	332	);
	333
	334	# only set if we didn't throw
	335	$unclassified_override_warn_emitted->{$key} = 1;
	336	}
	337
	338	return &$orig;
	339	}
4006691d	340	EOC
4006691d	341
28ef9468	342	}
	343
	344	Class::C3->reinitialize() if DBIx::Class::_ENV_::OLD_MRO;
	345	}
	346
	347	# CI sanity check that all annotations make sense
	348	if(
	349	DBIx::Class::_ENV_::ASSERT_NO_ERRONEOUS_METAINSTANCE_USE
	350	and
	351	# no point taxing 5.8 with this
	352	! DBIx::Class::_ENV_::OLD_MRO
	353	) {
	354
	355	my ( $rsrc_methods, $rsrc_proxy_methods, $base_methods ) = map {
	356	describe_class_methods($_)->{methods}
	357	} qw(
	358	DBIx::Class::ResultSource
	359	DBIx::Class::ResultSourceProxy
	360	DBIx::Class
	361	);
	362
	363	delete $rsrc_methods->{$_}, delete $rsrc_proxy_methods->{$_}
	364	for keys %$base_methods;
	365
	366	(
	367	$rsrc_methods->{$_}
	368	and
	369	! $rsrc_proxy_methods->{$_}[0]{attributes}{DBIC_method_is_indirect_sugar}
	370	)
	371	or
	372	delete $rsrc_proxy_methods->{$_}
	373	for keys %$rsrc_proxy_methods;
	374
	375	# see fat FIXME at top of file
	376	delete @{$rsrc_proxy_methods}{qw( source_name _source_name_accessor )};
	377
	378	if (
	379	( my $proxied = join "\n", map "\t$_", sort keys %$rsrc_proxy_methods )
	380	ne
	381	( my $wrapped = join "\n", map "\t$_", sort @wrap_rsrc_methods )
	382	) {
	383	Carp::confess(
	384	"Unexpected mismatch between the list of proxied methods:\n\n$proxied"
	385	. "\n\nand the list of wrapped rsrc methods:\n\n$wrapped\n\n"
	386	);
	387	}
8c49f629	388	}
8c49f629	389
b98e75f6	390	1;