From: Karen Etheridge <ether@cpan.org>
Date: Tue, 3 Dec 2013 01:16:24 +0000 (-0800)
Subject: extend support to calling against things that might be class names
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=5e41c170dabc732a0dde497020dce0201607894e;p=p5sagit%2FSafe-Isa.git

extend support to calling against things that might be class names
---

diff --git a/lib/Safe/Isa.pm b/lib/Safe/Isa.pm
index 680a71b..2d6c675 100644
--- a/lib/Safe/Isa.pm
+++ b/lib/Safe/Isa.pm
@@ -7,7 +7,7 @@ use Exporter 5.57 qw(import);
 
 our $VERSION = '1.000004';
 
-our @EXPORT = qw($_call_if_object $_isa $_can $_does $_DOES);
+our @EXPORT = qw($_call_if_object $_call_if_object_or_classname $_isa $_can $_does $_DOES);
 
 our $_call_if_object = sub {
   my ($obj, $method) = (shift, shift);
@@ -15,14 +15,23 @@ our $_call_if_object = sub {
   return $obj->$method(@_);
 };
 
+our $_call_if_object_or_classname = sub {
+  my ($thing, $method) = (shift, shift);
+  return unless blessed($thing) or do {
+    no strict 'refs';
+    %{"main::${thing}::"}
+  };
+  return $thing->$method(@_);
+};
+
 our ($_isa, $_can, $_does, $_DOES) = map {
   my $method = $_;
-  sub { my $obj = shift; $obj->$_call_if_object($method => @_) }
+  sub { my $obj = shift; $obj->$_call_if_object_or_classname($method => @_) }
 } qw(isa can does DOES);
 
 =head1 NAME
 
-Safe::Isa - Call isa, can, does and DOES safely on things that may not be objects
+Safe::Isa - Call isa, can, does and DOES safely on arbitrary things
 
 =head1 SYNOPSIS
 
@@ -34,16 +43,19 @@ Safe::Isa - Call isa, can, does and DOES safely on things that may not be object
   
   my $foo = Foo->new;
   my $bar = Bar->new;
+  my $class = 'Bar';
   my $blam = [ 42 ];
   
   # basic isa usage -
   
   $foo->isa('Foo');  # true
   $bar->isa('Foo');  # true
+  $class->isa('Foo') # true
   $blam->isa('Foo'); # BOOM
   
   $foo->can('bar');  # false
   $bar->can('bar');  # true
+  $class->can('bar); # true
   $blam->can('bar'); # BOOM
   
   # Safe::Isa usage -
@@ -52,10 +64,12 @@ Safe::Isa - Call isa, can, does and DOES safely on things that may not be object
   
   $foo->$_isa('Foo');  # true
   $bar->$_isa('Foo');  # true
+  $class->isa('Foo')   # true
   $blam->$_isa('Foo'); # false, no boom today
   
   $foo->$_can('bar');  # false
   $bar->$_can('bar');  # true
+  $class->can('bar);   # true
   $blam->$_can('bar'); # false, no boom today
 
 Similarly:
@@ -67,6 +81,10 @@ And just in case we missed a method:
 
   $maybe_an_object->$_call_if_object(name => @args);
 
+or this might be closer to what you want:
+
+  $maybe_a_referent->$_call_if_object_or_class(name => @args);
+
 Or to re-use a previous example for purposes of explication:
 
   $foo->$_call_if_object(isa => 'Foo');  # true
diff --git a/t/safe_isa.t b/t/safe_isa.t
index f9721e1..0fa9d37 100644
--- a/t/safe_isa.t
+++ b/t/safe_isa.t
@@ -1,6 +1,6 @@
 use strict;
 use warnings FATAL => 'all';
-use Test::More tests => 15;
+use Test::More tests => 28;
 
 { package Foo; sub new { bless({}, $_[0]) } }
 { package Bar; our @ISA = qw(Foo); sub bar { 1 } }
@@ -8,27 +8,43 @@ use Test::More tests => 15;
 my $foo = Foo->new;
 my $bar = Bar->new;
 my $blam = [ 42 ];
+my $class = 'Bar';
+my $blam2 = '';
 
 # basic isa usage -
 
 ok($foo->isa('Foo'), 'foo isa Foo');
 ok($bar->isa('Foo'), 'bar isa Foo');
-ok(!eval { $blam->isa('Foo'); 1 }, 'blam goes blam');
+ok($class->isa('Foo'), 'class name isa Foo');
+ok(!eval { $blam->isa('Foo'); 1 }, 'blam goes blam with isa');
+ok(!eval { $blam2->isa('Foo'); 1 }, 'blam2 goes blam with isa');
 
 ok(!$foo->can('bar'), 'foo !can bar');
 ok($bar->can('bar'), 'bar can bar');
-ok(!eval { $blam->can('bar'); 1 }, 'blam goes blam');
+ok($class->can('bar'), 'our class name can bar');
+ok(!eval { $blam->can('bar'); 1 }, 'blam goes blam with can');
+ok(!eval { $blam2->can('bar'); 1 }, 'blam2 goes blam with can');
 
 use Safe::Isa;
 
 ok($foo->$_isa('Foo'), 'foo $_isa Foo');
 ok($bar->$_isa('Foo'), 'bar $_isa Foo');
-ok(eval { $blam->$_isa('Foo'); 1 }, 'no boom today');
+ok($class->$_isa('Foo'), 'class name $_isa Foo');
+ok(eval { $blam->$_isa('Foo'); 1 }, 'no boom today with isa');
+ok(eval { $blam2->$_isa('Foo'); 1 }, 'no boom today with isa');
 
 ok(!$foo->$_can('bar'), 'foo !$_can bar');
 ok($bar->$_can('bar'), 'bar $_can bar');
-ok(eval { $blam->$_can('bar'); 1 }, 'no boom today');
+ok($class->$_can('bar'), 'class name $_can bar');
+ok(eval { $blam->$_can('bar'); 1 }, 'no boom today with can');
+ok(eval { $blam2->$_can('bar'); 1 }, 'no boom today with can');
 
 ok($foo->$_call_if_object(isa => 'Foo'), 'foo $_call_if_object(isa => Foo)');
 ok($bar->$_call_if_object(isa => 'Foo'), 'bar $_call_if_object(isa => Foo)');
-ok(eval { $blam->$_call_if_object(isa => 'Foo'); 1 }, 'no boom today');
+ok(eval { $blam->$_call_if_object(isa => 'Foo'); 1 }, 'no boom today with _call_if_object');
+
+ok($foo->$_call_if_object_or_classname(isa => 'Foo'), 'foo $_call_if_object_or_classname(isa => Foo)');
+ok($bar->$_call_if_object_or_classname(isa => 'Foo'), 'bar $_call_if_object_or_classname(isa => Foo)');
+ok($class->$_call_if_object_or_classname(isa => 'Foo'), 'class name $_call_if_object_or_classname(isa => Foo)');
+ok(eval { $blam->$_call_if_object_or_classname(isa => 'Foo'); 1 }, 'no boom today with _call_if_object_or_classname');
+ok(eval { $blam2->$_call_if_object_or_classname(isa => 'Foo'); 1 }, 'no boom today with _call_if_object_or_classname');