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.
Related
I am working on a program which uses different subroutines in separate files.
There are three parts
A text file with the name of the subroutine
A Perl program with the subroutine
The main program which extracts the name of the subroutine and launches it
The subroutine takes its data from a text file.
I need the user to choose the text file, the program then extracts the name of the subroutine.
The text file contains
cycle.name=cycle01
Here is the main program :
# !/usr/bin/perl -w
use strict;
use warnings;
use cycle01;
my $nb_cycle = 10;
# The user chooses a text file
print STDERR "\nfilename: ";
chomp($filename = <STDIN>);
# Extract the name of the cycle
open (my $fh, "<", "$filename.txt") or die "cannot open $filename";
while ( <$fh> ) {
if ( /cycle\.name/ ) {
(undef, $cycleToUse) = split /\s*=\s*/;
}
}
# I then try to launch the subroutine by passing variables.
# This fails because the subroutine is defined as a variable.
$cycleToUse($filename, $nb_cycle);
And here is the subroutine in another file
# !/usr/bin/perl
package cycle01;
use strict;
use warnings;
sub cycle01 {
# Get the total number of arguments passed
my ($filename, $nb_cycle) = #_;
print "$filename, $nb_cycle";
Your code doesn't compile, because in the final call, you have mistyped the name of $nb_cycle. It's helpful if you post code that actually runs :-)
Traditionally, Perl module names start with a capital letter, so you might want to rename your package to Cycle01.
The quick and dirty way to do this is to use the string version of eval. But evaluating an arbitrary string containing code is dangerous, so I'm not going to show you that. The best way is to use a dispatch table - basically a hash where the keys are valid subroutine names and the values are references to the subroutines themselves. The best place to add this is in the Cycle01.pm file:
our %subs = (
cycle01 => \&cycle01,
);
Then, the end of your program becomes:
if (exists $Cycle01::subs{$cycleToUse}) {
$Cycle01::subs{$cycleToUse}->($filename, $nb_cycle);
} else {
die "$cycleToUse is not a valid subroutine name";
}
(Note that you'll also need to chomp() the lines as you read them in your while loop.)
To build on Dave Cross' answer, I usually avoid the hash table, partly because, in perl, everything is a hash table anyway. Instead, I have all my entry-point subs start with a particular prefix, that prefix depends on what I'm doing, but here we'll just use ep_ for entry-point. And then I do something like this:
my $subname = 'ep_' . $cycleToUse;
if (my $func = Cycle01->can($subname))
{
$func->($filename, $nb_cycle);
}
else
{
die "$cycleToUse is not a valid subroutine name";
}
The can method in UNIVERSAL extracts the CODE reference for me from perl's hash tables, instead of me maintaining my own (and forgetting to update it). The prefix allows me to have other functions and methods in that same namespace that cannot be called by the user code directly, allowing me to still refactor code into common functions, etc.
If you want to have other namespaces as well, I would suggest having them all be in a single parent namespace, and potentially all prefixed the same way, and, ideally, don't allow :: or ' (single quote) in those names, so that you minimise the scope of what the user might call to only that which you're willing to test.
e.g.,
die "Invalid namespace $cycleNameSpaceToUse"
if $cycleNameSpaceToUse =~ /::|'/;
my $ns = 'UserCallable::' . $cycleNameSpaceToUse;
my $subname = 'ep_' . $cycleToUse;
if (my $func = $ns->can($subname))
# ... as before
There are definitely advantages to doing it the other way, such as being explicit about what you want to expose. The advantage here is in not having to maintain a separate list. I'm always horrible at doing that.
I want to scan a code base to identify all instances of undefined subroutines that are not presently reachable.
As an example:
use strict;
use warnings;
my $flag = 0;
if ( $flag ) {
undefined_sub();
}
Observations
When $flag evaluates to true, the following warning is emitted:
Undefined subroutine &main::undefined_sub called at - line 6
I don't want to rely on warnings issued at run-time to identify undefined subroutines
The strict and warnings pragmas don't help here. use strict 'subs' has no effect.
Even the following code snippet is silent
$ perl -Mstrict -we 'exit 0; undefined_sub()'
Perhaps Subroutines::ProhibitCallsToUndeclaredSubs policy from Perl::Critic can help
This Policy checks that every unqualified subroutine call has a matching subroutine declaration in the current file, or that it explicitly appears in the import list for one of the included modules.
This "policy" is a part of Perl::Critic::StricterSubs, which needs to be installed. There are a few more policies there. This is considered a severity 4 violation, so you can do
perlcritic -4 script.pl
and parse the output for neither declared nor explicitly imported, or use
perlcritic -4 --single-policy ProhibitCallsToUndeclaredSubs script.pl
Some legitimate uses are still flagged, since it requires all subs to be imported explicitly.
This is a static analyzer, which I think should fit your purpose.
What you're asking for is in at least some sense impossible. Consider the following code snippet:
( rand()<0.5 ? *foo : *bar } = sub { say "Hello World!" };
foo();
There is a 50% chance that this will run OK, and a 50% chance that it will give an "Undefined subroutine" error. The decision is made at runtime, so it's not possible to tell before that what it will be. This is of course a contrived case to demonstrate a point, but runtime (or compile-time) generation of subroutines is not that uncommon in real code. For an example, look at how Moose adds functions that create methods. Static source code analysis will never be able to fully analyze such code.
B::Lint is probably about as good as something pre-runtime can get.
To find calls to subs that aren't defined at compile time, you can use B::Lint as follows:
a.pl:
use List::Util qw( min );
sub defined_sub { }
sub defined_later;
sub undefined_sub;
defined_sub();
defined_later();
undefined_sub();
undeclared_sub();
min();
max(); # XXX Didn't import
List::Util::max();
List::Util::mac(); # XXX Typo!
sub defined_later { }
Test:
$ perl -MO=Lint,undefined-subs a.pl
Undefined subroutine 'undefined_sub' called at a.pl line 9
Nonexistent subroutine 'undeclared_sub' called at a.pl line 10
Nonexistent subroutine 'max' called at a.pl line 12
Nonexistent subroutine 'List::Util::mac' called at a.pl line 14
a.pl syntax OK
Note that this is just for sub calls. Method calls (such as Class->method and method Class) aren't checked. But you are asking about sub calls.
Note that foo $x is a valid method call (using the indirect method call syntax) meaning $x->foo if foo isn't a valid function or sub, so B::Lint won't catch that. But it will catch foo($x).
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]);
}
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.
I have one script i'm trying to call from another script, passing the information from the script that is being called to the calling script. When i use do or require it runs through but doesnt pass the value.
ex.
I have the following line at the bottom of the script that i am calling
called script.pl
print " $hold IS VALUE\n";
which prints me the value of hold.
I then start the calling script with:
calling_script.pl
require 'acc_option.pl';
print "HOLD PASSED IS $hold\n";
but the variable hold doesnt print.
Whats the best way to call this script instead of putting everything on one long ass page?
It depends on how $hold was declared.
If it was lexically declared (with "my $hold...") then you can't get at it directly - it's only accessible within the scope of called_script.pl.
If it's dynamically scoped (local $hold, or our $hold) then you should be able to get at it by prefixing it with the package it was declared under (so if it's in "package Foo;" you can get at it as $Foo::hold").
That said...
You generally don't want to mess around passing variables between scripts. Storing state in global variables can make for some nasty debugging sessions.
As a first step you might want to encapsulate accessing $hold inside a subroutine so in called_script.pl you have something like:
sub is_on_hold { return $hold };
which will return $hold when called (I'm assuming here that $hold is some kind of boolean state indicator. If it isn't name your subroutine in an appropriately intention revealing way :-)
If you describe how you're trying to use $hold in a bit more detail folk might be able to give some more specific advice on a better way of doing your task.
You have started down the right path, but are still a ways off. You should be using modules and the use statment, not code and the require statement. You should try reading perldoc perlmod and perldoc perlmodlib, but the general gist is:
decompose your process into functions
group those functions by what they do
put the groups of functions into modules
write a script that uses the modules and calls the functions
Think of the script as a skeleton and the functions as fleshing out the skeleton.
Here is a simple module and a script that uses it:
ExampleModule.pm:
package ExampleModule;
use strict;
use warnings;
use base 'Exporter';
our #EXPORT_OK = qw/do_first_thing do_second_thing do_third_thing/;
sub do_first_thing {
my ($thing) = #_;
return $thing + 1;
}
sub do_second_thing {
my ($thing) = #_;
return $thing + 1;
}
sub do_third_thing {
my ($thing) = #_;
return $thing + 1;
}
1;
example.pl:
#!/usr/bin/perl
use strict;
use warnings;
use ExampleModule qw/do_first_thing do_second_thing do_third_thing/;
my $thing = 0;
$thing = do_first_thing($thing);
$thing = do_second_thing($thing);
$thing = do_third_thing($thing);
print "$thing\n";