I'm trying to write a simple Perl debugger and I'm running into the following problem.
I'm running the following code as a debugger:
{
package DB;
sub DB { }
sub sub
{
&$sub;
# this is what produces the problem
$i = 1*1;
}
}
1;
I'm loading this in by setting the PERL5DB environment variable - e.g.:
export PERL5DB="BEGIN { require './debugger/tracer.pl'; }
Given this simple little Perl script:
#!/usr/bin/env perl
use Getopt::Long;
print "hello world";
I'm running the script as:
perl -d test.pl
When run, it generates the following error:
$ perl -d test.pl
Goto undefined subroutine &main::1 at /home/vagrant/perl5/perlbrew/perls/perl-5.16.0/lib/site_perl/5.16.0/Exporter.pm line 25.
BEGIN failed--compilation aborted at test.pl line 6.
I've isolated the problem to anything that is run after the &$sub; call in sub in the debugger. This problem is happening with certain packages being included in the base Perl script - in this case, Getopt::Long, though I've also found the same result with IO::File.
My Perl is pretty rusty, particularly with respect to advanced topics like the debugger.
Can anyone help me understand how I can get code executing after the &$sub; call in sub in the debugger to place nicely with the packages that I'm importing?
Thanks!
When you leave a Perl subroutine without using an explicit return statement, Perl will return the value of the last statement in the subroutine.
In particular, this means that if you have a subroutine that calls another subroutine as its last statement, like this:
package DB {
sub sub {
warn "Hello from DB::sub, about to call $sub\n";
&$sub;
}
}
then the return value of the other subroutine called via &$sub will be passed to the original caller, just as if you'd done an explicit return &$sub.
However, if the &$sub call is not the last thing in your DB::sub subroutine, then Perl will just throw away its return value and instead return the value of you actual last statement — in this case $i = 1*1, which evaluates to the number 1.
Now, when you define a custom debugger like that, Perl will wrap every ordinary subroutine call with a call to your DB::sub subroutine. Thus, your code causes every subroutine call to return the number 1! It's hardly a surprise that this will break a lot of things very badly.
Specifically, based on your error message, it looks like something in the Exporter module (which is used by many other modules to export symbols to the caller's namespace) is calling a subroutine that should return a reference to another subroutine. But since, because of your debugger, it's actually returning 1, the following attempt to call the returned subroutine ends up trying to call a subroutine named 1 (which gets mapped to the main:: package because numeric symbol names are superglobal), which then fails.
But what if you really need to do something in your DB::sub after calling &$sub? Well, the workaround is to save the return value, like this:
package DB {
sub DB { }
sub sub {
warn "Hello from DB::sub, about to call $sub...\n";
# call &sub, save the return value in #rv
my #rv = (wantarray ? &$sub : scalar &$sub);
warn "Hello again from DB::sub, just called $sub and got #rv!\n";
# ...and return the saved return value
return (wantarray ? #rv : $rv[0]);
}
}
1;
(The code is slightly complicated by the fact that our DB::sub might be called in either list or scalar context, and we need to pass the appropriate context on to &$sub. The wantarray should take care of that, though.)
Adding on to the answer from Ilmari Karonen.
DB::sub can also be called in a no value (void) context, therefore the return handling needs to take this into account. Refer to the documentation in wantarray for more details.
The following code handles all three cases.
package DB {
sub DB { }
sub sub {
# call &sub, save the return value in #rv
my #rv;
if(defined(wantarray)) {
#rv = (wantarray ? &$sub : scalar &$sub);
}
else {
# wantarray is undef
&$sub;
}
# after invoking &$sub
# return #rv
if(defined(wantarray)) {
return (wantarray ? #rv : $rv[0]);
}
else {
return undef
}
}
}
1;
Related
There's something quite unclear to me about subs return value.
I like to test my modules, sub by sub, and check whether they issue the correct return value or the correct exception if the case arise.
For example, let's say I have the following code (X::Argument::BadFormat is an exception handler derived from Exception::Class):
package My::Module;
use strict;
use warnings;
sub new{#does things unrelated to the current question}
sub my_sub {
my ($self,$possible_value) = #_;
if ($possible_value =~ q{\w}) { #Affect value to current object
$self->{field} = $possible_value;
}else{ #throw an exception
X::Argument::BadFormat->throw(
arg => 'possible_value',
expected_format => 'something that looks like a word',
received_value => $possible_value,
);
}
}
In the test file, I will run tests such as:
my $object = My::Module->new();
throws_ok(sub {$object->my_sub('*')}, 'X::Argument::BadFormat', 'Faulty value will raise an exception');
ok($object->my_sub('turlututu'));
It is easy to test when:
the sub returns a value,
the test conditions must raise an exception,
However, when I just set the value of a field in the current object, I have no reason to return anything.
In that case:
is the simple execution of the code enough to evaluate the sub output as "true" ?
Shall I add an explicit "return 1;" ?
does the sub actually return the last evaluation, in this case the sucess of the
test in the "if"? Something else I did not think about but which is
obvious to everybody?
In this case, I'd just check to ensure that the object's attribute was set correctly. That's all this particular sub does. If it's set ok, the sub ended correctly. If it wasn't set, something went wrong before the sub ended.
my $p='blah';
$obj->my_sub($p);
is $obj->{field}, $p, "my_sub() set the field attr ok";
It would be better if the field attribute had a getter so you're not breaking encapsulation, but I digress.
A sub that has no need to return a value should end with
return;
In your case, without it, you will be returning the value of $possible_value, which is the last thing executed. This doesn't look like a useful thing to return.
Assuming you add the explicit return:
Your throws_ok test looks fine. You should then test that the field was correctly set. Your ok test isn't needed, since your sub won't be returning anything.
Perl returns the result of the last executed code by default.
For example:
print main();
sub main {
my $var = 9 * 7;
}
print will output 63. If your code may be affected by the output of a given subroutine, then you need to set a return value (it's generally considered a best practice to always set an explicit return at the end of a subroutine/method).
print main();
sub main {
my $var = 9 * 7;
return;
}
print will output nothing.
Personally, I always try to set a return value depending on the context of what the subroutine will be returning to, but if you're writing code other people will be using, then it's generally safest to just do return;.
An additional explanation from Perl::Critic (link to the specific policy):
Subroutine "main" does not end with "return" at line 8, near 'sub main {'.
Subroutines::RequireFinalReturn (Severity: 4)
Require all subroutines to terminate explicitly with one of the
following: return',carp', croak',die', exec',exit', goto', or
throw'.
Subroutines without explicit return statements at their ends can be
confusing. It can be challenging to deduce what the return value will
be.
Furthermore, if the programmer did not mean for there to be a
significant return value, and omits a return statement, some of the
subroutine's inner data can leak to the outside. Consider this case:
package Password;
# every time the user guesses the password wrong, its value
# is rotated by one character
my $password;
sub set_password {
$password = shift;
}
sub check_password {
my $guess = shift;
if ($guess eq $password) {
unlock_secrets();
} else {
$password = (substr $password, 1).(substr $password, 0, 1);
}
}
1;
In this case, the last statement in check_password() is the assignment.
The result of that assignment is the implicit return value, so a wrong
guess returns the right password! Adding a `return;' at the end of that
subroutine solves the problem.
The only exception allowed is an empty subroutine.
Be careful when fixing problems identified by this Policy; don't blindly
put a `return;' statement at the end of every subroutine.
I would like to use a Perl variable from my script in a Log::Log4perl config file. I read the documentation and found that I can use a subroutine, but I would like to do it a little bit simpler, if possible.
I want to set the filename for my appender:
log4perl.appender.av_std_LOGFILE.filename="whateverfilename.log"
But doing this this way, it is a fixed value.
I have the filename in a variable within my script and would like to use this at runtime:
log4perl.appender.av_std_LOGFILE.filename=\
sub { return &av_getLogfileName(); }
Where this is the subroutine:
sub av_getLogfileName
{
return $av_std_LOGFILE;
}
This works, but I would like to avoid the sub inside my script since the return value is very simple.
The documentation says:
Each value starting with the string sub {... is interpreted as Perl code to be executed at the time the application parses the configuration...
So I tried something like this, but it did not work:
log4perl.appender.av_std_LOGFILE.filename=\
sub { print "$av_std_LOGFILE"; }
Is there a way to get result of the variable without the sub inside my script?
print returns 1 on success, so
sub { print "$av_std_LOGFILE"; }
returns 1, not the value of $av_std_LOGFILE. You also have to fully qualify variable names in hooks, which means you'll have to make $av_std_LOGFILE a package global.
Change your hook to:
sub { return $main::av_std_LOGFILE; } # double quotes are unnecessary
and set $av_std_LOGFILE in your script like this (before calling Log::Log4perl::init):
our $av_std_LOGFILE = '/path/to/logfile';
Generally, you should avoid global variables, so I would prefer using a subroutine.
I am new to Perl so I don't know whether it is doable or not.
I am interested in creating an module which would catch all calls performed on it.
The usage of it would be as follows :
$object = new Foo;
$object->blah;
the function name (so in this case "blah" would be cough by Foo and returned as string to a screen).
The bit I don't know how to do is catching the called function name as string.
You might want to check AUTOLOADING
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
my $object = new Foo;
print $object->blah, "\n";
package Foo;
sub new { return bless {}, shift }
# catch-all function
sub AUTOLOAD {
return $AUTOLOAD;
}
outputs Foo::blah
I have a function below in perl
sub create_hash()
{
my #files = #_;
foreach(#files){
if(/.text/)
{
open($files_list{$_},">>$_") || die("This file will not open!");
}
}
}
I am calling this function by passing an array argument like below:
create_hash( #files2);
The array has got around 38 values in it.
But i am getting compilation errors:
Too many arguments for main::create_hash at ....
what is the wrong that i am doing here?
my perl version is :
This is perl, v5.8.4 built for i86pc-solaris-64int
(with 36 registered patches, see perl -V for more detail)
Your problem is right here:
sub create_hash()
{
The () is a prototype. In this case, it indicates that create_hash takes no parameters. When you try to pass it some, Perl complains.
It should look like
sub create_hash
{
In general, you should not use prototypes with Perl functions. They aren't like prototypes in most other languages. They do have uses, but that's a fairly advanced topic in Perl.
May use array reference as:
sub create_hash {
my ($files) = #_;
foreach(#{$files)){
...
}
}
create_hash(\#files2);
I need to remove a method from the Perl symbol table at runtime. I attempted to do this using undef &Square::area, which does delete the function but leaves some traces behind. Specifically, when $square->area() is called, Perl complains that it is "Not a CODE reference" instead of "Undefined subroutine &Square::area called" which is what I expect.
You might ask, "Why does it matter? You deleted the function, why would you call it?" The answer is that I'm not calling it, Perl is. Square inherits from Rectangle, and I want the inheritance chain to pass $square->area through to &Rectangle::area, but instead of skipping Square where the method doesn't exist and then falling through to Rectangle's area(), the method call dies with "Not a CODE reference."
Oddly, this appears to only happen when &Square::area was defined by typeglob assignment (e.g. *area = sub {...}). If the function is defined using the standard sub area {} approach, the code works as expected.
Also interesting, undefining the whole glob works as expected. Just not undefining the subroutine itself.
Here's a short example that illustrates the symptom, and contrasts with correct behavior:
#!/usr/bin/env perl
use strict;
use warnings;
# This generates "Not a CODE reference". Why?
sub howdy; *howdy = sub { "Howdy!\n" };
undef &howdy;
eval { howdy };
print $#;
# Undefined subroutine &main::hi called (as expected)
sub hi { "Hi!\n" }
undef &hi;
eval { hi };
print $#;
# Undefined subroutine &main::hello called (as expected)
sub hello; *hello = sub { "Hello!\n" };
undef *hello;
eval { hello };
print $#;
Update: I have since solved this problem using Package::Stash (thanks #Ether), but I'm still confused by why it's happening in the first place. perldoc perlmod says:
package main;
sub Some_package::foo { ... } # &foo defined in Some_package
This is just a shorthand for a typeglob assignment at compile time:
BEGIN { *Some_package::foo = sub { ... } }
But it appears that it isn't just shorthand, because the two cause different behavior after undefining the function. I'd appreciate if someone could tell me whether this is a case of (1) incorrect docs, (2) bug in perl, or (3) PEBCAK.
Manipulating symbol table references yourself is bound to get you into trouble, as there are lots of little fiddly things that are hard to get right. Fortunately there is a module that does all the heavy lifting for you, Package::Stash -- so just call its methods add_package_symbol and remove_package_symbol as needed.
Another good method installer that you may want to check out is Sub::Install -- especially nice if you want to generate lots of similar functions.
As to why your approach is not correct, let's take a look at the symbol table after deleting the code reference:
sub foo { "foo!\n"}
sub howdy; *howdy = sub { "Howdy!\n" };
undef &howdy;
eval { howdy };
print $#;
use Data::Dumper;
no strict 'refs';
print Dumper(\%{"main::"});
prints (abridged):
$VAR1 = {
'howdy' => *::howdy,
'foo' => *::foo,
};
As you can see, the 'howdy' slot is still present - undefining &howdy doesn't actually do anything enough. You need to explicitly remove the glob slot, *howdy.
The reason it happens is precisely because you assigned a typeglob.
When you delete the CODE symbol, the rest of typeglob is still lingering, so when you try to execute howdy it will point to the non-CODE piece of typeglob.