Safe-Isa-1.000010/000700 000766 000024 00000000000 13270205565 013571 5ustar00etherstaff000000 000000 Safe-Isa-1.000010/Changes000644 000766 000024 00000002062 13270205553 015073 0ustar00etherstaff000000 000000 Revision history for Safe-Isa 1.000010 - 2018-04-25 - fix DOES tests on 5.8.x 1.000009 - 2018-04-21 - Fix handling of DOES and does (they no longer fall back to isa in most situations outside of Moo/Moose) 1.000008 - 2017-10-03 - fix scalar/list context handling for $_call_if_can 1.000007 - 2017-09-22 - added new interface: $obj->$_call_if_can 1.000006 - 2016-10-31 - now falling back to $obj->isa if DOES/does is not implemented on the object, to avoid fatal errors on perls too old to have their own DOES (RT#100866) 1.000005 - 2014-08-16 - comment blessed use so people who don't know perl stop trying to break it - add link to lightning talk given at YAPC::NA 2013 1.000004 - 2013-09-18 - fixed slightly mangled metadata from last release 1.000003 - 2013-03-25 - fix NAME in Makefile.PL (RT#84212) 1.000002 - 2012-07-19 - Document why we don't try and handle class names - Missed another stupid doc typo (thanks MJD) 1.000001 - 2012-07-18 - Fix stupid doc typo (thanks miyagawa) 1.000000 - 2012-07-18 - Initial release Safe-Isa-1.000010/MANIFEST000644 000766 000024 00000000546 13270205565 014741 0ustar00etherstaff000000 000000 Changes lib/Safe/Isa.pm maint/Makefile.PL.include Makefile.PL MANIFEST This list of files t/safe_does.t t/safe_isa.t META.yml Module YAML meta-data (added by MakeMaker) META.json Module JSON meta-data (added by MakeMaker) README README file (added by Distar) Safe-Isa-1.000010/META.json000600 000766 000024 00000003122 13270205564 015211 0ustar00etherstaff000000 000000 { "abstract" : "Call isa, can, does and DOES safely on things that may not be objects", "author" : [ "mst - Matt S. Trout (cpan:MSTROUT) " ], "dynamic_config" : 0, "generated_by" : "ExtUtils::MakeMaker version 7.34, CPAN::Meta::Converter version 2.150010", "license" : [ "perl_5" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : 2 }, "name" : "Safe-Isa", "no_index" : { "directory" : [ "t", "inc" ] }, "prereqs" : { "configure" : { "requires" : { "ExtUtils::MakeMaker" : "0" } }, "runtime" : { "requires" : { "Exporter" : "5.57", "Scalar::Util" : "0", "perl" : "5.006" } }, "test" : { "requires" : { "Test::More" : "0" } } }, "release_status" : "stable", "resources" : { "bugtracker" : { "mailto" : "bug-Safe-Isa@rt.cpan.org", "web" : "https://rt.cpan.org/Public/Dist/Display.html?Name=Safe-Isa" }, "repository" : { "type" : "git", "url" : "https://github.com/p5sagit/Safe-Isa.git", "web" : "https://github.com/p5sagit/Safe-Isa" } }, "version" : "1.000010", "x_contributors" : [ "Karen Etheridge ", "Matt S Trout ", "Graham Knop ", "David Steinbrunner " ], "x_serialization_backend" : "JSON::MaybeXS version 1.004" } Safe-Isa-1.000010/META.yml000600 000766 000024 00000001712 13270205564 015044 0ustar00etherstaff000000 000000 --- abstract: 'Call isa, can, does and DOES safely on things that may not be objects' author: - 'mst - Matt S. Trout (cpan:MSTROUT) ' build_requires: Test::More: '0' configure_requires: ExtUtils::MakeMaker: '0' dynamic_config: 0 generated_by: 'ExtUtils::MakeMaker version 7.34, CPAN::Meta::Converter version 2.150010' license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: '1.4' name: Safe-Isa no_index: directory: - t - inc requires: Exporter: '5.57' Scalar::Util: '0' perl: '5.006' resources: bugtracker: https://rt.cpan.org/Public/Dist/Display.html?Name=Safe-Isa repository: https://github.com/p5sagit/Safe-Isa.git version: '1.000010' x_contributors: - 'Karen Etheridge ' - 'Matt S Trout ' - 'Graham Knop ' - 'David Steinbrunner ' x_serialization_backend: 'CPAN::Meta::YAML version 0.018' Safe-Isa-1.000010/Makefile.PL000644 000766 000024 00000005765 13270204013 015555 0ustar00etherstaff000000 000000 use strict; use warnings FATAL => 'all'; use ExtUtils::MakeMaker; (do './maint/Makefile.PL.include' or die $@) unless -f 'META.yml'; my %WriteMakefileArgs = ( NAME => 'Safe::Isa', VERSION_FROM => 'lib/Safe/Isa.pm', META_MERGE => { 'meta-spec' => { version => 2 }, dynamic_config => 0, resources => { # GitHub mirrors from Shadowcat. We list it so we can get pull requests. # The canonical repo is: # r/o: git://git.shadowcat.co.uk/p5sagit/Safe-Isa.git # r/w: p5sagit@git.shadowcat.co.uk:Safe-Isa.git # web: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=p5sagit/Safe-Isa.git repository => { url => 'https://github.com/p5sagit/Safe-Isa.git', web => 'https://github.com/p5sagit/Safe-Isa', type => 'git', }, bugtracker => { mailto => 'bug-Safe-Isa@rt.cpan.org', web => 'https://rt.cpan.org/Public/Dist/Display.html?Name=Safe-Isa', }, }, x_contributors => [ # manually added, from git shortlog -e -s -n 'Karen Etheridge ', 'Matt S Trout ', 'Graham Knop ', 'David Steinbrunner ', ], }, META_ADD => { 'meta-spec' => { version => 2 }, prereqs => { configure => { requires => { 'ExtUtils::MakeMaker' => '0', }, }, runtime => { requires => { 'Exporter' => '5.57', 'Scalar::Util' => 0, perl => '5.006', }, }, test => { requires => { 'Test::More' => '0', }, }, }, }, ); my $eumm_version = eval $ExtUtils::MakeMaker::VERSION; for (qw(configure build test runtime)) { my $key = $_ eq 'runtime' ? 'PREREQ_PM' : uc $_.'_REQUIRES'; next unless exists $WriteMakefileArgs{META_ADD}{prereqs}{$_} or exists $WriteMakefileArgs{$key}; my $r = $WriteMakefileArgs{$key} = { %{$WriteMakefileArgs{META_ADD}{prereqs}{$_}{requires} || {}}, %{delete $WriteMakefileArgs{$key} || {}}, }; defined $r->{$_} or delete $r->{$_} for keys %$r; } # dynamic prereqs get added here. $WriteMakefileArgs{MIN_PERL_VERSION} = delete $WriteMakefileArgs{PREREQ_PM}{perl} || 0; die 'attention developer: you need to do a sane meta merge here!' if keys %{$WriteMakefileArgs{BUILD_REQUIRES}}; $WriteMakefileArgs{BUILD_REQUIRES} = { %{$WriteMakefileArgs{BUILD_REQUIRES} || {}}, %{delete $WriteMakefileArgs{TEST_REQUIRES}} } if $eumm_version < 6.63_03; $WriteMakefileArgs{PREREQ_PM} = { %{$WriteMakefileArgs{PREREQ_PM}}, %{delete $WriteMakefileArgs{BUILD_REQUIRES}} } if $eumm_version < 6.55_01; delete $WriteMakefileArgs{CONFIGURE_REQUIRES} if $eumm_version < 6.51_03; delete $WriteMakefileArgs{MIN_PERL_VERSION} if $eumm_version < 6.48; delete @WriteMakefileArgs{qw(META_ADD META_MERGE)} if $eumm_version < 6.46; delete $WriteMakefileArgs{LICENSE} if $eumm_version < 6.31; WriteMakefile(%WriteMakefileArgs); Safe-Isa-1.000010/README000600 000766 000024 00000010725 13270205565 014460 0ustar00etherstaff000000 000000 NAME Safe::Isa - Call isa, can, does and DOES safely on things that may not be objects SYNOPSIS use strict; use warnings; { package Foo; sub new { bless({}, $_[0]) } } { package Bar; our @ISA = qw(Foo); sub bar { 1 } } my $foo = Foo->new; my $bar = Bar->new; my $blam = [ 42 ]; # basic isa usage - $foo->isa('Foo'); # true $bar->isa('Foo'); # true $blam->isa('Foo'); # BOOM $foo->can('bar'); # false $bar->can('bar'); # true $blam->can('bar'); # BOOM # Safe::Isa usage - use Safe::Isa; $foo->$_isa('Foo'); # true $bar->$_isa('Foo'); # true $blam->$_isa('Foo'); # false, no boom today $foo->$_can('bar'); # false $bar->$_can('bar'); # true $blam->$_can('bar'); # false, no boom today 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 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: $foo->$_call_if_object(isa => 'Foo'); # true $bar->$_call_if_object(isa => 'Foo'); # true $blam->$_call_if_object(isa => 'Foo'); # false, no boom today DESCRIPTION How many times have you found yourself writing: if ($obj->isa('Something')) { and then shortly afterwards cursing and changing it to: if (Scalar::Util::blessed($obj) and $obj->isa('Something')) { Right. That's why this module exists. Since perl allows us to provide a subroutine reference or a method name to the -> operator when used as a method call, and a subroutine doesn't require the invocant to actually be an object, we can create safe versions of isa, can and friends by using a subroutine reference that only tries to call the method if it's used on an object. So: my $isa_Foo = $maybe_an_object->$_call_if_object(isa => 'Foo'); is equivalent to my $isa_Foo = do { if (Scalar::Util::blessed($maybe_an_object)) { $maybe_an_object->isa('Foo'); } else { undef; } }; 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 "is_module_name" function from Module::Runtime is a good way to check for something you might be able to call methods on if you want to do that. We are careful to make sure that scalar/list context is preserved for the method that is eventually called. EXPORTS $_isa $maybe_an_object->$_isa('Foo'); If called on an object, calls "isa" on it and returns the result, otherwise returns nothing. $_can $maybe_an_object->$_can('Foo'); If called on an object, calls "can" on it and returns the result, otherwise returns nothing. $_does $maybe_an_object->$_does('Foo'); If called on an object, calls "does" on it and returns the result, otherwise returns nothing. If the "does" method does not exist, returns nothing rather than failing. $_DOES $maybe_an_object->$_DOES('Foo'); If called on an object, calls "DOES" on it and returns the result, otherwise returns nothing. On perl versions prior to 5.10.0, the built in core "DOES" method doesn't exist. If the method doesn't exist, this will fall back to calling "isa" just like the core "DOES" method. $_call_if_object $maybe_an_object->$_call_if_object(method_name => @args); If called on an object, calls "method_name" on it and returns the result, otherwise returns nothing. $_call_if_can $maybe_an_object->$_call_if_can(name => @args); If called on an object, calls "can" on it; if that returns true, then calls "method_name" on it and returns the result; if any condition is false returns nothing. SEE ALSO I gave a lightning talk on this module (and curry and Import::Into) at YAPC::NA 2013 . AUTHOR mst - Matt S. Trout (cpan:MSTROUT) CONTRIBUTORS None yet. Well volunteered? :) COPYRIGHT Copyright (c) 2012 the Safe::Isa "AUTHOR" and "CONTRIBUTORS" as listed above. LICENSE This library is free software and may be distributed under the same terms as perl itself. Safe-Isa-1.000010/lib/000700 000766 000024 00000000000 13270205564 014336 5ustar00etherstaff000000 000000 Safe-Isa-1.000010/maint/000700 000766 000024 00000000000 13270205564 014700 5ustar00etherstaff000000 000000 Safe-Isa-1.000010/t/000700 000766 000024 00000000000 13270205564 014033 5ustar00etherstaff000000 000000 Safe-Isa-1.000010/t/safe_does.t000644 000766 000024 00000004120 13270202145 016147 0ustar00etherstaff000000 000000 use strict; use warnings; use Test::More tests => 20; { package Foo; sub new { bless({}, $_[0]) } } { package Bar; our @ISA = qw(Foo); sub bar { 1 } sub does { $_[0]->isa($_[1]) } } my $foo = Foo->new; my $bar = Bar->new; my $blam = [ 42 ]; my $undef; # basic does, DOES usage - # on perls >= 5.10.0, DOES falls back to isa. # does must always be manually provided if (UNIVERSAL->can('DOES')) { ok($foo->DOES('Foo'), 'foo DOES Foo'); ok($bar->DOES('Foo'), 'bar DOES Foo'); } else { ok(!eval { $foo->DOES('Foo') }, 'DOES not available in UNIVERSAL'); ok(!eval { $bar->DOES('Foo') }, 'DOES not available in UNIVERSAL'); } ok(!eval { $foo->does('Foo') }, 'does not implemented on Foo'); ok($bar->does('Foo'), 'bar does Foo'); ok(!eval { $blam->DOES('Foo'); 1 }, 'blam goes blam'); ok(!eval { $undef->DOES('Foo'); 1 }, 'undef goes poof'); use Safe::Isa; ok($foo->$_DOES('Foo'), 'foo $_DOES Foo'); ok($bar->$_DOES('Foo'), 'bar $_DOES Foo'); ok(eval { $blam->$_DOES('Foo'); 1 }, 'no boom today'); ok(eval { $undef->$_DOES('Foo'); 1 }, 'nor tomorrow either'); # does should not fall back to isa ok(!$foo->$_does('Foo'), 'foo !$_does Foo'); ok($bar->$_does('Foo'), 'bar $_does Foo'); ok(eval { $blam->$_does('Foo'); 1 }, 'no boom today'); ok(eval { $undef->$_does('Foo'); 1 }, 'nor tomorrow either'); if (UNIVERSAL->can('DOES')) { ok($foo->$_call_if_object(DOES => 'Foo'), 'foo $_call_if_object(DOES => Foo)'); ok($bar->$_call_if_object(DOES => 'Foo'), 'bar $_call_if_object(DOES => Foo)'); } else { ok(!eval { $foo->$_call_if_object(DOES => 'Foo'); 1 }, 'foo $_call_if_object(DOES => Foo) fails without UNIVERSAL::DOES'); ok(!eval { $bar->$_call_if_object(DOES => 'Foo'); 1 }, 'bar $_call_if_object(DOES => Foo) fails without UNIVERSAL::DOES'); } ok(eval { $blam->$_call_if_object(DOES => 'Foo'); 1 }, 'no boom today'); ok(eval { $undef->$_call_if_object(DOES => 'Foo'); 1 }, 'nor tomorrow either'); ok(!eval { $foo->$_call_if_object(does => 'Foo'); 1 }, 'no special DOES handling built into _call_if_object'); ok(!eval { $foo->$_call_if_object(Does => 'Foo'); 1 }, 'and no handling for wrong case'); Safe-Isa-1.000010/t/safe_isa.t000644 000766 000024 00000011436 13164557431 016016 0ustar00etherstaff000000 000000 use strict; use warnings; use Test::More tests => 68; { package Foo; sub new { bless({}, $_[0]) } } { package Bar; our @ISA = qw(Foo); sub bar { wantarray ? ( 5, 6 ) : $_[1] } } my $foo = Foo->new; my $bar = Bar->new; my $blam = [ 42 ]; my $undef; # 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(!eval { $undef->isa('Foo'); 1 }, 'undef goes poof'); ok(!$foo->can('bar'), 'foo !can bar'); ok($bar->can('bar'), 'bar can bar'); ok(!eval { $blam->can('bar'); 1 }, 'blam goes blam'); ok(!eval { $undef->can('bar'); 1 }, 'undef goes poof'); use Safe::Isa; note 'scalar context..'; ok($foo->$_isa('Foo'), 'foo $_isa Foo'); ok($bar->$_isa('Foo'), 'bar $_isa Foo'); ok(eval { is($blam->$_isa('Foo'), undef, 'blam isn\'t Foo'); 1 }, 'no boom today'); ok(eval { is($undef->$_isa('Foo'), undef, 'undef isn\'t Foo either'); 1 }, 'and no boom tomorrow either'); ok(!$foo->$_can('bar'), 'foo !$_can bar'); ok($bar->$_can('bar'), 'bar $_can bar'); ok(eval { is($blam->$_can('bar'), undef, 'blam can\'t bar'); 1 }, 'no boom today'); ok(eval { is($undef->$_can('bar'), undef, 'undef can\'t bar either'); 1 }, 'and no boom tomorrow either'); 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)'); is($bar->$_call_if_object(bar => ), undef, 'bar $_call_if_object(bar => )'); is($bar->$_call_if_object(bar => 2), 2, 'bar $_call_if_object(bar => 2)'); ok(eval { is($blam->$_call_if_object(isa => 'Foo'), undef, 'blam can\'t call anything'); 1 }, 'no boom today'); ok(eval { is($undef->$_call_if_object(isa => 'Foo'), undef, 'undef can\'t call anything'); 1 }, 'and no boom tomorrow either'); ok($foo->$_call_if_can(isa => 'Foo'), 'foo $_call_if_can(isa => Foo)'); ok($bar->$_call_if_can(isa => 'Foo'), 'bar $_call_if_can(isa => Foo)'); ok(eval { is($foo->$_call_if_can(bar => ), undef, 'foo can\'t call bar'); 1 }, 'no boom today'); is($bar->$_call_if_can(bar => ), undef, 'bar $_call_if_can(bar => )'); is($bar->$_call_if_can(bar => 2), 2, 'bar $_call_if_can(bar => 2)'); ok(eval { is($blam->$_call_if_can(isa => 'Foo'), undef, 'blam can\'t call anything'); 1 }, 'no boom today'); ok(eval { is($undef->$_call_if_can(isa => 'Foo'), undef, 'undef can\'t call anything'); 1 }, 'and no boom tomorrow either'); note 'list context..'; # isa always returns true/false is_deeply([ $foo->$_isa('Foo') ], [ 1 ], 'foo $_isa Foo'); is_deeply([ $bar->$_isa('Foo') ], [ 1 ], 'bar $_isa Foo'); ok( eval { is_deeply([ $blam->$_isa('Foo') ], [], 'blam isn\'t Foo'); 1 }, 'no boom today', ); ok( eval { is_deeply([ $undef->$_isa('Foo') ], [], 'undef isn\'t Foo either'); 1 }, 'and no boom tomorrow either', ); # can returns ref/undef if it ran, or false if not an object. is_deeply([ $foo->$_can('bar') ], [ undef ], 'foo !$_can bar'); is_deeply([ $bar->$_can('bar') ], [ \&Bar::bar ], 'bar $_can bar'); ok( eval { is_deeply([ $blam->$_can('bar') ], [], 'blam can\'t bar'); 1 }, 'no boom today', ); ok( eval { is_deeply([ $undef->$_can('bar') ], [], 'undef can\'t bar either'); 1 }, 'and no boom tomorrow either', ); # _call_if_object has the same behaviour as the method it is calling and # propagates context. is_deeply([ $foo->$_call_if_object(isa => 'Foo') ], [ 1 ], 'foo $_call_if_object(isa => Foo)'); is_deeply([ $bar->$_call_if_object(isa => 'Foo') ], [ 1 ], 'bar $_call_if_object(isa => Foo)'); is_deeply([ $bar->$_call_if_object(bar => ) ], [ 5, 6 ], 'bar $_call_if_object(bar => undef): wantarray is true'); is_deeply([ $bar->$_call_if_object(bar => 2) ], [ 5, 6 ], 'bar $_call_if_object(bar => 2): wantarray is true'); ok( eval { is_deeply([ $blam->$_call_if_object(isa => 'Foo') ], [], 'blam can\'t call anything'); 1 }, 'no boom today', ); ok( eval { is_deeply([ $undef->$_call_if_object(isa => 'Foo') ], [], 'undef can\'t call anything'); 1 }, 'and no boom tomorrow either', ); # _call_if_can has the same behaviour as the method it is calling and # propagates context. is_deeply([ $foo->$_call_if_can(isa => 'Foo') ], [ 1 ], 'foo $_call_if_can(isa => Foo)'); is_deeply([ $bar->$_call_if_can(isa => 'Foo') ], [ 1 ], 'bar $_call_if_can(isa => Foo)'); ok( eval { is_deeply([ $foo->$_call_if_can(bar => ) ], [], 'foo can\'t call bar'); 1 }, 'no boom today', ); is_deeply([ $bar->$_call_if_can(bar => ) ], [ 5, 6 ], 'bar $_call_if_can(bar => ): wantarray is true'); is_deeply([ $bar->$_call_if_can(bar => 2) ], [ 5, 6 ], 'bar $_call_if_can(bar => 2): wantarray is true'); ok( eval { is_deeply([ $blam->$_call_if_can(isa => 'Foo') ], [], 'blam can\'t call anything'); 1 }, 'no boom today', ); ok( eval { is_deeply([ $undef->$_call_if_can(isa => 'Foo') ], [], 'undef can\'t call anything'); 1 }, 'and no boom tomorrow either', ); Safe-Isa-1.000010/maint/Makefile.PL.include000644 000766 000024 00000000406 12474663751 020321 0ustar00etherstaff000000 000000 BEGIN { -e 'Distar' or system("git clone git://git.shadowcat.co.uk/p5sagit/Distar.git") } use lib 'Distar/lib'; use Distar; use ExtUtils::MakeMaker 6.68; # ensure meta-spec v2 compatibility author 'mst - Matt S. Trout (cpan:MSTROUT) '; 1; Safe-Isa-1.000010/lib/Safe/000700 000766 000024 00000000000 13270205564 015214 5ustar00etherstaff000000 000000 Safe-Isa-1.000010/lib/Safe/Isa.pm000644 000766 000024 00000012426 13266670536 016317 0ustar00etherstaff000000 000000 package Safe::Isa; use strict; use warnings FATAL => 'all'; use Scalar::Util (); use Exporter 5.57 qw(import); our $VERSION = '1.000010'; our @EXPORT = qw($_call_if_object $_isa $_can $_does $_DOES $_call_if_can); our $_call_if_object = sub { my ($obj, $method) = (shift, shift); # 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->$method(@_); }; our ($_isa, $_can) = map { my $method = $_; sub { my $obj = shift; $obj->$_call_if_object($method => @_) } } qw(isa can); our $_call_if_can = sub { my ($obj, $method) = (shift, shift); return unless $obj->$_call_if_object(can => $method); return $obj->$method(@_); }; our $_does = sub { my $obj = shift; $obj->$_call_if_can(does => @_); }; our $_DOES = sub { my $obj = shift; return unless Scalar::Util::blessed($obj); return $obj->DOES(@_) if $obj->can('DOES'); return $obj->isa(@_); }; 1; __END__ =pod =head1 NAME Safe::Isa - Call isa, can, does and DOES safely on things that may not be objects =head1 SYNOPSIS use strict; use warnings; { package Foo; sub new { bless({}, $_[0]) } } { package Bar; our @ISA = qw(Foo); sub bar { 1 } } my $foo = Foo->new; my $bar = Bar->new; my $blam = [ 42 ]; # basic isa usage - $foo->isa('Foo'); # true $bar->isa('Foo'); # true $blam->isa('Foo'); # BOOM $foo->can('bar'); # false $bar->can('bar'); # true $blam->can('bar'); # BOOM # Safe::Isa usage - use Safe::Isa; $foo->$_isa('Foo'); # true $bar->$_isa('Foo'); # true $blam->$_isa('Foo'); # false, no boom today $foo->$_can('bar'); # false $bar->$_can('bar'); # true $blam->$_can('bar'); # false, no boom today 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 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: $foo->$_call_if_object(isa => 'Foo'); # true $bar->$_call_if_object(isa => 'Foo'); # true $blam->$_call_if_object(isa => 'Foo'); # false, no boom today =head1 DESCRIPTION How many times have you found yourself writing: if ($obj->isa('Something')) { and then shortly afterwards cursing and changing it to: if (Scalar::Util::blessed($obj) and $obj->isa('Something')) { Right. That's why this module exists. Since perl allows us to provide a subroutine reference or a method name to the -> operator when used as a method call, and a subroutine doesn't require the invocant to actually be an object, we can create safe versions of isa, can and friends by using a subroutine reference that only tries to call the method if it's used on an object. So: my $isa_Foo = $maybe_an_object->$_call_if_object(isa => 'Foo'); is equivalent to my $isa_Foo = do { if (Scalar::Util::blessed($maybe_an_object)) { $maybe_an_object->isa('Foo'); } else { undef; } }; 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. We are careful to make sure that scalar/list context is preserved for the method that is eventually called. =head1 EXPORTS =head2 $_isa $maybe_an_object->$_isa('Foo'); If called on an object, calls C on it and returns the result, otherwise returns nothing. =head2 $_can $maybe_an_object->$_can('Foo'); If called on an object, calls C on it and returns the result, otherwise returns nothing. =head2 $_does $maybe_an_object->$_does('Foo'); If called on an object, calls C on it and returns the result, otherwise returns nothing. If the C method does not exist, returns nothing rather than failing. =head2 $_DOES $maybe_an_object->$_DOES('Foo'); If called on an object, calls C on it and returns the result, otherwise returns nothing. On perl versions prior to 5.10.0, the built in core C method doesn't exist. If the method doesn't exist, this will fall back to calling C just like the core C method. =head2 $_call_if_object $maybe_an_object->$_call_if_object(method_name => @args); 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) =head1 CONTRIBUTORS None yet. Well volunteered? :) =head1 COPYRIGHT Copyright (c) 2012 the Safe::Isa L and L as listed above. =head1 LICENSE This library is free software and may be distributed under the same terms as perl itself. =cut