Why does "try" not cause an undefined subroutine error? - perl

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.

Related

Custom missing module message

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...

Devel::Declare removes line from script

I am trying to learn Devel::Declare so as to attempt to reimplement something like PDL::NiceSlice without source filters. I was getting somewhere when I noticed that it was removing the next line from my script. To illustrate I have made this minimal example wherein one can use the comment keyword to remove the entire line from the code, allowing a compile even though barewords abound on that line.
#Comment.pm
package Comment;
use strict;
use warnings;
use Devel::Declare ();
sub import {
my $class = shift;
my $caller = caller;
Devel::Declare->setup_for(
$caller,
{ comment => { const => \&parser } }
);
no strict 'refs';
*{$caller.'::comment'} = sub {};
}
sub parser {
#my $linestr = Devel::Declare::get_linestr;
#print $linestr;
Devel::Declare::set_linestr("");
}
1
and
#!/usr/bin/env perl
#test.pl
use strict;
use warnings;
use Comment;
comment stuff;
print "Print 1\n";
print "Print 2\n";
yields only
Print 2
what am I missing?
P.S. I will probably have a few more questions on D::D coming up if I should figure this one out, so thanks in advance!
Ok so I got it. Using perl -MO=Deparse test.pl you get:
use Comment;
use warnings;
use strict 'refs';
comment("Print 1\n");
print "Print 2\n";
test.pl syntax OK
which tells me that if forces the comment function to be called. After some experimentation I found that I could just set the output to call comment() explicitly so that it doesn't try to call comment on whatever is next.
sub parser {
Devel::Declare::set_linestr("comment();");
}
so that the deparse is:
use Comment;
use warnings;
use strict 'refs';
comment();
print "Print 1\n";
print "Print 2\n";
test.pl syntax OK
and the proper output too.

Perl - Custom Error Output

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";
}

How can I hook into Perl's use/require so I can throw an exception?

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. :-)

Perl: $SIG{__DIE__}, eval { } and stack trace

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.