I'm working on a test framework in Perl. As part of the tests, I may need to add precondition or postcondition checks for any given test, but not necessarily for all of them. What I've got so far is something like:
eval "&verify_precondition_TEST$n";
print $# if $#;
Unfortunately, this outputs "Undefined subroutine &verify_precondition_TEST1 called at ..." if the function does not exist.
How can I determine ahead of time whether the function exists, before trying to call it?
Package::Name->can('function')
or
*Package::Name::function{CODE}
# or no strict; *{ "Package::Name::$function" }{CODE}
or just live with the exception. If you call the function in an eval and $# is set, then you can't call the function.
Finally, it sounds like you may want Test::Class instead of writing this yourself.
Edit: defined &function_name (or the no strict; defined &{ $function_name } variant), as mentioned in the other answers, looks to be the best way. UNIVERSAL::can is best for something you're going to call as a method (stylistically), and why bother messing around with the symbol table when Perl gives you syntax to do what you want.
Learning++ :)
sub function_exists {
no strict 'refs';
my $funcname = shift;
return \&{$funcname} if defined &{$funcname};
return;
}
if (my $subref = function_exists("verify_precondition_TEST$n") {
...
}
With defined:
if (eval "defined(&verify_precondition_TEST$n)") {
eval "&verify_precondition_TEST$n";
print $# if $#;
}
else {
print "verify_precondition_TEST$n does not exist\n";
}
EDIT: hmm, I only thought of eval as it was in the question but with symbolic references brought up with Leon Timmermans, couldn't you do
if (defined(&{"verify_precondition_TEST$n"}) {
&{"verify_precondition_TEST$n"};
print $# if $#;
}
else {
print "verify_precondition_TEST$n does not exist\n";
}
even with strict?
I had used Leon's approach, but when I had multiple packages, it failed. I'm not sure precisely why; I think it relates to the propagation of scope between namespaces. This is the solution I came up with.
my %symbols = ();
my $package = __PACKAGE__; # bring it in at run-time
{
no strict;
%symbols = %{$package . "::"}; #S ee Symbol Tables on perlmod
}
print "$funcname not defined\n" if (!defined($symbols{$funcname});
References:
__PACKAGE__ reference on the perlmod page.
Packages/__PACKAGE__reference on Perl Training Australia.
Related
awesome programmers.... im trying to studying perl opengl... i install all the modules and it went ok.. everythings fine! except for this...
my first code is
use OpenGL;
use SDL;
glpOpenWindow();
print "Return to exit\n";
while(<>){
exit;
}
and the result is
Goto undefined subroutine &AutoLoader::AUTOLOAD at C:/strawberry/perl/site/lib/OpenGL.pm line 6110.
i tried the test.pl of OpenGL.. awesomely works fine but this line of me is weird!
Below is the source code of method AUTOLOAD from OpenGL.pm
sub AUTOLOAD {
# This AUTOLOAD is used to 'autoload' constants from the constant()
# XS function. If a constant is not found then control is passed
# to the AUTOLOAD in AutoLoader.
# NOTE: THIS AUTOLOAD FUNCTION IS FLAWED (but is the best we can do for now).
# Avoid old-style ``&CONST'' usage. Either remove the ``&'' or add ``()''.
if (#_ > 0) {
# Is it an old OpenGL-0.4 function? If so, remap it to newer variant
local($constname);
($constname = $AUTOLOAD) =~ s/.*:://;
if (grep ($_ eq $constname, #rename_old)) {
eval "sub $AUTOLOAD { $AUTOLOAD" . "_s(\#_) }";
goto &$AUTOLOAD;
}
$AutoLoader::AUTOLOAD = $AUTOLOAD;
goto &AutoLoader::AUTOLOAD; #LINE 6110
}
They have put in comment that THIS AUTOLOAD FUNCTION IS FLAWED so maybe the warning you are getting is not due to your program but the problem with module itself.
i am switching my application from Perl 5.8.8 to Perl 5.16.3 and now i get tons of warnings about the following third party code in SOAP::Lite
unless (defined %{"$protocol_class\::Client::" )
The code produces the following warings:
Warning in Perl code: \t(Maybe you should just omit the defined()?)
Warning in Perl code: defined(%hash) is deprecated at /.../SOAP/Lite.pm
line ...
If i reduce it to a simple example it looks like
unless( defined %{"some::string"} )
Question: Why should someone interpret a string "some::string" as a hash %{"some::string"} and check if the hash is defined? It doen't make any sense to me. I want to replace this codepiece with something else without breaking the third party module so i can focus on real important warnings and errors.
Here is the whole function. I don't know if this helps because think its some kind of Guru code which is a little bit hard to understand
sub proxy {
my $self = shift;
$self = $self->new() if not ref $self;
my $class = ref $self;
return $self->{_proxy} unless #_;
$_[0] =~ /^(\w+):/ or die "proxy: transport protocol not specified\n";
my $protocol = uc "$1"; # untainted now
# HTTPS is handled by HTTP class
$protocol =~s/^HTTPS$/HTTP/;
(my $protocol_class = "${class}::$protocol") =~ s/-/_/g;
no strict 'refs';
unless (defined %{"$protocol_class\::Client::"}
&& UNIVERSAL::can("$protocol_class\::Client" => 'new')
) {
eval "require $protocol_class";
die "Unsupported protocol '$protocol'\n"
if $# =~ m!^Can\'t locate SOAP/Transport/!;
die if $#;
}
$protocol_class .= "::Client";
return $self->{_proxy} = $protocol_class->new(endpoint => shift, #_);
}
The construct %Package:: gives access to a package's stash, i.e. the symbol table hash.
All this code is doing is checking whether a given package has been loaded (in which case its stash will exist) and that there is a new method for the package. If not then require is used to load the module.
The call to UNIVERSAL::can('package', 'method') is normally written as 'package'->can('method') and you can change that here if you like, but the code will work as it stands.
I suggest you do just as the warnings say, and omit the defined. It would also be nicer if you put the package name in its own variable instead of using the interpolated double-quoted string twice, and you can use the conventional call to can as I have described. It would look like this
my $package = "${protocol_class}::Client";
unless ( %{"${package}::"} and $package->can('new') ) {
# load missing module
}
In Perl we can get the name of the current package and current line number Using the predefined variables like __PACKAGE__ and __LINE__.
Like this I want to get the name of the current subroutine:
use strict;
use warnings;
print __PACKAGE__;
sub test()
{
print __LINE__;
}
&test();
In the above code I want to get the name of the subroutine inside the function test.
Use the caller() function:
my $sub_name = (caller(0))[3];
This will give you the name of the current subroutine, including its package (e.g. 'main::test'). Closures return names like 'main::__ANON__'and in eval it will be '(eval)'.
caller is the right way to do at #eugene pointed out if you want to do this inside the subroutine.
If you want another piece of your program to be able to identify the package and name information for a coderef, use Sub::Identify.
Incidentally, looking at
sub test()
{
print __LINE__;
}
&test();
there are a few important points to mention: First, don't use prototypes unless you are trying to mimic builtins. Second, don't use & when invoking a subroutine unless you specifically need the effects it provides.
Therefore, that snippet is better written as:
sub test
{
print __LINE__;
}
test();
I was just looking for an answer to this question as well, I found caller as well, but I was not interested in the fully qualified path, simply the literal current package name of the sub, so I used:
my $current_sub = (split(/::/,(caller(0))[3]))[-1];
Seems to work perfectly, just adding it in for if anyone else trips over this questions :)
There special __SUB__ exists from perl-5.16.
use v5.16;
use Sub::Identify qw/sub_fullname/;
sub foo {
print sub_fullname( __SUB__ ); # main::foo
}
foo();
Actually you can pass to sub_fullname any subroutine reference (even anonymous):
use Sub::Identify qw/sub_fullname/;
sub foo {
print sub_fullname( \&foo ); # main::foo
print sub_fullname( sub{} ); # main::__ANON__
}
foo();
How do you loop over all the methods of a class in Perl? Are there any good online references to Perl introspection or reflection?
The recommendation Todd Gardner gave to use Moose is a good one, but the example code he chose isn't very helpful.
If you're inspecting a non-Moose using class, you'd do something like this:
use Some::Class;
use Class::MOP;
my $meta = Class::MOP::Class->initialize('Some::Class');
for my $meth ( $meta->get_all_methods ) {
print $meth->fully_qualified_name, "\n";
}
See the Class::MOP::Class docs for more details on how to do introspection.
You'll also note that I used Class::MOP instead of Moose. Class::MOP (MOP = Meta-Object Protocol) is the base on which Moose builds. If you're working with non-Moose classes, using Moose to introspect doesn't gain you anything.
If you wanted, you could use Moose () and Moose::Meta::Class->initialize instead of CMOP.
You can easily get a list of the defined methods of a class using the answers already provided. However, Perl is a dynamic language, which means more methods may be defined later. There really isn't a way to get a list of all of the methods to which any particular class will handle. For a lot more detail on this sort of stuff, I have a few chapters in Mastering Perl.
People are giving you (and upvoting) answers without telling you about the limitations.
Adam mentions his Class::Inspector, but it doesn't really work because it's trying to do something a dynamic language doesn't do (and that's be static :) For instance, here's a snippet where Class::Inspector returns no methods, but I can still call the VERSION method (as well as isa and can):
BEGIN {
package Foo;
our $VERSION = '1.23'
}
use Class::Inspector;
my $methods = Class::Inspector->methods( 'Foo' );
print "Methods are [#$methods]\n"; # reports nothing
print Foo->VERSION, "\n";
Here's another case where I can call any method I like, but Class::Inspector only returns AUTOLOAD (and still missing VERSION, isa, and can):
BEGIN {
package Foo;
our $VERSION = '1.23';
my $object = bless {}, __PACKAGE__;
sub AUTOLOAD { $object }
}
use Class::Inspector;
my $methods = Class::Inspector->methods( 'Foo' );
print "Methods are [#$methods]\n"; # reports only "AUTOLOAD"
print Foo->dog->cat->bird, "\n";
Curiously, everyone seems to ignore UNIVERSAL, probably because they don't explicitly handle it since it's only virtually in #ISA. I can add a debug method to every class, and Class::Inspector still misses it even though it's a defined method:
BEGIN {
sub UNIVERSAL::debug { "Hello debugger!\n" }
package Foo;
}
use Class::Inspector;
my $methods = Class::Inspector->methods( 'Foo' );
print "Methods are [#$methods]\n"; # still reports nothing
print Foo->debug, "\n";
Class::MOP has the same limitations.
Not every module is going to use AUTOLOAD, but it's not an obscure or rare feature either. If you don't mind that you are going to miss some of the methods then Class::Inspector or Class::MOP might be okay. It's just not going to give you a list of every method you can call on a class or an object in every case.
If you have a class or an object and you want to know if you can call a particular method, use can(). Wrap it in an eval block so can can call can() on things that aren't even objects to still get back false, instead of death, in those cases:
if( eval { $object->can( 'method_name' ) } )
{
$object->( #args );
}
In the general case, you'll have to inspect the symbol table (unless you use Moose). For example, to list the methods defined in the IO::File package:
use IO::File;
no strict 'refs';
print join ', ', grep { defined &{"IO::File::$_"} } keys %{IO::File::};
The hash %{IO::File::} is the symbol table of the IO::File package, and the grep filters out non-subroutine entries (e.g. package variables).
To extend this to include inherited methods, you have to recursively search the symbol tables of the parent classes (#IO::File::ISA).
Here is a complete example:
sub list_methods_for_class {
my $class = shift;
eval "require $class";
no strict 'refs';
my #methods = grep { defined &{$class . "::$_"} } keys %{$class . "::"};
push #methods, list_methods_for_class($_) foreach #{$class . "::ISA"};
return #methods;
}
For more info on packages and symbol tables, see the perlmod man page.
Depends if you mean, any class, or if you were implementing your own. For the latter, I use Moose, which offers a very clean syntax for these features. From the cookbook:
my %attributes = %{ $self->meta->get_attribute_map };
for my $name ( sort keys %attributes ) {
my $attribute = $attributes{$name};
if ( $attribute->does('MyApp::Meta::Attribute::Trait::Labeled')
# ... keeps on
You probably want Class::Inspector->methods('Your::Class').
Nuff said.
I'll just leave this here for when I forget it. This is extremely powerful; too bad it is so out of the way that most Perl programmers never get to experience it.
package Foo;
use strict;
sub foo1 {};
sub foo2 {};
our $foo3 = sub{};
my $foo4 = "hello, world!";
package Bar;
use strict;
# woo, we're javascript!
(sub {
*Bar::foo1 = sub { print "hi!"; };
*Bar::foo2 = sub { print "hello!"; };
$Bar::foo1 = 200;
})->();
package main;
use strict;
use Data::Dumper;
$Data::Dumper::Deparse = 1;
print Dumper \%Data::Dumper::;
print Dumper \%Foo::;
print Dumper \%Bar::;
I have a piece of Perl code somewhat like the following (strongly simplified): There are some levels of nested subroutine calls (actually, methods), and some of the inner ones do their own exception handling:
sub outer { middle() }
sub middle {
eval { inner() };
if ( my $x = $# ) { # caught exception
if (ref $x eq 'ARRAY') {
print "we can handle this ...";
}
else {
die $x; # rethrow
}
}
}
sub inner { die "OH NOES!" }
Now I want to change that code so that it does the following:
print a full stack trace for every exception that "bubbles up" all the way to the outermost level (sub outer). Specifically, the stack trace should not stop at the first level of "eval { }".
Not having to change the the implementation of any of the inner levels.
Right now, the way I do this is to install a localized __DIE__ handler inside the outer sub:
use Devel::StackTrace;
sub outer {
local $SIG{__DIE__} = sub {
my $error = shift;
my $trace = Devel::StackTrace->new;
print "Error: $error\n",
"Stack Trace:\n",
$trace->as_string;
};
middle();
}
[EDIT: I made a mistake, the code above actually doesn't work the way I want, it actually bypasses the exception handling of the middle sub. So I guess the question should really be: Is the behaviour I want even possible?]
This works perfectly, the only problem is that, if I understand the docs correctly, it relies on behaviour that is explicitly deprecated, namely the fact that __DIE__ handlers are triggered even for "die"s inside of "eval { }"s, which they really shouldn't. Both perlvar and perlsub state that this behaviour might be removed in future versions of Perl.
Is there another way I can achieve this without relying on deprecated behaviour, or is it save to rely on even if the docs say otherwise?
UPDATE: I changed the code to override die globally so that exceptions from other packages can be caught as well.
Does the following do what you want?
#!/usr/bin/perl
use strict;
use warnings;
use Devel::StackTrace;
use ex::override GLOBAL_die => sub {
local *__ANON__ = "custom_die";
warn (
'Error: ', #_, "\n",
"Stack trace:\n",
Devel::StackTrace->new(no_refs => 1)->as_string, "\n",
);
exit 1;
};
use M; # dummy module to functions dying in other modules
outer();
sub outer {
middle( #_ );
M::n(); # M::n dies
}
sub middle {
eval { inner(#_) };
if ( my $x = $# ) { # caught exception
if (ref $x eq 'ARRAY') {
print "we can handle this ...";
}
else {
die $x; # rethrow
}
}
}
sub inner { die "OH NOES!" }
It is not safe to rely on anything that the documentation says is deprecated. The behavior could (and likely will) change in a future release. Relying on deprecated behavior locks you into the version of Perl you're running today.
Unfortunately, I don't see a way around this that meets your criteria. The "right" solution is to modify the inner methods to call Carp::confess instead of die and drop the custom $SIG{__DIE__} handler.
use strict;
use warnings;
use Carp qw'confess';
outer();
sub outer { middle(#_) }
sub middle { eval { inner() }; die $# if $# }
sub inner { confess("OH NOES!") }
__END__
OH NOES! at c:\temp\foo.pl line 11
main::inner() called at c:\temp\foo.pl line 9
eval {...} called at c:\temp\foo.pl line 9
main::middle() called at c:\temp\foo.pl line 7
main::outer() called at c:\temp\foo.pl line 5
Since you're dieing anyway, you may not need to trap the call to inner(). (You don't in your example, your actual code may differ.)
In your example you're trying to return data via $#. You can't do that. Use
my $x = eval { inner(#_) };
instead. (I'm assuming this is just an error in simplifying the code enough to post it here.)
Note that overriding die will only catch actual calls to die, not Perl errors like dereferencing undef.
I don't think the general case is possible; the entire point of eval is to consume errors. You MIGHT be able to rely on the deprecated behavior for exactly this reason: there's no other way to do this at the moment. But I can't find any reasonable way to get a stack trace in every case without potentially breaking whatever error-handling code already exists however far down the stack.