From: Peter Rabbitson Date: Tue, 17 May 2016 15:43:30 +0000 (+0200) Subject: Add a few more indirect call guards missed in e5053694 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=d99f2db7432d90469c7b860a865e0c32f1611cec;p=dbsrgits%2FDBIx-Class.git Add a few more indirect call guards missed in e5053694 No notable code changes were required as a result --- diff --git a/lib/DBIx/Class/Relationship/Accessor.pm b/lib/DBIx/Class/Relationship/Accessor.pm index 0dab640..025ab24 100644 --- a/lib/DBIx/Class/Relationship/Accessor.pm +++ b/lib/DBIx/Class/Relationship/Accessor.pm @@ -100,9 +100,18 @@ EOC } elsif ($acc_type eq 'multi') { - quote_sub "${class}::${rel}_rs", "shift->related_resultset( q{$rel} )->search_rs( \@_ )"; - quote_sub "${class}::add_to_${rel}", "shift->create_related( q{$rel} => \@_ )"; + quote_sub "${class}::${rel}_rs", sprintf( <<'EOC', perlstring $rel ); + DBIx::Class::_ENV_::ASSERT_NO_INTERNAL_INDIRECT_CALLS and DBIx::Class::_Util::fail_on_internal_call; + shift->related_resultset(%s)->search_rs( @_ ) +EOC + + quote_sub "${class}::add_to_${rel}", sprintf( <<'EOC', perlstring $rel ); + DBIx::Class::_ENV_::ASSERT_NO_INTERNAL_INDIRECT_CALLS and DBIx::Class::_Util::fail_on_internal_call; + shift->create_related( %s => @_ ); +EOC + quote_sub "${class}::${rel}", sprintf( <<'EOC', perlstring $rel ); + DBIx::Class::_ENV_::ASSERT_NO_INTERNAL_INDIRECT_CALLS and DBIx::Class::_Util::fail_on_internal_call; DBIx::Class::_ENV_::ASSERT_NO_INTERNAL_WANTARRAY and my $sog = DBIx::Class::_Util::fail_on_internal_wantarray; shift->related_resultset(%s)->search( @_ ) EOC diff --git a/lib/DBIx/Class/Relationship/ManyToMany.pm b/lib/DBIx/Class/Relationship/ManyToMany.pm index 1cf6b02..fdfb5dd 100644 --- a/lib/DBIx/Class/Relationship/ManyToMany.pm +++ b/lib/DBIx/Class/Relationship/ManyToMany.pm @@ -5,7 +5,7 @@ use strict; use warnings; use DBIx::Class::Carp; -use DBIx::Class::_Util qw(fail_on_internal_wantarray quote_sub); +use DBIx::Class::_Util qw( quote_sub perlstring ); # FIXME - this souldn't be needed my $cu; @@ -61,12 +61,19 @@ EOW '$carp_unique' => \$cu, }; - quote_sub "${class}::${rs_meth}", sprintf( <<'EOC', $rel, $f_rel ), $qsub_attrs; + quote_sub "${class}::${rs_meth}", sprintf( <<'EOC', map { perlstring $_ } ( "${class}::${meth}", $rel, $f_rel ) ), $qsub_attrs; + + DBIx::Class::_ENV_::ASSERT_NO_INTERNAL_INDIRECT_CALLS + and + # allow nested calls from our ->many_to_many, see comment below + ( (CORE::caller(1))[3] ne %s ) + and + DBIx::Class::_Util::fail_on_internal_call; # this little horror is there replicating a deprecation from # within search_rs() itself - shift->related_resultset( q{%1$s} ) - ->related_resultset( q{%2$s} ) + shift->related_resultset( %s ) + ->related_resultset( %s ) ->search_rs ( undef, ( @_ > 1 and ref $_[-1] eq 'HASH' ) @@ -79,6 +86,7 @@ EOC quote_sub "${class}::${meth}", sprintf( <<'EOC', $rs_meth ); + DBIx::Class::_ENV_::ASSERT_NO_INTERNAL_INDIRECT_CALLS and DBIx::Class::_Util::fail_on_internal_call; DBIx::Class::_ENV_::ASSERT_NO_INTERNAL_WANTARRAY and my $sog = DBIx::Class::_Util::fail_on_internal_wantarray; my $rs = shift->%s( @_ ); diff --git a/lib/DBIx/Class/ResultSource.pm b/lib/DBIx/Class/ResultSource.pm index 6fa12c3..eb56b01 100644 --- a/lib/DBIx/Class/ResultSource.pm +++ b/lib/DBIx/Class/ResultSource.pm @@ -353,7 +353,10 @@ sub add_columns { return $self; } -sub add_column { shift->add_columns(@_); } # DO NOT CHANGE THIS TO GLOB +sub add_column { + DBIx::Class::_ENV_::ASSERT_NO_INTERNAL_INDIRECT_CALLS and fail_on_internal_call; + shift->add_columns(@_) +} =head2 has_column @@ -578,7 +581,6 @@ sub remove_columns { $self->_ordered_columns([ grep { not $to_remove{$_} } @{$self->_ordered_columns} ]); } -# DO NOT CHANGE THIS TO A GLOB sub remove_column { DBIx::Class::_ENV_::ASSERT_NO_INTERNAL_INDIRECT_CALLS and fail_on_internal_call; shift->remove_columns(@_) diff --git a/lib/DBIx/Class/Schema.pm b/lib/DBIx/Class/Schema.pm index c0cba10..fff27dd 100644 --- a/lib/DBIx/Class/Schema.pm +++ b/lib/DBIx/Class/Schema.pm @@ -908,6 +908,7 @@ sub compose_namespace { } } + # Legacy stuff, not inserting INDIRECT assertions quote_sub "${target}::${_}" => "shift->schema->$_(\@_)" for qw(class source resultset); }