1package Safe::Isa; 2 3use strict; 4use warnings FATAL => 'all'; 5use Scalar::Util (); 6use Exporter 5.57 qw(import); 7 8our $VERSION = '1.000010'; 9 10our @EXPORT = qw($_call_if_object $_isa $_can $_does $_DOES $_call_if_can); 11 12our $_call_if_object = sub { 13 my ($obj, $method) = (shift, shift); 14 # This is intentionally a truth test, not a defined test, otherwise 15 # we gratuitously break modules like Scalar::Defer, which would be 16 # un-perlish. 17 return unless Scalar::Util::blessed($obj); 18 return $obj->$method(@_); 19}; 20 21our ($_isa, $_can) = map { 22 my $method = $_; 23 sub { my $obj = shift; $obj->$_call_if_object($method => @_) } 24} qw(isa can); 25 26our $_call_if_can = sub { 27 my ($obj, $method) = (shift, shift); 28 return unless $obj->$_call_if_object(can => $method); 29 return $obj->$method(@_); 30}; 31 32our $_does = sub { 33 my $obj = shift; 34 $obj->$_call_if_can(does => @_); 35}; 36 37our $_DOES = sub { 38 my $obj = shift; 39 return unless Scalar::Util::blessed($obj); 40 return $obj->DOES(@_) 41 if $obj->can('DOES'); 42 return $obj->isa(@_); 43}; 44 451; 46__END__ 47 48=pod 49 50=head1 NAME 51 52Safe::Isa - Call isa, can, does and DOES safely on things that may not be objects 53 54=head1 SYNOPSIS 55 56 use strict; 57 use warnings; 58 59 { package Foo; sub new { bless({}, $_[0]) } } 60 { package Bar; our @ISA = qw(Foo); sub bar { 1 } } 61 62 my $foo = Foo->new; 63 my $bar = Bar->new; 64 my $blam = [ 42 ]; 65 66 # basic isa usage - 67 68 $foo->isa('Foo'); # true 69 $bar->isa('Foo'); # true 70 $blam->isa('Foo'); # BOOM 71 72 $foo->can('bar'); # false 73 $bar->can('bar'); # true 74 $blam->can('bar'); # BOOM 75 76 # Safe::Isa usage - 77 78 use Safe::Isa; 79 80 $foo->$_isa('Foo'); # true 81 $bar->$_isa('Foo'); # true 82 $blam->$_isa('Foo'); # false, no boom today 83 84 $foo->$_can('bar'); # false 85 $bar->$_can('bar'); # true 86 $blam->$_can('bar'); # false, no boom today 87 88Similarly: 89 90 $maybe_an_object->$_does('RoleName'); # true or false, no boom today 91 $maybe_an_object->$_DOES('RoleName'); # true or false, no boom today 92 93And just in case we missed a method or two: 94 95 $maybe_an_object->$_call_if_object(name => @args); 96 $maybe_an_object->$_call_if_can(name => @args); 97 98Or to re-use a previous example for purposes of explication: 99 100 $foo->$_call_if_object(isa => 'Foo'); # true 101 $bar->$_call_if_object(isa => 'Foo'); # true 102 $blam->$_call_if_object(isa => 'Foo'); # false, no boom today 103 104=head1 DESCRIPTION 105 106How many times have you found yourself writing: 107 108 if ($obj->isa('Something')) { 109 110and then shortly afterwards cursing and changing it to: 111 112 if (Scalar::Util::blessed($obj) and $obj->isa('Something')) { 113 114Right. That's why this module exists. 115 116Since perl allows us to provide a subroutine reference or a method name to 117the -> operator when used as a method call, and a subroutine doesn't require 118the invocant to actually be an object, we can create safe versions of isa, 119can and friends by using a subroutine reference that only tries to call the 120method if it's used on an object. So: 121 122 my $isa_Foo = $maybe_an_object->$_call_if_object(isa => 'Foo'); 123 124is equivalent to 125 126 my $isa_Foo = do { 127 if (Scalar::Util::blessed($maybe_an_object)) { 128 $maybe_an_object->isa('Foo'); 129 } else { 130 undef; 131 } 132 }; 133 134Note that we don't handle trying class names, because many things are valid 135class names that you might not want to treat as one (like say "Matt") - the 136C<is_module_name> function from L<Module::Runtime> is a good way to check for 137something you might be able to call methods on if you want to do that. 138 139We are careful to make sure that scalar/list context is preserved for the 140method that is eventually called. 141 142=head1 EXPORTS 143 144=head2 $_isa 145 146 $maybe_an_object->$_isa('Foo'); 147 148If called on an object, calls C<isa> on it and returns the result, otherwise 149returns nothing. 150 151=head2 $_can 152 153 $maybe_an_object->$_can('Foo'); 154 155If called on an object, calls C<can> on it and returns the result, otherwise 156returns nothing. 157 158=head2 $_does 159 160 $maybe_an_object->$_does('Foo'); 161 162If called on an object, calls C<does> on it and returns the result, otherwise 163returns nothing. If the C<does> method does not exist, returns nothing rather 164than failing. 165 166=head2 $_DOES 167 168 $maybe_an_object->$_DOES('Foo'); 169 170If called on an object, calls C<DOES> on it and returns the result, otherwise 171returns nothing. On perl versions prior to 5.10.0, the built in core C<DOES> 172method doesn't exist. If the method doesn't exist, this will fall back to 173calling C<isa> just like the core C<DOES> method. 174 175=head2 $_call_if_object 176 177 $maybe_an_object->$_call_if_object(method_name => @args); 178 179If called on an object, calls C<method_name> on it and returns the result, 180otherwise returns nothing. 181 182=head2 $_call_if_can 183 184 $maybe_an_object->$_call_if_can(name => @args); 185 186If called on an object, calls C<can> on it; if that returns true, then 187calls C<method_name> on it and returns the result; if any condition is false 188returns nothing. 189 190=head1 SEE ALSO 191 192I gave a lightning talk on this module (and L<curry> and L<Import::Into>) at 193L<YAPC::NA 2013|https://www.youtube.com/watch?v=wFXWV2yY7gE&t=46m05s>. 194 195=head1 AUTHOR 196 197mst - Matt S. Trout (cpan:MSTROUT) <mst@shadowcat.co.uk> 198 199=head1 CONTRIBUTORS 200 201None yet. Well volunteered? :) 202 203=head1 COPYRIGHT 204 205Copyright (c) 2012 the Safe::Isa L</AUTHOR> and L</CONTRIBUTORS> 206as listed above. 207 208=head1 LICENSE 209 210This library is free software and may be distributed under the same terms 211as perl itself. 212 213=cut 214