lib/Safe/Isa.pm

   1 package Safe::Isa;
   2
   3 use strict;
   4 use warnings FATAL => 'all';
   5 use Scalar::Util qw(blessed);
   6 use Exporter 5.57 qw(import);
   7
   8 our $VERSION = '1.000005';
   9
  10 our @EXPORT = qw($_call_if_object $_isa $_can $_does $_DOES);
  11
  12 our $_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 blessed($obj);
  18   return $obj->$method(@_);
  19 };
  20
  21 our ($_isa, $_can, $_does, $_DOES) = map {
  22   my $method = $_;
  23   sub { my $obj = shift; $obj->$_call_if_object($method => @_) }
  24 } qw(isa can does DOES);
  25
  26 =head1 NAME
  27
  28 Safe::Isa - Call isa, can, does and DOES safely on things that may not be objects
  29
  30 =head1 SYNOPSIS
  31
  32   use strict;
  33   use warnings;
  34
  35   { package Foo; sub new { bless({}, $_[0]) } }
  36   { package Bar; our @ISA = qw(Foo); sub bar { 1 } }
  37
  38   my $foo = Foo->new;
  39   my $bar = Bar->new;
  40   my $blam = [ 42 ];
  41
  42   # basic isa usage -
  43
  44   $foo->isa('Foo');  # true
  45   $bar->isa('Foo');  # true
  46   $blam->isa('Foo'); # BOOM
  47
  48   $foo->can('bar');  # false
  49   $bar->can('bar');  # true
  50   $blam->can('bar'); # BOOM
  51
  52   # Safe::Isa usage -
  53
  54   use Safe::Isa;
  55
  56   $foo->$_isa('Foo');  # true
  57   $bar->$_isa('Foo');  # true
  58   $blam->$_isa('Foo'); # false, no boom today
  59
  60   $foo->$_can('bar');  # false
  61   $bar->$_can('bar');  # true
  62   $blam->$_can('bar'); # false, no boom today
  63
  64 Similarly:
  65
  66   $maybe_an_object->$_does('RoleName'); # true or false, no boom today
  67   $maybe_an_object->$_DOES('RoleName'); # true or false, no boom today
  68
  69 And just in case we missed a method:
  70
  71   $maybe_an_object->$_call_if_object(name => @args);
  72
  73 Or to re-use a previous example for purposes of explication:
  74
  75   $foo->$_call_if_object(isa => 'Foo');  # true
  76   $bar->$_call_if_object(isa => 'Foo');  # true
  77   $blam->$_call_if_object(isa => 'Foo'); # false, no boom today
  78
  79 =head1 DESCRIPTION
  80
  81 How many times have you found yourself writing:
  82
  83   if ($obj->isa('Something')) {
  84
  85 and then shortly afterwards cursing and changing it to:
  86
  87   if (Scalar::Util::blessed($obj) and $obj->isa('Something')) {
  88
  89 Right. That's why this module exists.
  90
  91 Since perl allows us to provide a subroutine reference or a method name to
  92 the -> operator when used as a method call, and a subroutine doesn't require
  93 the invocant to actually be an object, we can create safe versions of isa,
  94 can and friends by using a subroutine reference that only tries to call the
  95 method if it's used on an object. So:
  96
  97   my $isa_Foo = $maybe_an_object->$_call_if_object(isa => 'Foo');
  98
  99 is equivalent to
 100
 101   my $isa_Foo = do {
 102     if (Scalar::Util::blessed($maybe_an_object)) {
 103       $maybe_an_object->isa('Foo');
 104     } else {
 105       undef;
 106     }
 107   };
 108
 109 Note that we don't handle trying class names, because many things are valid
 110 class names that you might not want to treat as one (like say "Matt") - the
 111 C<is_module_name> function from L<Module::Runtime> is a good way to check for
 112 something you might be able to call methods on if you want to do that.
 113
 114 =head1 EXPORTS
 115
 116 =head2 $_isa
 117
 118   $maybe_an_object->$_isa('Foo');
 119
 120 If called on an object, calls C<isa> on it and returns the result, otherwise
 121 returns nothing.
 122
 123 =head2 $_can
 124
 125   $maybe_an_object->$_can('Foo');
 126
 127 If called on an object, calls C<can> on it and returns the result, otherwise
 128 returns nothing.
 129
 130 =head2 $_does
 131
 132   $maybe_an_object->$_does('Foo');
 133
 134 If called on an object, calls C<does> on it and returns the result, otherwise
 135 returns nothing.
 136
 137 =head2 $_DOES
 138
 139   $maybe_an_object->$_DOES('Foo');
 140
 141 If called on an object, calls C<DOES> on it and returns the result, otherwise
 142 returns nothing.
 143
 144 =head2 $_call_if_object
 145
 146   $maybe_an_object->$_call_if_object(method_name => @args);
 147
 148 If called on an object, calls C<method_name> on it and returns the result,
 149 otherwise returns nothing.
 150
 151 =head1 AUTHOR
 152
 153 mst - Matt S. Trout (cpan:MSTROUT) <mst@shadowcat.co.uk>
 154
 155 =head1 CONTRIBUTORS
 156
 157 None yet. Well volunteered? :)
 158
 159 =head1 COPYRIGHT
 160
 161 Copyright (c) 2012 the Safe::Isa L</AUTHOR> and L</CONTRIBUTORS>
 162 as listed above.
 163
 164 =head1 LICENSE
 165
 166 This library is free software and may be distributed under the same terms
 167 as perl itself.
 168
 169 =cut