X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FSafe%2FIsa.pm;h=2e29b3c15c326eef49b5348eab84480e8c405b8b;hb=ff5366dba91627d0ce2cab3500db8ae094625a4f;hp=0495cccb98c46b1c7266a8ad7c8e8ac1a885213b;hpb=4703f64cbe034ffe6e326ca165c6fb8238664be4;p=p5sagit%2FSafe-Isa.git diff --git a/lib/Safe/Isa.pm b/lib/Safe/Isa.pm index 0495ccc..2e29b3c 100644 --- a/lib/Safe/Isa.pm +++ b/lib/Safe/Isa.pm @@ -2,16 +2,20 @@ package Safe::Isa; use strict; use warnings FATAL => 'all'; -use Scalar::Util qw(blessed); -use base qw(Exporter); +use Scalar::Util (); +use Exporter 5.57 qw(import); -our $VERSION = '1.000001'; +our $VERSION = '1.000006'; -our @EXPORT = qw($_call_if_object $_isa $_can $_does $_DOES); +our @EXPORT = qw($_call_if_object $_isa $_can $_does $_DOES $_call_if_can); our $_call_if_object = sub { my ($obj, $method) = (shift, shift); - return unless blessed($obj); + # This is intentionally a truth test, not a defined test, otherwise + # we gratuitously break modules like Scalar::Defer, which would be + # un-perlish. + return unless Scalar::Util::blessed($obj); + return $obj->isa(@_) if lc($method) eq 'does' and not $obj->can($method); return $obj->$method(@_); }; @@ -20,6 +24,16 @@ our ($_isa, $_can, $_does, $_DOES) = map { sub { my $obj = shift; $obj->$_call_if_object($method => @_) } } qw(isa can does DOES); +our $_call_if_can = sub { + my ($obj, $method) = (shift, shift); + $obj->$_call_if_object(can => $method) && $obj->$_call_if_object($method => @_); +}; + +1; +__END__ + +=pod + =head1 NAME Safe::Isa - Call isa, can, does and DOES safely on things that may not be objects @@ -63,9 +77,10 @@ Similarly: $maybe_an_object->$_does('RoleName'); # true or false, no boom today $maybe_an_object->$_DOES('RoleName'); # true or false, no boom today -And just in case we missed a method: +And just in case we missed a method or two: $maybe_an_object->$_call_if_object(name => @args); + $maybe_an_object->$_call_if_can(name => @args); Or to re-use a previous example for purposes of explication: @@ -103,6 +118,11 @@ is equivalent to } }; +Note that we don't handle trying class names, because many things are valid +class names that you might not want to treat as one (like say "Matt") - the +C function from L is a good way to check for +something you might be able to call methods on if you want to do that. + =head1 EXPORTS =head2 $_isa @@ -140,6 +160,19 @@ returns nothing. If called on an object, calls C on it and returns the result, otherwise returns nothing. +=head2 $_call_if_can + + $maybe_an_object->$_call_if_can(name => @args); + +If called on an object, calls C on it; if that returns true, then +calls C on it and returns the result; if any condition is false +returns nothing. + +=head1 SEE ALSO + +I gave a lightning talk on this module (and L and L) at +L. + =head1 AUTHOR mst - Matt S. Trout (cpan:MSTROUT)