I would like to be able to output a custom error message to STDERR if one of my modules cannot be found.
From what I understand if I import the module with the use command the lack of the module will be discovered prior to my script being executed which poses a significant problem to achieving the result that I am looking for.
Basically what I am looking for is a Perl equivalent of catching the ImportError exception in Python.
You can use an #INC hook to do this:
BEGIN { push #INC, sub { Carp::croak "Couldn't find $_[1]" } }
use Xyz;
To catch an exception in Perl you should use the eval operator. If the code passed to eval dies, then the error message is put into $# instead for you to use however you like.
It would look something like this
use strict;
use warnings;
use 5.010;
BEGIN {
eval 'use Xyz';
if ( $# ) {
if ( $# =~ /Can't locate (\S+)/ ) {
warn "$1 isn't installed";
}
else {
die $#;
}
}
}
say 'Continuing...';
output
Xyz.pm isn't installed at E:\Perl\source\trap use.pl line 9.
Continuing...
Related
A couple of times I've ran into the situation where I've forgotten to load the Try::Tiny module in my script and I've still used its try-catch block, like this:
#!/usr/bin/env perl
use strict;
use warnings;
try {
call_a( 'x' );
} catch {
die "ACTUALLY die $_";
};
sub call_a {
die "Yes, I will";
}
For some reason, the script works fine without giving any hints that there is no try. No Undefined subroutine errors. This makes me wonder why my raised exceptions are not caught.
Why does this work silently, without an error?
EDIT
I looked into symbol table as well:
say "$_: %main::{ $_ }" for keys %main::;
and found there no try. Also I tried to call it as main::try in the script above, and it caused also no errors.
This is due to the indirect-object syntax, and is a more elaborate variation on this example.
The "indirect object notation" allows code
PackageName->method(#args);
to be written as
method PackageName #args;
So the "try" and "catch" words don't matter. The interesting bit here is the more involved and extended syntax, with two parts, each in this indirect object notation.
The code in question in fact has method BLOCK LIST form, but that also goes by indirect object syntax into (do BLOCK)->method(LIST), where do BLOCK needs to produce a name of a package or a blessed (object) reference for a meaningful method call. This is seen below in Deparse output.
Using B::Deparse compiler backend (via O module) on this code
use strict;
use warnings;
use feature 'say';
try { call_a( 'x' ) }
catch {
die "ACTUALLY die";
#say "NO DONT die";
};
sub call_a {
die "Yes it dies";
#say "no die";
}
as perl -MO=Deparse script.pl should show a very close approximation of what runs:
use warnings;
use strict;
use feature 'say';
try {
call_a('x')
} do {
die 'ACTUALLY die'
}->catch;
sub call_a {
use warnings;
use strict;
use feature 'say';
die 'Yes it dies';
}
undef_sub.pl syntax OK
The nested indirect object syntax is apparently too much for Deparse which still leaves method BLOCK LIST form in the output. The equivalent code can be spelled out as
(do { call_a('x') })->try( (do { die("ACTUALLY die") })->catch() );
what in this case is more simply
call_a('x')->try( die("ACTUALLY die")->catch() );
Thus the original code is interpreted as valid syntax (!) and it is the contents of the block after try (call_a('x')) that runs first --- so the program dies and never gets to go for the "method" try.
It gets more interesting if we change the example to
use strict;
use warnings;
use feature 'say';
try { call_a( 'x' ) }
catch {
#die "ACTUALLY die";
say "NO DONT die";
};
sub call_a {
#die "Yes it dies";
say "no die";
}
with no die-ing anywhere. Run it with -MO=Deparse to see
use warnings;
use strict;
use feature 'say';
try {
call_a('x')
} (catch {
say 'NO DONT die'
} );
sub call_a {
use warnings;
use strict;
use feature 'say';
say 'no die';
}
undef_sub.pl syntax OK
which is now in a straight-up method {} args syntax (with args itself shown by Deparse in an indirect object notation as well).
The equivalent code is
call_a('x')->try( say("NO DONT die")->catch() );
where first the call_a() goes and, after it returns, then the code for the argument list in the try method call runs next. We aren't running into a die and an actual run goes as
no die
NO DONT die
Can't call method "catch" without a package or object reference at ...
So now a problem with the method "catch" does come up.
Thanks to ikegami for comments
If the block above were to return a name of a package (or object reference) which does have a method catch then the try would finally be attempted as well
use strict;
use warnings;
use feature 'say';
BEGIN {
package Catch;
sub catch { say "In ", (caller(0))[3] };
$INC{"Catch.pm"} = 1;
};
use Catch;
try { call_a( 'x' ) }
catch {
say "NO DONT die";
"Catch";
};
sub call_a { say "no die" }
Now we have the equivalent
call_a('x')->try( do { say("NO DONT die"); 'Catch' }->catch() );
with the output
no die
NO DONT die
In Catch::catch
Can't call method "try" without a package or object reference at undef_sub.pl line 14.
I need to know how to customize my own errors in Perl. For instance, here's some code:
my $filename = 'filaname1.exe';
print "Copying $filename";
copy("$dir_root\\$filename", "$spcl_dir\\$filename");
if ($? == "0") {
print " - Success!\n";
}
else { print " - Failure!\n"; }
I tried to write this and "catch" the error and print "Failure" when I don't get an exit code of 0, and print "Success" when I do. I need to know how I can customize this; I don't really want to use die or anything like that where it will give a somewhat cryptic error (to the end user).
Thanks!
You need to read the documentation on $? in perlvar. This value is:
The status returned by the last pipe
close, backtick ("``") command,
successful call to wait() or
waitpid(), or from the system()
operator.
Your call to copy (presumably from File::Copy) doesn't far into any of those categories, so $? isn't set.
However, if you read the documentation for File::Copy, you'll see that its function all "return 1 on success, 0 on failure". So you can simplify your code a lot.
#!/usr/bin/perl
use strict; use warnings;
use File::Copy;
if (copy('notthere', 'somewhere else')) {
warn "success\n";
} else {
warn "failure: $!\n";
}
Note that I've used "warn" rather than "print" so that the errors go to STDERR. Note, also, the use of $! to display the operating system error. This can, of course, be omitted if it's not user-friendly enough.
Are you using File::Copy? You must be using something, because copy() isn't a perl keyword or built-in function.
The documentation of File::Copy doesn't refer to $? at all, so that's probably your mistake. You want to check the return value, and only if it's zero, refer to $!.
use strict;
use File::Copy qw(copy);
my ($from, $to) = #ARGV;
my $res = copy ($from, $to);
if( $res ){
print "Okay\n";
}
else{
print "Not Okay: $!\n";
}
If a file is already loaded, is there anyway to hook into the use/require so I can throw an exception? In my upcoming nextgen::blacklist, I'm trying to die if certain modules are used. I'm using the object-hook method as mentioned in perldoc -f require: there are three-like hooks object, array with subref, and subref. The example in this post is the object-hook, you can find my attempt of the sub-ref hook in nextgen::blacklist.
The syntax I'm desiring is something like:
perl -Mnextgen -E"use NEXT"
package Foo;
use nextgen;
use NEXT;
Ideally it is supposed to throw a message like this:
nextgen::blacklist violation with import attempt for: [ NEXT (NEXT.pm) ] try 'use mro' instead.
I've tried this a bunch of different ways.
package Class;
use Data::Dumper;
use strict;
use warnings;
sub install {
unshift #main::INC, bless {}, __PACKAGE__
unless ref $main::INC[0] eq __PACKAGE__
;
}
sub reset_cache { undef %main::INC }
sub Class::INC {
my ( $self, $pmfile ) = #_;
warn Dumper [\%main::INC, $pmfile];
#undef %INC;
}
package main;
BEGIN { Class->install; undef %main::INC }
use strict;
use strict;
use strict;
use strict;
use warnings;
use strict;
use warnings;
It seems as if %INC is only set after these hooks. I'm interested in anything that will allow me to throw an exception. If an attempt is made to load/reload a module dispite the status of it as a dependency of other modules that don't use my pragma, I want to die.
package Foo;
use NEXT;
package main;
use Foo; (which uses Next.pm);
use NEXT.pm; ## Throw exception
You probably want to put a coderef onto the beginning #INC, as described in perldoc -f require. From there, you can raise exceptions to prevent certain modules from being loaded, or do nothing to let require carry on with its normal job of looking up the module in the other #INC entries.
$ perl -E'BEGIN { unshift #INC, sub { die q{no NEXT} if pop eq q{NEXT.pm}; () }; }; use Carp; say q{success}'
success
$ perl -E'BEGIN { unshift #INC, sub { die q{no NEXT} if pop eq q{NEXT.pm}; () }; }; use NEXT; say q{success}'
no NEXT at -e line 1.
BEGIN failed--compilation aborted at -e line 1.
If you want that behaviour to be lexical, you should make use of Perl's hints hash %^H. Dealing with that is a little fiddly, so I'd recommend using Devel::Pragma, which can take care of all the gory details for you.
As you pointed out, the #INC hooks won't be executed for a module that's already loaded. If you also need to hook into the use or require of a loaded module, overriding CORE::GLOBAL::require would work, as it is called for every attempt to load a module.
$ perl -E'BEGIN { *CORE::GLOBAL::require = sub { warn #_ } } use NEXT; use NEXT;'
NEXT.pm at -e line 1
NEXT.pm at -e line 1.
Also, as the maintainer of NEXT, I completely approve of preventing people from using it, at all, ever. :-)
I have the following perl code :
use strict;
use warnings;
use Test::Cmd::Common;
my $path = "/something/not/available";
my $test = Test::Cmd::Common->new(string => 'File system operations');
eval{
$test->unlink("$path");
};
ok(!$#, "file unlike");
print "done.\n";
The $test->unlink() line will fail and throw exception. but the problem : eval is not handling that exception and the code execution is being interrupted.
the output :
$ perl test.pl
could not unlink files (/something/not/available): No such file or directory
NO RESULT for test at line 561 of /home/y/lib/perl5/site_perl/5.8/Test/Cmd/Common.pm (Test::Cmd::Common::unlink)
from line 9 of test.pl.
Is eval doing the right job here? or I am misunderstanding something?
F.
From documentation of Test::Cmd::Common: "Removes the specified files. Exits NO RESULT if any file could not be removed for any reason.". And by looking at source, Test::Cmd::Common calls Test::Cmd->no_result, which really does
exit (2);
"exit" cannot be trapped by eval, so it is expected behavior.
This is slightly orthogonal, but if you want to test if an operation "succeeded" or died, use Test::Exception:
use strict;
use warnings;
use Test::More tests => 2;
use Test::Exception;
note 'File system operations';
dies_ok
{ some_operation_which_may_die(); }
'operation died';
throws_ok
{ some_operation_which_may_die(); }
/String we expect to see on death/,
'operation died with expected message';
Requirement is to pass module name and function name from the command-line argument.
I need to get the command-line argument in the program and I need to call that function from that module
For example, calling a try.pl program with 2 arguments: MODULE1(Module name) Display(Function name)
perl try.pl MODULE1 Display
I want to some thing like this, but its not working, please guide me:
use $ARGV[0];
& $ARGV[0]::$ARGV[1]();
Assuming the function is not a class method, try this:
#!/usr/bin/perl
use strict;
use warnings;
my ( $package, $function ) = #ARGV;
eval "use $package (); ${package}::$function()";
die $# if $#;
Keep in mind that this technique is wide open to code injection. (The arguments could easily contain any Perl code instead of a module name.)
There's many ways to do this. One of them is:
#!/usr/bin/perl
use strict;
use warnings;
my ( $package, $function ) = #ARGV;
eval "use $package; 1" or die $#;
$package->$function();
Note the the first argument of the function will be $package.
Assuming the module exports the function, this should do:
perl -Mmodule -e function
If you want to make sure your perl script is secure (or at least, prevent yourself from accidentally doing something stupid), I'd avoid doing any kind of eval on data passed in to the script without at least some kind of checking. But, if you're doing some kind of checking anyway, and you end up explicitly checking the input, you might as well explicitly spell out witch methods you want to call. You could set up a hash with 'known good' methods, thus documenting everything that you want callable and protecting yourself at the same time.
my %routines = (
Module => {
Routine1 => \&Module::Method,
Routine2 => \&Module::Method2,
},
Module2 => {
# and so on
},
);
my $module = shift #ARGV;
my $routine = shift #ARGV;
if (defined $module
&& defined $routine
&& exists $routines{$module} # use `exists` to prevent
&& exists $routines{$module}{$routine}) # unnecessary autovivication
{
$routines{$module}{$routine}->(#ARGV); # with remaining command line args
}
else { } # error handling
As a neat side effect of this method, you can simply iterate through the methods available for any kind of help output:
print "Available commands:\n";
foreach my $module (keys %routines)
{
foreach my $routine (keys %$module)
{
print "$module::$routine\n";
}
}
As per Leon's, if the perl module doesn't export it, you can call it like so
perl -MMyModule -e 'MyModule::doit()'
provided that the sub is in that package.
If it exports the sub all the time (in #EXPORT), then Leon's will work:
perl -MMyModule -e doit
If it is an optional export (in #EXPORT_OK), then you can do it like this.
perl -MMyModule=doit -e doit
But the first will work in any case where the sub is defined to the package, and I'd probably use that one over the last one.
Always start your Perl like this:
use strict;
use warnings 'all';
Then do this:
no strict 'refs';
my ($class, $method) = #_;
(my $file = "$class.pm") =~ s/::/\//g;
require $file;
&{"$class\::$method"}();
Whatever you do, try not to eval "$string" ever.
Well, for your revised question, you can do this:
use strict;
use warnings;
{
no strict;
use Symbol qw<qualify>;
my $symb = qualify( $ARGV[1], $ARGV[0] );
unless ( defined &{$symb} ) {
die "&$ARGV[1] not defined to package $ARGV[0]\::";
}
&{$symb};
}
And because you're specifying it on the command line, the easiest way to include from the command line is the -M flag.
perl -MMyModule try.pl MyModule a_subroutine_which_does_something_cool
But you can always
eval "use $ARGV[0];";
But that's highly susceptible to injection:
perl try.pl "Carp; `do something disastrous`;" no_op
I'd use UNIVERSAL::require. It allows you to require or use a module from a variable. So your code would change to something like this:
use UNIVERSAL::require;
$ARGV[0]->use or die $UNIVERSAL::require::ERROR;
$ARGV[0]::$ARGV[1]();
Disclaimer: I did not test that code and I agree Robert P's comment about there probably being a better solution than passing these as command line arguments.