Check if a subroutine is being used as an lvalue or an rvalue in Perl - perl

I'm writing some code where I am using a subroutine as both an lvalue and an rvalue to read and write database values. The problem is, I want it to react differently based on whether it is being used as an lvalue or an rvalue.
I want the subroutine to write to the database when it is used as an lvalue, and read from the database when it is used as an rvalue.
Example:
# Write some data
$database->record_name($subscript) = $value;
# Read some data
my $value = $database->record_name($subscript);
The only way I can think of the make this work is to find a way for the subroutine to recognize whether it is being used as an lvalue or an rvalue and react differently for each case.
Is there a way to do this?

Deciding how to behave on whether it was called as an lvalue or not is a bad idea since foo(record_name(...)) would call it as an lvalue.
Instead, you should decide how to behave on whether it is used as an lvalue or not.
You can do that by returning a magical value.
use Variable::Magic qw( cast wizard );
my $wiz = wizard(
data => sub { shift; \#_ },
get => sub { my ($ref, $args) = #_; $$ref = get_record_name(#$args); },
set => sub { my ($ref, $args) = #_; set_record_name(#$args, $$ref); },
);
sub record_name :lvalue {
cast(my $rv, $wiz, #_);
return $rv;
}
A little test:
use Data::Dumper;
sub get_record_name { print("get: #_\n"); return "val"; }
sub set_record_name { print("set: #_\n"); }
my $x = record_name("abc", "def"); # Called as rvalue
record_name("abc", "def") = "xyz"; # Called as lvalue. Used as lvalue.
my $y_ref = \record_name("abc", "def"); # Called as lvalue.
my $y = $$y_ref; # Used as rvalue.
$$y_ref = "xyz"; # Used as lvalue.
Output:
get: abc def
set: abc def xyz
get: abc def
set: abc def xyz
After seeing this, you've surely learned that you should abandon the idea of using an lvalue sub. It's possible to hide all that complexity (such as by using sentinel), but the complexity remains. The fanciness is not worth all the complexity. Use separate setters and getters or use an accessor whose role is based on the number of parameters passed to it ($s=acc(); vs acc($s)) instead.

For this situation you might like to try my Sentinel module.
It provides a function you can use in the accessor, to turn it into a more get/set style approach. E.g. you could
use Sentinel qw( sentinel );
sub get_record_name { ... }
sub set_record_name { ... }
sub record_name
{
sentinel get => \&get_record_name,
set => \&set_record_name,
obj => shift;
}
At this point, the following pairs of lines of code are equivalent
$name = $record->record_name;
$name = $record->get_record_name;
$record->record_name = $new_name;
$record->set_record_name( $new_name );
Of course, if you're not needing to provide the specific get_ and set_ prefixed versions of the methods as well, you could inline them as closures.
See the module docs also for further ideas.

In my opinion, lvalue subroutines in Perl were a dumb idea. Just support ->record_name($subscript, $value) as a setter and ->record_name($subscript) as a getter.
That said, you can use the Want module, like this
use Want;
sub record_name:lvalue {
if ( want('LVALUE') ) {
...
}
else {
...
}
}
though that will also treat this as an LVALUE:
foo( $database->record_name($subscript) );
If you want only assignment statements to be treated specially, use want('ASSIGN') instead.

Related

String overloaded variable is considered defined no matter what

I have the following lines in my script:
my $spec = shift;
if (!defined $spec) {
return ("Invalid specification", undef);
}
$spec = "$spec" // '';
I would naturally expect this to, when passed undef, return the warning Invalid specification in the array, with the second item being undef. Instead, the check is passed, and I get a console message warning me about Use of uninitialized value $spec in string on the next line.
$spec is an object with string and number overloading, and is unfortunately written such that attempting to test for truthiness in this particular subroutine (by way of if ($spec) for instance) results in deep recursion and a segfault.
While I am interested in why, exactly, this is happening, I'm more interested in how to make it stop happening. I want to eliminate the console warning, preferable without no warnings qw/uninitialized/. Is this possible, and if so, how do I do it?
You say that $spec is an object with string overloading.
If that's the case then you need to coerce it into String form before checking for it being defined:
if (! defined overload::StrVal($spec)) {
Correction per ysth
As ysth pointed out in the StrVal does not coerce the overloaded stringification:
overload::StrVal(arg)
Gives the string value of arg as in the absence of stringify overloading. If you are using this to get the address of a reference (useful for checking if two references point to the same thing) then you may be better off using Scalar::Util::refaddr() , which is faster.
Therefore to accomplish this, try his other suggestion of:
"$spec" trapping warnings and detecting the uninitialized var warning. Better to add a method to the class to test for whatever case returns undef.
The following demonstrates this approach:
#!/usr/bin/env perl
use strict;
use warnings;
use Test::More tests => 2;
my $obj_str_defined = StringOverloaded->new("has value");
my $obj_str_undef = StringOverloaded->new(undef);
ok( is_overloaded_string_defined($obj_str_defined), qq{\$obj_str_defined is defined} );
ok( !is_overloaded_string_defined($obj_str_undef), qq{\$obj_str_undef is undef} );
sub is_overloaded_string_defined {
my $obj = shift;
my $is_str_defined = 1;
local $SIG{__WARN__} = sub {
$is_str_defined = 0 if $_[0] =~ /Use of uninitialized value \$obj in string/;
};
my $throwaway_var = "$obj";
return $is_str_defined;
}
{
# Object with string overloading
package StringOverloaded;
use strict;
use warnings;
use overload (
'""' => sub {
my $self = shift;
return $$self; # Dereference
},
fallback => 1
);
sub new {
my $pkg = shift;
my $val = shift;
my $self = bless \$val, $pkg;
return $self;
}
}
Output:
1..2
ok 1 - $obj_str_defined is defined
ok 2 - $obj_str_undef is undef

Is there a convenience for safe dereferencing in Perl?

So perl5porters is discussing to add a safe dereferencing operator, to allow stuff like
$ceo_car_color = $company->ceo->car->color
if defined $company
and defined $company->ceo
and defined $company->ceo->car;
to be shortened to e.g.
$ceo_car_color = $company->>ceo->>car->>color;
where $foo->>bar means defined $foo ? $foo->bar : undef.
The question: Is there some module or unobstrusive hack that gets me this operator, or similar behavior with a visually pleasing syntax?
For your enjoyment, I'll list ideas that I was able to come up with.
A multiple derefencing method (looks ugly).
sub multicall {
my $instance = shift // return undef;
for my $method (#_) {
$instance = $instance->$method() // return undef;
}
return $instance;
}
$ceo_car_color = multicall($company, qw(ceo car color));
A wrapper that turns undef into a proxy object (looks even uglier) which returns undef from all function calls.
{ package Safe; sub AUTOLOAD { return undef } }
sub safe { (shift) // bless {}, 'Safe' }
$ceo_car_color = safe(safe(safe($company)->ceo)->car)->color;
Since I have access to the implementations of ceo(), car() and color(), I thought about returning the safe proxy directly from these methods, but then existing code might break:
my $ceo = $company->ceo;
my $car = $ceo->car if defined $ceo; # defined() breaks
Unfortunately, I don't see anything in perldoc overload about overloading the meaning of defined and // in my safe proxy.
Maybe this is not the most useful solution, but it's one more WTDI (a variant of nr. 1) and it's a non-trivial use-case for List::Util's reduce, which are very rare. ;)
Code
#!/usr/bin/env perl
use strict;
use warnings;
use feature 'say';
use List::Util 'reduce';
my $answer = 42;
sub new { bless \$answer }
sub foo { return shift } # just chaining
sub bar { return undef } # break the chain
sub baz { return ${shift()} } # return the answer
sub multicall { reduce { our ($a, $b); $a and $a = $a->$b } #_ }
my $obj = main->new();
say $obj->multicall(qw(foo foo baz)) // 'undef!';
say $obj->multicall(qw(foo bar baz)) // 'undef!';
Output
42
undef!
Note:
Of course it should be
return unless defined $a;
$a = $a->$b;
instead of the shorter $a and $a = $a->$b from above to work correctly with defined but false values, but my point here is to use reduce.
You can use eval:
$ceo_car_color = eval { $company->ceo->car->color };
But it will of course catch any errors, not just calling a method on an undef.

Using a variable as a method name in Perl

I have a perl script (simplified) like so:
my $dh = Stats::Datahandler->new(); ### homebrew module
my %url_map = (
'/(article|blog)/' => \$dh->articleDataHandler,
'/video/' => \$dh->nullDataHandler,
);
Essentially, I'm going to loop through %url_map, and if the current URL matches a key, I want to call the function pointed to by the value of that key:
foreach my $key (keys %url_map) {
if ($url =~ m{$key}) {
$url_map{$key}($url, $visits, $idsite);
$mapped = 1;
last;
}
}
But I'm getting the message:
Can't use string ("/article/") as a subroutine ref while "strict refs" in use at ./test.pl line 236.
Line 236 happens to be the line $url_map{$key}($url, $visits, $idsite);.
I've done similar things in the past, but I'm usually doing it without parameters to the function, and without using a module.
Since this is being answered here despite being a dup, I may as well post the right answer:
What you need to do is store a code reference as the values in your hash. To get a code reference to a method, you can use the UNIVERSAL::can method of all objects. However, this is not enough as the method needs to be passed an invocant. So it is clearest to skip ->can and just write it this way:
my %url_map = (
'/(article|blog)/' => sub {$dh->articleDataHandler(#_)},
'/video/' => sub {$dh->nullDataHandler(#_)},
);
This technique will store code references in the hash that when called with arguments, will in turn call the appropriate methods with those arguments.
This answer omits an important consideration, and that is making sure that caller works correctly in the methods. If you need this, please see the question I linked to above:
How to take code reference to constructor?
You're overthinking the problem. Figure out the string between the two forward slashes, then look up the method name (not reference) in a hash. You can use a scalar variable as a method name in Perl; the value becomes the method you actually call:
%url_map = (
'foo' => 'foo_method',
);
my( $type ) = $url =~ m|\A/(.*?)/|;
my $method = $url_map{$type} or die '...';
$dh->$method( #args );
Try to get rid of any loops where most of the iterations are useless to you. :)
my previous answer, which I don't like even though it's closer to the problem
You can get a reference to a method on a particular object with can (unless you've implemented it yourself to do otherwise):
my $dh = Stats::Datahandler->new(); ### homebrew module
my %url_map = (
'/(article|blog)/' => $dh->can( 'articleDataHandler' ),
'/video/' => $dh->can( 'nullDataHandler' ),
);
The way you have calls the method and takes a reference to the result. That's not what you want for deferred action.
Now, once you have that, you call it as a normal subroutine dereference, not a method call. It already knows its object:
BEGIN {
package Foo;
sub new { bless {}, $_[0] }
sub cat { print "cat is $_[0]!\n"; }
sub dog { print "dog is $_[0]!\n"; }
}
my $foo = Foo->new;
my %hash = (
'cat' => $foo->can( 'cat' ),
'dog' => $foo->can( 'dog' ),
);
my #tries = qw( cat dog catbird dogberg dogberry );
foreach my $try ( #tries ) {
print "Trying $try\n";
foreach my $key ( keys %hash ) {
print "\tTrying $key\n";
if ($try =~ m{$key}) {
$hash{$key}->($try);
last;
}
}
}
The best way to handle this is to wrap your method calls in an anonymous subroutine, which you can invoke later. You can also use the qr operator to store proper regexes to avoid the awkwardness of interpolating patterns into things. For example,
my #url_map = (
{ regex => qr{/(article|blog)/},
method => sub { $dh->articleDataHandler }
},
{ regex => qr{/video/},
method => sub { $dh->nullDataHandler }
}
);
Then run through it like this:
foreach my $map( #url_map ) {
if ( $url =~ $map->{regex} ) {
$map->{method}->();
$mapped = 1;
last;
}
}
This approach uses an array of hashes rather than a flat hash, so each regex can be associated with an anonymous sub ref that contains the code to execute. The ->() syntax dereferences the sub ref and invokes it. You can also pass parameters to the sub ref and they'll be visible in #_ within the sub's block. You can use this to invoke the method with parameters if you want.

Perl: How to create objects on the fly?

My goal is to be able to use $obj like this:
print $obj->hello() . $obj->{foo};
And I would like to create an object inline, maybe using something like this:
my $obj = (
foo => 1,
hello => sub { return 'world' }
);
but when I try to use $obj as an object, I get an error saying that $obj has not been blessed. Is there some base class (like stdClass in PHP) I can use to bless the hash so that I can use it as an object?
For those that know JavaScript, I am trying to do the following, but in Perl:
# JS CODE BELOW
var obj = { foo: 1, hello: function () { return 'world' } };
echo obj.hello() + obj.foo;
Perl would require a little help to do this. Because it doesn't consider code references stored in hashes as "methods". Methods are implemented as entries into a package symbol table. Perl is more class-oriented than JavaScript, which proudly proclaims that it is more object-oriented (on individual objects).
In order to do that functionality, you would have to create a class that mapped references in this way. The way to get around methods in the symbol table is the AUTOLOAD method. If a package contains an AUTOLOAD subroutine, when a call is made to a blessed object that Perl cannot find in the inheritance chain, it will call AUTOLOAD and set the package-scoped (our) variable $AUTOLOAD will contain the full name of the function.
We get the name of the method called, by getting the last node (after the last '::') of the fully-qualified sub name. We look to see if there is a coderef at that location, and if there is, we can return it.
package AutoObject;
use strict;
use warnings;
use Carp;
use Params::Util qw<_CODE>;
our $AUTOLOAD;
sub AUTOLOAD {
my $method_name = substr( $AUTOLOAD, index( $AUTOLOAD, '::' ) + 2 );
my ( $self ) = #_;
my $meth = _CODE( $self->{$method_name} );
unless ( $meth ) {
Carp::croak( "object does not support method='$method_name'!" );
}
goto &$meth;
}
1;
Then you would bless the object into that class:
package main;
my $obj
= bless { foo => 1
, hello => sub { return 'world' }
}, 'AutoObject';
print $obj->hello();
Normally, in an AUTOLOAD sub I "cement" behavior. That is, I create entries into the package symbol table to avoid AUTOLOAD the next time. But that's usually for a reasonably defined class behavior.
I also designed a QuickClass which creates a package for each object declared, but that contains a lot of symbol table wrangling that now days is probably better done with Class::MOP.
Given the suggestion by Eric Strom, you could add the following code into the AutoObject package. The import sub would be called anytime somebody use-d AutoObject (with the parameter 'object').
# Definition:
sub object ($) { return bless $_[0], __PACKAGE__; };
sub import { # gets called when Perl reads 'use AutoObject;'
shift; # my name
return unless $_[0] eq 'object'; # object is it's only export
use Symbol;
*{ Symbol::qualify_to_reference( 'object', scalar caller()) }
= \&object
;
}
And then, when you wanted to create an "object literal", you could just do:
use AutoObject qw<object>;
And the expression would be:
object { foo => 1, hello => sub { return 'world' } };
You could even do:
object { name => 'World'
, hello => sub { return "Hello, $_[0]->{name}"; }
}->hello()
;
And you have an "object literal" expression. Perhaps the module would be better called Object::Literal.
A more Perlish approach is to create a separate namespace for your object's desired methods and to bless the object to make those methods available for your object. The code to do this can still be quite succint.
my $obj = bless { foo => 1 }, "bar";
sub bar::hello { return 'world' };
As gbacon suggests, if you're willing to write $obj->{hello}->() instead of $obj->hello(), you can skip the bless operation.
my $obj = { foo => 1, hello => sub { return 'world' } };
Try Hash::AsObject from CPAN.
In whatever function you're creating the object in, you need to call bless on your object in order to enable method calling.
For example:
package MyClass;
sub new
{
my $obj = {
foo => 1
};
return bless($obj, "MyClass");
}
sub hello
{
my $self = shift;
# Do stuff, including shifting off other arguments if needed
}
package main;
my $obj = MyClass::new();
print "Foo: " . $obj->{foo} . "\n";
$obj->hello();
EDIT: If you want to be able to use subroutine references to provide dynamic functionality for your objects...
First, you can create your code reference like so (within this hash constructor example):
my $obj = {
foo => 1,
hello => sub { print "Hello\n"; },
}
You can then invoke it like this:
my $obj = MyClass::new(); # or whatever
$obj->{hello}->(#myArguments);
A little cumbersome, but it works. (You might not even need the second arrow, but I'm not sure.)
$obj would be a scalar, so whatever you assign to it has to be a scalar as well. You could either say
my %obj = ( foo => 1, hello => sub { return 'world' });
or
my $obj = { foo => 1, hello => sub { return 'world' }};
The latter, with the curly braces, creates a hash reference (which is a scalar, so it can go into $obj). To get to the stuff inside a hash reference, though, you have to use the arrow operator. Something like $obj->{foo} or &{$obj->{hello}}.
Unless you need to have lists of hashes or something like that, it's generally better to use the first method.
Either way, you won't be able to say $obj->hello(). Perl uses that syntax for its own flavor of OOP, which would have the hello function in a separate package that your reference has been blessed into. Like:
package example;
sub new {} { my $result = {}; return bless $result, 'example' }
sub hello { return 'world' }
package main;
my $obj = example->new();
As you can see, the methods you can call are already defined, and it's not trivial to add more. There are magic methods you can use to do such a thing, but really, it's not worth it. &{$obj{hello}} (or &{$obj->{hello}} for a reference) is less effort than trying to make Perl work like Javascript.
It's spelled a little bit differently in Perl:
my $obj = { foo => 1, hello => sub { return "world" } };
print $obj->{hello}() . $obj->{foo};
But the code is awkward. The warning you saw about the reference not being blessed is telling you that your objects aren't implemented in the way Perl expects. The bless operator marks an object with the package in which to begin searching for its methods.
Tell us what you want to do in terms of your problem domain, and we can offer suggestions for a more natural approach in Perl.
Methods in Perl are not properties of the object like they are in Python. Methods are plain regular functions functions in a package associated with the object. Regular functions taking an extra argument for the self reference.
You cannot have dynamically created functions as methods.
Here is a quote from perldoc perlobj:
1. An object is simply a reference that happens to know which class it
belongs to.
2. A class is simply a package that happens to provide methods to deal
with object references.
3. A method is simply a subroutine that expects an object reference
(or a package name, for class methods) as the first argument.
Oh, and bless() is how you establish the connection between the reference and the package.
I recommend using Class::Struct as explained in perltoot man page.
Instead of paraphrasing the documentation, let me quote it as it explained well how this works:
"What it does is provide you a way to "declare" a class as having objects whose fields are of a specific type. The function that does this is called, not surprisingly enough, struct(). Because structures or records are not base types in Perl, each time you want to create a class to provide a record-like data object, you yourself have to define a new() method, plus separate data-access methods for each of that record's fields. You'll quickly become bored with this process. The Class::Struct::struct() function alleviates this tedium."
Still quoting from the doc is an example way on how to implement it:
use Class::Struct qw(struct);
use Jobbie; # user-defined; see below
struct 'Fred' => {
one => '$',
many => '#',
profession => 'Jobbie', # does not call Jobbie->new()
};
$ob = Fred->new(profession => Jobbie->new());
$ob->one("hmmmm");
$ob->many(0, "here");
$ob->many(1, "you");
$ob->many(2, "go");
print "Just set: ", $ob->many(2), "\n";
$ob->profession->salary(10_000);

Best way to use "isa" method?

What is the "best" way to use "isa()" reliably? In other words, so it works correctly on any value, not just an object.
By "best", I mean lack of un-handled corner cases as well as lack of potential performance issues, so this is not a subjective question.
This question mentions two approaches that seem reliable (please note that the old style UNIVERSAL::isa() should not be used, with reasons well documented in the answers to that Q):
eval { $x->isa("Class") }
#and check $# in case $x was not an object, in case $x was not an object
use Scalar::Util 'blessed';
blessed $x && $x ->isa($class);
The first one uses eval, the second uses B:: (at least for non-XS flavor of Scalar::Util).
The first does not seem to work correctly if $x is a scalar containing a class name, as illustrated below, so I'm leaning towards #2 (using blessed) unless somoene indicates a good reason not to.
$ perl5.8 -e '{use IO::Handle;$x="IO::Handle";
eval {$is = $x->isa("IO::Handle")}; print "$is:$#\n";}'
1:
Are there any objective reasons to pick one of these two approaches (or a 3rd one i'm not aware of) such as performance, not handling some special case, etc...?
The Scalar::Util implementation is categorically better. It avoids the overhead of the eval {} which always results in the setting of an additional variable.
perl -we'$#=q[foo]; eval {}; print $#'
The Scalar::Util implementation is easier to read (it doesn't die for a reason that is unknown to the code). If the eval fails too, I believe what happens is you have walk backwards in the tree to the state prior to the eval -- this is how resetting state is achieved. This comes with additional overhead on failure.
Benchmarks
Not an object at all
Rate eval su
eval 256410/s -- -88%
su 2222222/s 767% --
Object passing isa check
Rate su eval
su 1030928/s -- -16%
eval 1234568/s 20% --
Object failing isa check
Rate su eval
su 826446/s -- -9%
eval 909091/s 10% --
Test code:
use strict;
use warnings;
use Benchmark;
use Scalar::Util;
package Foo;
Benchmark::cmpthese(
1_000_000
, {
eval => sub{ eval{ $a->isa(__PACKAGE__) } }
, su => sub { Scalar::Util::blessed $a && $a->isa(__PACKAGE__) }
}
);
package Bar;
$a = bless {};
Benchmark::cmpthese(
1_000_000
, {
eval => sub{ eval{ $a->isa(__PACKAGE__)} }
, su => sub { Scalar::Util::blessed $a && $a->isa(__PACKAGE__) }
}
);
package Baz;
$a = bless {};
Benchmark::cmpthese(
1_000_000
, {
eval => sub{ eval{ $a->isa('duck')} }
, su => sub { Scalar::Util::blessed $a && $a->isa( 'duck' ) }
}
);
I used This is perl, v5.10.1 (*) built for i486-linux-gnu-thread-multi, and Scalar::Util, 1.21
You can wrap the safety checks in a scalar and then use the scalar as a method to keep things clean:
use Scalar::Util 'blessed';
my $isa = sub {blessed $_[0] and $_[0]->isa($_[1])};
my $obj;
if ($obj->$isa('object')) { ... } # returns false instead of throwing an error
$obj = {};
if ($obj->$isa('object')) { ... } # returns false as well
bless $obj => 'object';
if ($obj->$isa('object')) { say "we got an object" }
Note that $obj->$isa(...) is just a different spelling of $isa->($obj, ...) so no method call actually takes place (which is why it avoids throwing any errors).
And here is some code that will allow you to call isa on anything and then inspect the result (inspired by Axeman's answer):
{package ISA::Helper;
use Scalar::Util;
sub new {
my ($class, $obj, $type) = #_;
my $blessed = Scalar::Util::blessed $obj;
bless {
type => $type,
obj => $obj,
blessed => $blessed,
isa => $blessed && $obj->isa($type)
} => $class
}
sub blessed {$_[0]{blessed}}
sub type {$_[0]{isa}}
sub ref {ref $_[0]{obj}}
sub defined {defined $_[0]{obj}}
use overload fallback => 1,
bool => sub {$_[0]{isa}};
sub explain {
my $self = shift;
$self->type ? "object is a $$self{type}" :
$self->blessed ? "object is a $$self{blessed} not a $$self{type}" :
$self->ref ? "object is a reference, but is not blessed" :
$self->defined ? "object is defined, but not a reference"
: "object is not defined"
}
}
my $isa = sub {ISA::Helper->new(#_)};
By placing the code reference in a scalar, it can be called on anything without error:
my #items = (
undef,
5,
'five',
\'ref',
bless( {} => 'Other::Pkg'),
bless( {} => 'My::Obj'),
);
for (#items) {
if (my $ok = $_->$isa('My::Obj')) {
print 'ok: ', $ok->explain, "\n";
} else {
print 'error: ', $ok->explain, "\n";
}
}
print undef->$isa('anything?')->explain, "\n";
my $obj = bless {} => 'Obj';
print $obj->$isa('Obj'), "\n";
my $ref = {};
if (my $reason = $ref->$isa('Object')) {
say "all is well"
} else {
given ($reason) {
when (not $_->defined) {say "not defined"}
when (not $_->ref) {say "not a reference"}
when (not $_->blessed) {say "not a blessed reference"}
when (not $_->type) {say "not correct type"}
}
}
this prints:
error: object is not defined
error: object is defined, but not a reference
error: object is defined, but not a reference
error: object is a reference, but is not blessed
error: object is a Other::Pkg not a My::Obj
ok: object is a My::Obj
object is not defined
1
not a blessed reference
If anyone thinks this is actually useful, let me know, and I will put it up on CPAN.
Here's an update for 2020. Perl v5.32 has the isa operator, also known as the class infix operator. It handles the case where the left-hand argument is not an object it returns false instead of blowing up:
use v5.32;
if( $something isa 'Animal' ) { ... }
This might sound a little bit harsh to Perl, but neither one of these is ideal. Both cover up the fact that objects are a tack on to Perl. The blessed idiom is wordy and contains more than a couple simple pieces.
blessed( $object ) && object->isa( 'Class' )
I would prefer something more like this:
object_isa( $object, 'Class' )
There is no logical operation to get wrong, and most of the unfit uses will be weeded out by the compiler. (Quotes not closed, no comma, parens not closed, calling object_isa instead...)
It would take undefined scalars, simple scalars (unless they are a classname that is a Class), unblessed references, and blessed references that do not extend 'Class' and tell you that no, they are not Class objects. Unless we want to go the route of autobox-ing everything, we're going to need a function that tells us simply.
Perhaps there might be a third parameter for $how_close, but there could also be something like this:
if ( my $ranking = object_isa( $object, 'Class' )) {
...
}
else {
given ( $ranking ) {
when ( NOT_TYPE ) { ... }
when ( NOT_BLESSED ) { ... }
when ( NOT_REF ) { ... }
when ( NOT_DEFINED ) { ... }
}
}
About the only way I can see that we could return this many unique falses is if $ranking was blessed into a class that overloaded the boolean operator to return false unless the function returned the one value indicating an ISA relationship.
However, it could have a few members: EXACTLY, INHERITS, IMPLEMENTS, AGGREGATES or even MOCKS
I get tired of typing this too:
$object->can( 'DOES' ) && $object->DOES( 'role' )
because I try to implement the future-facing DOES in lesser perls (on the idea that people might frown on my polluting UNIVERSAL) on them.