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