Passing on error message if AUTOLOAD fails - perl

I am using AUTOLOAD to handle calls to some undefined subroutines.
sub AUTOLOAD {
my $member = $AUTOLOAD;
# ... do something if knowing how to handle '$member'
# otherwise ?
}
When calling a non-existent subroutine (say, my_method) on a package, Perl normally says something like
Can't locate object method "my_method" via package "MyPackage"
at Package.pm line 99.
I want Perl to display this standard message in case I don't know how to handle the call to the subroutine $member in my implementation of AUTOLOAD.
How can I do that?
I found no special variable that might contain the appropriate message. Also the Perl documentation on Autoloading gives no hint for this problem.
Remark: I'd like to avoid rewriting the error message, but to use the standard message provided by Perl instead.

No, the message isn't available anywhere. But you can use Carp to add the appropriate line and file:
sub AUTOLOAD {
our $AUTOLOAD;
my ($package,$method) = $AUTOLOAD=~/^(.*)::(.*)/s;
use Carp ();
local $Carp::CarpLevel = 1;
Carp::croak( qq!Can't locate object method "$method" via package "$package"! );
}

Unfortunately, you can't. Perl first attempts to locate a method within the package, then its parent packages in #ISA, and finally UNIVERSAL. Next it repeats that process but searches for AUTOLOAD in lieu of the method name. The only way perl is going to raise an exception at the point of invocation is if no method can be found. If perl has invoked your AUTOLOAD sub, it's already past the point of locating the method and it can only die from within AUTOLOAD's stack frame.
If you absolutely need to die where the method is invoked, your only option is to avoid AUTOLOAD and define all of your methods.
However, this will fake it, if only for the sake of appearance:
sub AUTOLOAD {
my ($package, $method) = $AUTOLOAD =~ /^(.*)::([^:]*)/;
die sprintf(qq{Can't locate object method "%s" via package "%s" at %s line %d.\n},
$method, $package, (caller)[1,2]);
}

Related

How can a Perl subroutine report the line that called it?

I am writing a Perl pipeline, a script that calls various other programs and manages passing data from one to the other. The script (call it pipeline.pl) and the various sub-scripts it manages all share a list of common subroutines defined in subroutines.ph and included via a require subroutines.ph directive.
One of these is a function whose job is to exit printing an error message (the actual subroutine also does some other jobs, but they're not relevant here; no, I am not reinventing die()):
## subroutines.ph
sub errorDie
{
my ($errMsg) = #_;
## various other cleanup tasks here
die($errMsg);
}
1;
And, in pipeline.pl:
#!/usr/bin/perl
require 'subroutines.ph';
errorDie("foo")
Running the script above results in:
foo at subroutines.ph line 5.
Is it possible to have it instead report something like:
foo at pipelines.pl line 4.
So, instead of reporting the line the die() was found on, it should report the line of the original script where the errorDie subroutine was called from. I know I can do this by including the line in the $errMsg variable, but that is fragile and cumbersome. Can this be done automatically? Can a subroutine defined in an external file detect where it was called from?
There is caller , to do this:
https://perldoc.perl.org/functions/caller.html
my ($package, $filename, $line) = caller;
gives you the information you need.
However, as you are talking about debugging generally, you can get a complete backtrace from carp, as mentioned already.
That's the point of Carp's croak.
Pkg.pm:
package Pkg;
use Carp qw( croak );
sub some_func {
my ($cmd, $param) = #_;
$cmd eq 'encode' || $cmd eq 'decode'
or croak("Invalid command \"$cmd\"");
# ...
}
1;
a.pl:
use Pkg;
Pkg::some_func('foo', 'bar');
Output:
Invalid command "foo" at a.pl line 3.

writing reflective method to load variables from conf file, and assigning references?

I'm working with ugly code and trying to do a cleanup by moving values in a module into a configuration file. I want to keep the modules default values if a variable doesn't exist in the conf file, otherwise use the conf file version. There are lots of variables (too many) in the module so I wanted a helper method to support this. This is a first refactoring step, I likely will go further to better handle config variables later, but one step at a time.
I want a method that would take a variable in my module and either load the value from conf or set a default. So something like this (writing this from scratch, so treat it as just pseudocode for now)
Our ($var_a, $var_b ...);
export($var_a, $var_b ...);
my %conf = #load config file
load_var(\$var_a, "foo");
load_var(\$var_b, "$var_abar");
sub load_var($$){
my($variable_ref, $default) = #_
my $variale_name = Dumper($$variable_ref); #get name of variable
my $variable_value = $conf{$variable_name} // $default;
#update original variable by having $variable_ref point to $variable_value
}
So two questions here. First, does anyone know if some functionality like my load_var already exists which I an reuse?
Second, if I have to write it from scratch, can i do it with a perl version older then 5.22? when I read perlref it refers to setting references as being a new feature in 5.22, but it seems odd that such a basic behavior of references wasn't implemented sooner, so I'm wonder if I'm misunderstanding the document. Is there a way to pass a variable to my load_var method and ensure it's actually updated?
For this sort of problem, I would be thinking along the lines of using the AUTOLOAD - I know it's not quite what you asked, but it's sort of doing a similar thing:
If you call a subroutine that is undefined, you would ordinarily get an immediate, fatal error complaining that the subroutine doesn't exist. (Likewise for subroutines being used as methods, when the method doesn't exist in any base class of the class's package.) However, if an AUTOLOAD subroutine is defined in the package or packages used to locate the original subroutine, then that AUTOLOAD subroutine is called with the arguments that would have been passed to the original subroutine.
Something like:
#!/usr/bin/env perl
package Narf;
use Data::Dumper;
use strict;
use warnings;
our $AUTOLOAD;
my %conf = ( fish => 1,
carrot => "banana" );
sub AUTOLOAD {
print "Loading $AUTOLOAD\n";
##read config file
my $target = $AUTOLOAD =~ s/.*:://gr;
print $target;
return $conf{$target} // 0;
}
sub boo {
print "Boo!\n";
}
You can either call it OO style, or just 'normally' - but bear in mind this creates subs, not variables, so you might need to specify the package (or otherwise 'force' an import/export)
#!/usr/bin/env perl
use strict;
use warnings;
use Narf;
print Narf::fish(),"\n";
print Narf::carrot(),"\n";
print Narf::somethingelse(),"\n";
print Narf::boo;
Note - as these are autoloaded, they're not in the local namespace. Related to variables you've got this perlmonks discussion but I'm not convinced that's a good line to take, for all the reasons outlined in Why it's stupid to `use a variable as a variable name'

Is there a way to mock the built-in require function in Perl?

I am developing an application that has to replace an existing mess of spaghetti-code piece by piece. To achieve this I have a dispatcher that runs required HTTP resources when a URI has been matched and otherwise uses the legacy HTTP resource class.
So, this legacy HTTP resource has to require the entry point file of the old system, and I'm trying to figure out how to test this process. The way I see it now is I would like to replace the original require function with a mock subroutine and check that it has been called with an appropriate file name.
Is this possible, and if not, maybe there is a better way to do it?
To override require in a single package:
use subs 'require'; # imports `require` so it can be overridden
sub require {print "mock require: #_\n"}
To override require globally:
BEGIN {
*CORE::GLOBAL::require = sub {print "mock require: #_\n"}
}
And then:
require xyz; # mock require: xyz.pm
require Some::Module; # mock require: Some/Module.pm
A better way to override require globally may be to install a hook into #INC. This little-known functionality is described at the end of the require documentation.
Here's a simple example that intercepts any request for a module whose name begins with HTTP:
BEGIN {
unshift #INC, sub {
my ($self, $file) = #_;
return unless $file =~ /^HTTP/;
print "Creating mock $file\n";
my #code = "1"; # Fake module must return true
return sub { $_ = shift #code; defined $_ };
}
}
require HTTP::Foo;
use HTTPBar;
Note that this also mocks use, since it's based on require.
Hooks can be added as code refs into your #INC path. These will then be applied globally to both use and require statements.
To quote perldoc require
You can also insert hooks into the import facility by putting Perl code directly into the #INC array.
There are three forms of hooks: subroutine references, array references, and blessed objects.
Subroutine references are the simplest case. When the inclusion system walks through #INC and encounters a subroutine, this subroutine gets called with two parameters, the first a reference to itself, and the second the name of the file to be included (e.g., "Foo/Bar.pm"). The subroutine should return either nothing or else a list of up to three values in the following order:
1. A filehandle, from which the file will be read.
2. A reference to a subroutine. If there is no filehandle (previous item), then this subroutine is expected to generate one line of source code per call, writing the line into $_ and returning 1, then finally at end of file returning 0. If there is a filehandle, then the subroutine will be called to act as a simple source filter, with the line as read in $_ . Again, return 1 for each valid line, and 0 after all lines have been returned.
3.Optional state for the subroutine. The state is passed in as $_[1] . A reference to the subroutine itself is passed in as $_[0]
Here's an example:
#!/usr/bin/perl
sub my_inc_hook {
my ($sub_ref, $file) = #_;
unless ($file =~ m{^HTTP/}) {
warn "passing through: $file\n";
return;
}
warn "grokking: $file\n";
return (\*DATA);
}
BEGIN {
unshift(#INC, \&my_inc_hook);
}
use strict;
require warnings;
require HTTP::Bazinga;
HTTP::Bazinga::it_works();
__DATA__
package HTTP::Bazinga;
sub it_works {warn "bazinga!\n"};
1;
Produces:
$ perl inc.pl
passing through: strict.pm
passing through: warnings.pm
grokking: HTTP/Bazinga.pm
bazinga!
I believe this works for perl 5.10.0 and above.

How can I dynamically include Perl modules without using eval?

I need to dynamically include a Perl module, but if possible would like to stay away from eval due to work coding standards. This works:
$module = "My::module";
eval("use $module;");
But I need a way to do it without eval if possible. All google searches lead to the eval method, but none in any other way.
Is it possible to do it without eval?
Use require to load modules at runtime. It often a good idea to wrap this in a block (not string) eval in case the module can't be loaded.
eval {
require My::Module;
My::Module->import();
1;
} or do {
my $error = $#;
# Module load failed. You could recover, try loading
# an alternate module, die with $error...
# whatever's appropriate
};
The reason for the eval {...} or do {...} syntax and making a copy of $# is because $# is a global variable that can be set by many different things. You want to grab the value as atomically as possible to avoid a race condition where something else has set it to a different value.
If you don't know the name of the module until runtime you'll have to do the translation between module name (My::Module) and file name (My/Module.pm) manually:
my $module = 'My::Module';
eval {
(my $file = $module) =~ s|::|/|g;
require $file . '.pm';
$module->import();
1;
} or do {
my $error = $#;
# ...
};
How about using the core module Module::Load
With your example:
use Module::Load;
my $module = "My::module";
load $module;
"Module::Load - runtime require of both modules and files"
"load eliminates the need to know whether you are trying to require either a file or a module."
If it fails it will die with something of the like "Can't locate xxx in #INC (#INC contains: ...".
Well, there's always require as in
require 'My/Module.pm';
My::Module->import();
Note that you lose whatever effects you may have gotten from the import being called at compile time instead of runtime.
Edit: The tradeoffs between this and the eval way are: eval lets you use the normal module syntax and gives you a more explicit error if the module name is invalid (as opposed to merely not found). OTOH, the eval way is (potentially) more subject to arbitrary code injection.
No, it's not possible to without eval, as require() needs the bareword module name, as described at perldoc -f require. However, it's not an evil use of eval, as it doesn't allow injection of arbitrary code (assuming you have control over the contents of the file you are requireing, of course).
EDIT: Code amended below, but I'm leaving the first version up for completeness.
I use I used to use this little sugar module to do dynamic loads at runtime:
package MyApp::Util::RequireClass;
use strict;
use warnings;
use Exporter 'import'; # gives you Exporter's import() method directly
our #EXPORT_OK = qw(requireClass);
# Usage: requireClass(moduleName);
# does not do imports (wrong scope) -- you should do this after calling me: $class->import(#imports);
sub requireClass
{
my ($class) = #_;
eval "require $class" or do { die "Ack, can't load $class: $#" };
}
1;
PS. I'm staring at this definition (I wrote it quite a while ago) and I'm pondering adding this:
$class->export_to_level(1, undef, #imports);... it should work, but is not tested.
EDIT: version 2 now, much nicer without an eval (thanks ysth): :)
package MyApp::Util::RequireClass;
use strict;
use warnings;
use Exporter 'import'; # gives you Exporter's import() method directly
our #EXPORT_OK = qw(requireClass);
# Usage: requireClass(moduleName);
# does not do imports (wrong scope) -- you should do this after calling me: $class->import(#imports);
sub requireClass
{
my ($class) = #_;
(my $file = $class) =~ s|::|/|g;
$file .= '.pm';
require $file; # will die if there was an error
}
1;
Class::MOP on CPAN has a load_class method for this:
http://metacpan.org/pod/Class::MOP
i like doing things like..
require Win32::Console::ANSI if ( $^O eq "MSWin32" );

How can I get around a 'die' call in a Perl library I can't modify?

Yes, the problem is with a library I'm using, and no, I cannot modify it. I need a workaround.
Basically, I'm dealing with a badly written Perl library, that exits with 'die' when a certain error condition is encountered reading a file. I call this routine from a program which is looping through thousands of files, a handful of which are bad. Bad files happen; I just want my routine to log an error and move on.
IF I COULD modify the library, I would simply change the
die "error";
to a
print "error";return;
, but I cannot. Is there any way I can couch the routine so that the bad files won't crash the entire process?
FOLLOWUP QUESTION: Using an "eval" to couch the crash-prone call works nicely, but how do I set up handling for catch-able errors within that framework? To describe:
I have a subroutine that calls the library-which-crashes-sometimes many times. Rather than couch each call within this subroutine with an eval{}, I just allow it to die, and use an eval{} on the level that calls my subroutine:
my $status=eval{function($param);};
unless($status){print $#; next;}; # print error and go to next file if function() fails
However, there are error conditions that I can and do catch in function(). What is the most proper/elegant way to design the error-catching in the subroutine and the calling routine so that I get the correct behavior for both caught and uncaught errors?
You could wrap it in an eval. See:
perldoc -f eval
For instance, you could write:
# warn if routine calls die
eval { routine_might_die }; warn $# if $#;
This will turn the fatal error into a warning, which is more or less what you suggested. If die is called, $# contains the string passed to it.
Does it trap $SIG{__DIE__}? If it does, then it's more local than you are. But there are a couple strategies:
You can evoke its package and override die:
package Library::Dumb::Dyer;
use subs 'die';
sub die {
my ( $package, $file, $line ) = caller();
unless ( $decider->decide( $file, $package, $line ) eq 'DUMB' ) {
say "It's a good death.";
die #_;
}
}
If not, can trap it. (look for $SIG on the page, markdown is not handling the full link.)
my $old_die_handler = $SIG{__DIE__};
sub _death_handler {
my ( $package, $file, $line ) = caller();
unless ( $decider->decide( $file, $package, $line ) eq 'DUMB DIE' ) {
say "It's a good death.";
goto &$old_die_handler;
}
}
$SIG{__DIE__} = \&_death_handler;
You might have to scan the library, find a sub that it always calls, and use that to load your $SIG handler by overriding that.
my $dumb_package_do_something_dumb = \&Dumb::do_something_dumb;
*Dumb::do_something_dumb = sub {
$SIG{__DIE__} = ...
goto &$dumb_package_do_something_dumb;
};
Or override a builtin that it always calls...
package Dumb;
use subs 'chdir';
sub chdir {
$SIG{__DIE__} = ...
CORE::chdir #_;
};
If all else fails, you can whip the horse's eyes with this:
package CORE::GLOBAL;
use subs 'die';
sub die {
...
CORE::die #_;
}
This will override die globally, the only way you can get back die is to address it as CORE::die.
Some combination of this will work.
Although changing a die to not die has a specific solution as shown in the other answers, in general you can always override subroutines in other packages. You don't change the original source at all.
First, load the original package so you get all of the original definitions. Once the original is in place, you can redefine the troublesome subroutine:
BEGIN {
use Original::Lib;
no warnings 'redefine';
sub Original::Lib::some_sub { ... }
}
You can even cut and paste the original definition and tweak what you need. It's not a great solution, but if you can't change the original source (or want to try something before you change the original), it can work.
Besides that, you can copy the original source file into a separate directory for your application. Since you control that directory, you can edit the files in it. You modify that copy and load it by adding that directory to Perl's module search path:
use lib qw(/that/new/directory);
use Original::Lib; # should find the one in /that/new/directory
Your copy sticks around even if someone updates the original module (although you might have to merge changes).
I talk about this quite a bit in Mastering Perl, where I show some other techniques to do that sort of thing. The trick is to not break things even more. How you not break things depends on what you are doing.