better logic for coderef detection - no more evals

Changes

@@ -4,6 +4,8 @@ Revision history for {{$dist->name}}
           - remove additional options in constructor before passing to
             LWP::UserAgent (was causing a carp when $^W was set) - thanks for
             the report and patch, Nigel Gregoire and Michael Schulthess!
+          - all remaining uses of eval eliminated, by using better heuristics
+            for "can be used as a coderef" logic
 
 0.010     2012-10-06 16:47:33 PDT-0700 (Karen Etheridge)
           - documentation on integration with XML::Compile::SOAP

lib/Test/LWP/UserAgent.pm

@@ -5,7 +5,7 @@ use strict;
 use warnings;
 
 use parent 'LWP::UserAgent';
-use Scalar::Util 'blessed';
+use Scalar::Util qw(blessed reftype);
 use Storable 'freeze';
 use HTTP::Request;
 use HTTP::Response;
@@ -20,6 +20,9 @@ my @response_map;
 my $network_fallback;
 my $last_useragent;
 
+sub __isa_coderef($);
+sub __is_regexp($);
+
 sub new
 {
     my ($class, %options) = @_;
@@ -64,7 +67,7 @@ sub map_response
 
     warn "map_response: response is not a coderef or an HTTP::Response, it's a ",
             (blessed($response) || 'non-object')
-        unless eval { \&$response } or $response->$_isa('HTTP::Response');
+        unless __isa_coderef($response) or $response->$_isa('HTTP::Response');
 
     if (blessed $self)
     {
@@ -117,7 +120,7 @@ sub register_psgi
     return $self->map_response($domain, undef) if not defined $app;
 
     warn "register_psgi: app is not a coderef, it's a ", ref($app)
-        unless eval { \&$app };
+        unless __isa_coderef($app);
 
     warn "register_psgi: did you forget to load HTTP::Message::PSGI?"
         unless HTTP::Request->can('to_psgi') and HTTP::Response->can('from_psgi');
@@ -212,11 +215,13 @@ sub send_request
             $matched_response = $response, last
                 if $uri =~ $request_desc;
         }
-        else
+        elsif (__isa_coderef $request_desc)
         {
             $matched_response = $response, last
-                if eval { $request_desc->($request) };
-
+                if $request_desc->($request);
+        }
+        else
+        {
             $uri = URI->new($uri) if not $uri->$_isa('URI');
             $matched_response = $response, last
                 if $uri->host eq $request_desc;
@@ -238,7 +243,7 @@ sub send_request
         ? $matched_response
         : HTTP::Response->new(404);
 
-    if (eval { \&$response })
+    if (__isa_coderef $response)
     {
         # emulates handling in LWP::UserAgent::send_request
         if ($self->use_eval)
@@ -288,6 +293,13 @@ sub send_request
     return $response;
 }
 
+sub __isa_coderef($)
+{
+    ref $_[0] eq 'CODE'
+        or (reftype($_[0]) || '') eq 'CODE'
+        or overload::Method($_[0], '&{}')
+}
+
 sub __is_regexp($)
 {
     $^V < 5.009005 ? ref(shift) eq 'Regexp' : re::is_regexp(shift);

t/08-isa-coderef.t

@@ -0,0 +1,27 @@
+use strict;
+use warnings FATAL => 'all';
+
+use Test::More tests => 7;
+use Test::NoWarnings 1.04 ':early';
+
+use Test::LWP::UserAgent;
+
+{
+    package CodeRefOverload;
+    use overload '&{}' => sub { sub { ::fail 'sub should not be called' } };
+    sub new { bless {}, 'CodeRefOverload' }
+}
+
+my $string = 'ohhai';
+my $scalarref = \$string;
+my $coderef = sub { fail 'sub should not be called' };
+my $nota_coderef = bless {}, 'NotaCodeRef';
+my $isa_coderef = bless sub { fail 'sub should not be called' }, 'IsaCodeRef';
+
+ok(!Test::LWP::UserAgent::__isa_coderef($string), 'string is not callable as a coderef');
+ok(!Test::LWP::UserAgent::__isa_coderef($scalarref), 'scalarref is not callable as a coderef');
+ok(Test::LWP::UserAgent::__isa_coderef($coderef), 'coderef is callable as a coderef');
+ok(!Test::LWP::UserAgent::__isa_coderef($nota_coderef), 'blessed hash is not callable as a coderef');
+ok(Test::LWP::UserAgent::__isa_coderef($isa_coderef), 'blessed coderef is callable as a coderef');
+ok(Test::LWP::UserAgent::__isa_coderef(CodeRefOverload->new), 'object with code overload is callable as a coderef');
+