I want to use a method of an object.
Like $myObject->helloWorld().
However there are a couple of methods so I loop through an array of method names and call the method like this:
my $methodName ="helloWorld";
$myObject->$methodNames;
This works quite nice but some objects don't have all methods.
How can I tell whether $myObject has a method called helloWorld or not?
You can use the UNIVERSAL::can method of all objects to determine what methods it supports:
if ($myObject->can($methodName)) {
$myObject->$methodName;
}
As Eric noted, you can usually use UNIVERSAL::can
It can be used either on an object as in your example ($obj->can($methodName)) or statically, on a class: (CLASS->can($methodName))
Please note that there are possible false negatives associated with using UNIVERSAL::can on objects/classes which have AUTOLOAD-ed methods - see the perldoc for details. So before using can() on an object/class, please be careful to verify that the class in question either does not use AUTOLOAD, or overrides can() to compensate, or uses forward declaration to compensate as described in can()'s perldoc - hat tip to brian d foy)
Also, please be careful to either ONLY call can() on actual objects, or encapsulate it in eval. It will die if called on a non-object (e.g. undef, scalar etc...)
The canonical way to use can is inside an eval block in case the thing that you have in your scalar variable isn't actually an object. You don't have to worry about that because you'll still get the right answer (a non-object or class can't respond to the method):
if( my $ref = eval { $obj->can( $method ) } ) {
$obj->$ref( #args );
}
The can has the added feature that it returns a code reference to the method. Sometimes that can be handy.
I used this method when checking database connections, passed into a function, such as
my $method = "ping";
if(defined ($local_dbh) && eval{ $local_dbh->can($method) } ) {
if ($local_dbh->ping) {
return $local_dbh;
}
}
else {
## do connection
...
}
Related
I have inherited some Perl code which contains a line that is mysterious to me:
my $binary = A->current->config->settings('arg1', 'arg2')
Basically, I am not sure how to find the related code. "A" is NOT a variable in the local code so I thought this was a class hierarchy. However I checked the directory structure to see if the following path existed, but there was none:
A/current/config/settings.pm
Is A->current->config->settings guaranteed to be a nested class hierarchy, or could it be something else? For example could config actually be a property or method of a different object A->current?
Any assistance you could lend tracking this down would be greatly appreciated!
A is a class name, you should find it in A.pm. current should be a method of the class, defined under a sub current in A.pm. It returns an object whose config method is being called which returns an object again whose settings method is being called with arguments 'arg1' and 'arg2' (well, in fact, the object itself is the first argument).
In fact, any of the methods can return a class instead of an object, too.
Step through the code in the perl debugger and see where it takes you.
foo->bar is a method call, meaning that there is likely a subroutine called bar defined in the package referred to by foo (or a superclass), and gives you no information about whether there is a package bar or foo::bar.
Is A->current->config->settings guaranteed to be a nested class hierarchy
You're thinking of A::current::config::settings.
The following are method calls:
INVOCANT->name
INVOCANT->name(LIST)
That means that A->current->config->settings is a chain of method calls.
The only class named in that code is A.
could config actually be a property or method of a different object A->current?
It's the name of a method of the object or class returned by A->current.
How to find the Perl code referenced by this line?
my $binary = A->current->config->settings('arg1', 'arg2');
is short for
my $obj1 = A->current;
my $obj2 = $obj1->config;
my $binary = $obj2->settings('arg1', 'arg2');
Now that you have the objects available, you can find the class of which they are an instance using
say ref($obj) || "Not a reference";
or
use Scalar::Util qw( blessed );
say blessed($obj) // "Not an object";
As explained, you are dealing with a chain of method calls in the class named A, where at least the first one is a class method since it is invoked on the class (A) itself, not on an object.
An easy way to find that class is by using Class::Inspector
use Class::Inspector;
say "Filename: ", Class::Inspector->resolved_filename( 'A' );
which printed the full path to the class I used in my tests. Also see loaded_filename.
Another interesting way to interrogate a class is to add to it at runtime.
Create an object of A and add to it a method of your choice at runtime
my $objA = A->new();
eval q( sub A::get_info { print "$_\n" for (caller(0)) } );
if ($#) { print "Eval: $#" };
eval q( sub A::boom { croak "Stacktrace: " } );
if ($#) { print "Eval: $#" };
$objA->get_info();
$objA->boom();
These are simple examples but you can acquire practically any information from inside a method.
If A happens to not have a method called new (possible) work with methods in the given chain, starting with my $objA = A->current.
Or, you can directly add a subroutine to the package's symbol table
*{A::new_method} = sub { say "A new method" };
$any_obj_of_A->new_method();
which is now also available on all existing instances, as well as on new ones.
I have this subroutine that gets an object on call from the surrounding system (in this case IRSSI-Proxy):
sub my_method {
my ($obj) = #_;
if( not defined ( $obj->{ someProp } ) ) {
die "someProp is undefined in $obj";
}
}
The function prints out the following message: "someProp is undefined in SomePackage:SomeClass=HASH(0x12345678)".
The so called class "SomePackage:SomeClass" has the property "someProp", but the property inside the passsed instance seems to have no value. But the documentation of the surrounding system says there is one.
I am no Perl developer, but maybe you can point me into a specific direction or maybe provide some debugging techniques?
Sorry guys, after experimenting around a bit and reading other scripts, I found the very easy solution: I was just missing an include directive for the package of the class this object was an instance of. All that was missing was use SomePackage; (or in that case use Irssi::Irc;). After that include, obj->{ someProp } magically had the anticipated value other than undefined.
Thanks everyone for the help, though.
We are trying to build an API to support commit() and rollback() automatically, so that we don't have to bother with it anymore. By researching, we have found that using eval {} is the way to go.
For eval {} to know what to do, I have thought of giving the API an array of functions, which it can execute with a foreach without the API having to intepret anything. However, this function might be in a different package.
Let me clarify with an example:
sub handler {
use OSA::SQL;
use OSA::ourAPI;
my #functions = ();
push(#functions, OSA::SQL->add_page($date, $stuff, $foo, $bar));
my $API = OSA::ourAPI->connect();
$API->exec_multi(#functions);
}
The question is: Is it possible to execute the functions in #functions inside of OSA::ourAPI, even if ourAPI has no use OSA::SQL. If not, would it be possible if I use an array reference instead of an array, given that the pointer would point to the known function inside of the memory?
Note: This is the basic idea that we want to base the more complex final version on.
You are NOT adding a function pointer to your array. You are adding teh return value of calling the add_page() subroutine. You have 3 solutions to this:
A. You will need to store (in #functions) an array of arrayrefs of the form [\&OSA::SQL::add_page, #argument_values], meaning you pass in an actual reference to a subroutine (called statically); and then exec_multi will do something like (syntax may not be 100% correct as it's 4am here)
sub exec_multi {
my ($class, $funcs)= #_;
foreach my $f (#$funcs) {
my ($func, #args) = #$f;
my $res = &$func(#args);
print "RES:$res\n";
}
}
Just to re-iterate, this will call individual subs in static version (OSA::SQL::add_page), e.g. WITHOUT passing the package name as the first parameter as a class call OSA::SQL->add_page would. If you want the latter, see the next solution.
B. If you want to call your subs in class context (like in your example, in other words with the class name as a first parameter), you can use ysth's suggestion in the comment.
You will need to store (in #functions) an array of arrayrefs of the form [sub { OSA::SQL->add_page(#argument_values) }], meaning you pass in a reference to a subroutine which will in turn call what you need; and then exec_multi will do something like (syntax may not be 100% correct as it's 4am here)
sub exec_multi {
my ($class, $funcs)= #_;
foreach my $f (#$funcs) {
my ($func) = #$f;
my $res = &$func();
print "RES:$res\n";
}
}
C. You will need to store (in #functions) an array of arrayrefs of the form [ "OSA::SQL", "add_page", #argument_values], meaning you pass in a package and function name; and then exec_multi will do something like (syntax may not be 100% correct as it's 4am here)
my ($package, $sub, #args) = #{ $functions[$i] };
no strict 'refs';
$package->$sub(#args);
use strict 'refs';
If I understood your question correctly, then you don't need to worry about whether ourAPI uses OSA::SQL, since your main code imports it already.
However, since - in #1B - you will be passing a list of packages to exec_multi as first elements of each arrayref, you can do "require $package; $package->import();" in exec_multi. But again, it's completely un-necessary if your handler call already required and loaded each of those packages. And to do it right you need to pass in a list of parameters to import() as well. BUT WHYYYYYY? :)
I simply hate how CGI::Application's accessor for the CGI object is called query.
I would like my instance classes to be able to use an accessor named cgi to get the CGI object associated with the current instance of my CGI::Application subclass.
Here is a self-contained example of what I am doing:
package My::Hello;
sub hello {
my $self =shift;
print "Hello #_\n";
}
package My::Merhaba;
use base 'My::Hello';
sub merhaba {
goto sub { shift->hello(#_) };
}
package main;
My::Merhaba->merhaba('StackOverflow');
This is working as I think it should and I cannot see any problems (say, if I wanted to inherit from My::Merhaba: Subclasses need not know anything about merhaba).
Would it have been better/more correct to write
sub merhaba {
my $self = shift;
return $self->hello(#_);
}
What are the advantages/disadvantages of using goto &NAME for the purpose of aliasing a method name? Is there a better way?
Note: If you have an urge to respond with goto is evil don't do it because this use of Perl's goto is different than what you have in mind.
Your approach with goto is the right one, because it will ensure that caller / wantarray and the like keep working properly.
I would setup the new method like this:
sub merhaba {
if (my $method = eval {$_[0]->can('hello')}) {
goto &$method
} else {
# error code here
}
}
Or if you don't want to use inheritance, you can add the new method to the existing package from your calling code:
*My::Hello::merhaba = \&My::Hello::hello;
# or you can use = My::Hello->can('hello');
then you can call:
My::Hello->merhaba('StackOverflow');
and get the desired result.
Either way would work, the inheritance route is more maintainable, but adding the method to the existing package would result in faster method calls.
Edit:
As pointed out in the comments, there are a few cases were the glob assignment will run afoul with inheritance, so if in doubt, use the first method (creating a new method in a sub package).
Michael Carman suggested combining both techniques into a self redefining function:
sub merhaba {
if (my $method = eval { $_[0]->can('hello') }) {
no warnings 'redefine';
*merhaba = $method;
goto &merhaba;
}
die "Can't make 'merhaba' an alias for 'hello'";
}
You can alias the subroutines by manipulating the symbol table:
*My::Merhaba::merhaba = \&My::Hello::hello;
Some examples can be found here.
I'm not sure what the right way is, but Adam Kennedy uses your second method (i.e. without goto) in Method::Alias (click here to go directly to the source code).
This is sort of a combination of Quick-n-Dirty with a modicum of indirection using UNIVERSAL::can.
package My::Merhaba;
use base 'My::Hello';
# ...
*merhaba = __PACKAGE__->can( 'hello' );
And you'll have a sub called "merhaba" in this package that aliases My::Hello::hello. You are simply saying that whatever this package would otherwise do under the name hello it can do under the name merhaba.
However, this is insufficient in the possibility that some code decorator might change the sub that *My::Hello::hello{CODE} points to. In that case, Method::Alias might be the appropriate way to specify a method, as molecules suggests.
However, if it is a rather well-controlled library where you control both the parent and child categories, then the method above is slimmmer.
I currently use a block eval to test that I've set an attribute as read-only. Is there a simpler way to do this?
Example from working code:
#Test that sample_for is ready only
eval { $snp_obj->sample_for('t/sample_manifest2.txt');};
like($#, qr/read-only/xms, "'sample_for' is read-only");
UPDATE
Thanks to friedo, Ether, and Robert P for their answers and to Ether, Robert P, and jrockway for their comments.
I like how Ether's answer ensures that $is_read_only is only a true or false value (i.e. but never a coderef) by negating it with a !. Double negation also provides that. Thus, you can use $is_read_only in an is() function, without it printing out the coderef.
See Robert P's answer below for the most complete answer. Everyone has been very helpful and built on each other's answers and comments. Overall, I think he's helped me the most, hence his is now marked the accepted answer. Again, thanks to Ether, Robert P, friedo, and jrockway.
In case you might be wondering, as I did at first, here is documentation about the difference between get_attribute and find_attribute_by_name (from Class::MOP::Class):
$metaclass->get_attribute($attribute_name)
This will return a Class::MOP::Attribute for the specified $attribute_name. If the
class does not have the specified attribute, it returns undef.
NOTE that get_attribute does not search superclasses, for that you need to use
find_attribute_by_name.
Technically, an attribute does not need to have a read or a write method. Most of the time it will, but not always. An example (graciously stolen from jrockway's comment) is below:
has foo => (
isa => 'ArrayRef',
traits => ['Array'],
handles => { add_foo => 'push', get_foo => 'pop' }
)
This attribute will exist, but not have standard readers and writers.
So to test in every situation that an attribute has been defined as is => 'RO', you need to check both the write and the read method. You could do it with this subroutine:
# returns the read method if it exists, or undef otherwise.
sub attribute_is_read_only {
my ($obj, $attribute_name) = #_;
my $attribute = $obj->meta->get_attribute($attribute_name);
return unless defined $attribute;
return (! $attribute->get_write_method() && $attribute->get_read_method());
}
Alternatively, you could add a double negation before the last return to boolify the return value:
return !! (! $attribute->get_write_method() && $attribute->get_read_method());
As documented in Class::MOP::Attribute:
my $attr = $this->meta->find_attribute_by_name($attr_name);
my $is_read_only = ! $attr->get_write_method();
$attr->get_write_method() will get the writer method (either one you created or one that was generated), or undef if there isn't one.
You should be able to get this from the object's metaclass:
unless ( $snp_obj->meta->get_attribute( 'sample_for' )->get_write_method ) {
# no write method, so it's read-only
}
See Class::MOP::Attribute for more.