From: Peter Rabbitson <ribasushi@cpan.org>
Date: Fri, 18 Jul 2014 08:42:58 +0000 (+0200)
Subject: Simplify no wantarray assert (a9da9b6a) - fish out args from caller
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=e89c79683fccf5cb93e5215bba92927bf32ef02b;p=dbsrgits%2FDBIx-Class-Historic.git

Simplify no wantarray assert (a9da9b6a) - fish out args from caller
---

diff --git a/lib/DBIx/Class/Relationship/Accessor.pm b/lib/DBIx/Class/Relationship/Accessor.pm
index 3a12f28..fee1621 100644
--- a/lib/DBIx/Class/Relationship/Accessor.pm
+++ b/lib/DBIx/Class/Relationship/Accessor.pm
@@ -82,7 +82,7 @@ sub add_relationship_accessor {
     );
   } elsif ($acc_type eq 'multi') {
     $meth{$rel} = sub {
-      DBIx::Class::_ENV_::ASSERT_NO_INTERNAL_WANTARRAY and wantarray and my $sog = fail_on_internal_wantarray($_[0]);
+      DBIx::Class::_ENV_::ASSERT_NO_INTERNAL_WANTARRAY and my $sog = fail_on_internal_wantarray;
       shift->search_related($rel, @_)
     };
     $meth{"${rel}_rs"} = sub { shift->search_related_rs($rel, @_) };
diff --git a/lib/DBIx/Class/Relationship/ManyToMany.pm b/lib/DBIx/Class/Relationship/ManyToMany.pm
index 8237602..36ec18d 100644
--- a/lib/DBIx/Class/Relationship/ManyToMany.pm
+++ b/lib/DBIx/Class/Relationship/ManyToMany.pm
@@ -71,7 +71,7 @@ EOW
 
     my $meth_name = join '::', $class, $meth;
     *$meth_name = subname $meth_name, sub {
-      DBIx::Class::_ENV_::ASSERT_NO_INTERNAL_WANTARRAY and wantarray and my $sog = fail_on_internal_wantarray($_[0]);
+      DBIx::Class::_ENV_::ASSERT_NO_INTERNAL_WANTARRAY and my $sog = fail_on_internal_wantarray;
       my $self = shift;
       my $rs = $self->$rs_meth( @_ );
       return (wantarray ? $rs->all : $rs);
diff --git a/lib/DBIx/Class/ResultSet.pm b/lib/DBIx/Class/ResultSet.pm
index f71bf38..b21415e 100644
--- a/lib/DBIx/Class/ResultSet.pm
+++ b/lib/DBIx/Class/ResultSet.pm
@@ -389,7 +389,7 @@ sub search {
   my $rs = $self->search_rs( @_ );
 
   if (wantarray) {
-    DBIx::Class::_ENV_::ASSERT_NO_INTERNAL_WANTARRAY and my $sog = fail_on_internal_wantarray($rs);
+    DBIx::Class::_ENV_::ASSERT_NO_INTERNAL_WANTARRAY and my $sog = fail_on_internal_wantarray;
     return $rs->all;
   }
   elsif (defined wantarray) {
diff --git a/lib/DBIx/Class/ResultSetColumn.pm b/lib/DBIx/Class/ResultSetColumn.pm
index 3756dbf..74473e7 100644
--- a/lib/DBIx/Class/ResultSetColumn.pm
+++ b/lib/DBIx/Class/ResultSetColumn.pm
@@ -406,7 +406,7 @@ sub func {
   my $cursor = $self->func_rs($function)->cursor;
 
   if( wantarray ) {
-    DBIx::Class::_ENV_::ASSERT_NO_INTERNAL_WANTARRAY and my $sog = fail_on_internal_wantarray($self);
+    DBIx::Class::_ENV_::ASSERT_NO_INTERNAL_WANTARRAY and my $sog = fail_on_internal_wantarray;
     return map { $_->[ 0 ] } $cursor->all;
   }
 
diff --git a/lib/DBIx/Class/_Util.pm b/lib/DBIx/Class/_Util.pm
index 02de9a6..d43d836 100644
--- a/lib/DBIx/Class/_Util.pm
+++ b/lib/DBIx/Class/_Util.pm
@@ -169,7 +169,7 @@ sub modver_gt_or_eq ($$) {
 {
   my $list_ctx_ok_stack_marker;
 
-  sub fail_on_internal_wantarray {
+  sub fail_on_internal_wantarray () {
     return if $list_ctx_ok_stack_marker;
 
     if (! defined wantarray) {
@@ -192,12 +192,23 @@ sub modver_gt_or_eq ($$) {
       $cf++;
     }
 
+    my ($fr, $want, $argdesc);
+    {
+      package DB;
+      $fr = [ caller($cf) ];
+      $want = ( caller($cf-1) )[5];
+      $argdesc = ref $DB::args[0]
+        ? DBIx::Class::_Util::refdesc($DB::args[0])
+        : 'non '
+      ;
+    };
+
     if (
-      (caller($cf))[0] =~ /^(?:DBIx::Class|DBICx::)/
+      $want and $fr->[0] =~ /^(?:DBIx::Class|DBICx::)/
     ) {
       DBIx::Class::Exception->throw( sprintf (
-        "Improper use of %s instance in list context at %s line %d\n\n\tStacktrace starts",
-        refdesc($_[0]), (caller($cf))[1,2]
+        "Improper use of %s instance in list context at %s line %d\n\n    Stacktrace starts",
+        $argdesc, @{$fr}[1,2]
       ), 'with_stacktrace');
     }