Why does this Perl produce "Not a CODE reference?" - perl

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.

Related

Not enough arguments when redefining a subroutine

When I redefine my own subroutine (and not a Perl built-in function), as below :
perl -ce 'sub a($$$){} sub b {a(#_)}'
I get this error :
Not enough arguments for main::a at -e line 1, near "#_)"
I'm wondering why.
Edit :
The word "redefine" is maybe not well chosen. But in my case (and I probably should have explained what I was trying to do originally), I want to redefine (and here "redefine" makes sense) the Test::More::is function by printing first Date and Time before the test result.
Here's what I've done :
Test::More.pm :
sub is ($$;$) {
my $tb = Test::More->builder;
return $tb->is_eq(#_);
}
MyModule.pm :
sub is ($$;$) {
my $t = gmtime(time);
my $date = $t->ymd('/').' '.$t->hms.' ';
print($date);
Test::More::is(#_);
}
The prototype that you have given your subroutine (copied from Test::More::is) says that your subroutine requires two mandatory parameters and one optional one. Passing in a single array will not satisfy that prototype - it is seen as a single parameter which will be evaluated in scalar context.
The fix is to retrieve the two (or three) parameters passed to your subroutine and to pass them, individually, to Test::More::is.
sub is ($$;$) {
my ($got, $expected, $test_name) = #_;
my $t = gmtime(time);
my $date = $t->ymd('/').' '.$t->hms.' ';
print($date);
Test::More::is($got, $expected, $test_name);
}
The problem has nothing to do with your use of a prototype or the fact that you are redefining a subroutine (which, strictly, you aren't as the two subroutines are in different packages) but it's because Test::More::is() has a prototype.
You are not redefining anything here.
You've set a prototype for your sub a by saying sub a($$$). The dollar signs in the function definition tell Perl that this sub has exactly three scalar parameters. When you call it with a(#_), Perl doesn't know how many elements will be in that list, thus it doesn't know how many arguments the call will have, and fails at compile time.
Don't mess with prototypes. You probably don't need them.
Instead, if you know your sub will need three arguments, explicitly grab them where you call it.
sub a($$$) {
...
}
sub b {
my ($one, $two, $three) = #_;
a($one, $two, $three);
}
Or better, don't use the prototype at all.
Also, a and b are terrible names. Don't use them.
In Perl, prototypes don't validate arguments so much as alter parsing rules. $$;$ means the sub expects the caller to match is(EXPR, EXPR) or is(EXPR, EXPR, EXPR).
In this case, bypassing the prototype is ideal.
sub is($$;$) {
print gmtime->strftime("%Y/%m/%d %H:%M:%S ");
return &Test::More::is(#_);
}
Since you don't care if Test::More::is modifies yours #_, the following is a simple optimization:
sub is($$;$) {
print gmtime->strftime("%Y/%m/%d %H:%M:%S ");
return &Test::More::is;
}
If Test::More::is uses caller, you'll find the following useful:
sub is($$;$) {
print gmtime->strftime("%Y/%m/%d %H:%M:%S ");
goto &Test::More::is;
}

Perl Anonymous Subroutine/Function error

I have the following piece of code: (extremely simplified for the purposes of this question, but perfectly illustrates the problem I am having)
#!/usr/bin/perl
use strict;
use warnings;
&outer;
my $connected_sub;
sub outer {
print "HELLO\n";
&$connected_sub;
$connected_sub = sub {
print "GOODBYE\n";
}
}
When run the program gives this output and error:
HELLO
Use of uninitialized value in subroutine entry at subTesting line 13.
Can't use string ("") as a subroutine ref while "strict refs" in use at subTesting.pl line 13.
Am I totally overlooking something here? I cannot understand or work out what the problem with this is.
To clarify:
Subroutine definitions happen in the compilation stage. Thus code like this will work:
foo();
sub foo { print "No need to declare me before calling!"; }
But an assignment doesn't actually happen until that line of code is called. That is why this won't work:
my $foo;
&$foo();
$foo = sub { print "Foo hasn't been set to me when you try to call me." }
I assume that what you are trying to do here is assign an anonymous sub to the variable $connected_sub. This is not a good way to do it.
What you are doing is taking an empty variable, trying to use it as a code reference, assigning a code reference to it, then exiting the sub and then declaring the variable with my. Not the best order of doing things.
What you probably want to do is return a value which can be assigned to the variable, like so:
my $connected = outer();
$connected->();
sub outer {
print "HELLO\n";
my $sub = sub { print "GOODBYE\n"; }
return $sub;
}
Using a lexical variable inside a subroutine is somewhat confusing, I think. Besides the general drawbacks of using global variables, the subroutine is also compiled before the code is executed and the variable declared.
Also, when calling a subroutine, the standard way of doing so is
name(#args);
Where #args is your argument list. Using & is old style perl, and using it has a special meaning (override prototypes). When using an anonymous sub in a variable, use the ->() notation.
The $connected_sub is not initializated. Try to assign to an anonymous sub:
my $connected_sub = sub {
print "The code you need to run\n";
}
At the definition, and drop the code after the &$connected_sub call
This is the complete example modified:
#!/usr/bin/perl
use strict;
use warnings;
my $connected_sub = sub {
print "GOODBYE\n";
};
&outer;
sub outer
{
print "HELLO\n";
&$connected_sub;
}
Looks like you're using $connected_stub before it is initialized. Try to move the initialization up, like:
$connected_sub = sub {
print "GOODBYE\n";
}
&$connected_sub;

Passing a block to a Moose method

Is it somehow possible to pass blocks to Moose methods? In standard Perl, I can define a function with prototypes like this
sub fn (&) {
my $code =\&{shift #_};
$code->();
}
and then pass a block to the function without explicit sub references, i.e. fn { say "Hi there, world" }.
I think this is only possible if the subroutine is the first parameter, and as this is always $self with a Moose method, it doesn't seem possible there, forcing me to do it the slightly more explicit way:
sub wrapper {
my ($self, $code) = #_;
$code->()
}
Wrapper->wrapper(sub { say "Hi there, world" });
Now this would be a pretty convenient way to wrap some blocks, i.e. to provide some additional text or conditionally execute code or wrap an eval around some code where the error handling stays the same (e.g. eval some code and log errors, record user etc.).
If I'm not missing something, is there some semi-convenient workaround or alternative method to achieve something like this without too much line noise?
Have a look at the PerlX::MethodCallWithBlock CPAN module which contorts the Perl syntax (via the Devel::Declare module) to allow you to put a block after a method call.
For e.g.:
use 5.016;
use warnings;
use PerlX::MethodCallWithBlock;
{
package Foo;
use Moose;
sub bar {
my ($self, $code) = #_;
$code->();
}
}
Foo->bar { say "Hi there world" };
This module was released as a proof of concept. So far I've had no issues with it but YMMV.

Typo when calling subref dies with `Not a GLOB reference`

A coworker's typo when calling a subref raised this strange syntax question. If I call a subref without the dereference arrow, perl dies with Not a GLOB reference. However, if the subref is called as a method on a blessed object, it runs fine.
What does this have to do with globs? And why does the method call work?
use 5.12.0;
use Try::Tiny;
my $f = sub { 'sub ref' };
my $obj = bless({}, 'Blessed');
try {
say $f($obj); # should be $f->();
} catch {
say "ERROR: $_";
};
say $obj->$f();
Output:
C:\code>perl dispatch.pl
ERROR: Not a GLOB reference at dispatch.pl line 8.
sub ref
say, like print, accepts an optional filehandle/typeglob to direct output to, eg:
my $f = \*STDERR;
say $f ("This goes to stderr.");
I didn't realize until now that you could do a method call on a subroutine reference, but sure enough, the perlobj man page states:
If the right side of the arrow is a scalar containing a reference to a
subroutine, then this is equivalent to calling the referenced subroutine
directly with the class name or object on the left side of the arrow as its
first argument. No lookup is done and there is no requirement that the
subroutine be defined in any package related to the class name or object on the
left side of the arrow.

How can I override Perl functions, enabling multiple overrides?

some time ago, I asked This question about overriding building perl functions.
How do I do this in a way that allows multiple overrides? The following code yields an infinite recursion.
What's the proper way to do this? If I redefine a function, I don't want to step on someone else's redefinition.
package first;
my $orig_system1;
sub mysystem {
my #args = #_;
print("in first mysystem\n");
return &{$orig_system1}(#args);
}
BEGIN {
if (defined(my $orig = \&CORE::GLOBAL::system)) {
$orig_system1 = $orig;
*CORE::GLOBAL::system = \&first::mysystem;
printf("first defined\n");
} else {
printf("no orig for first\n");
}
}
package main;
system("echo hello world");
The proper way to do it is not to do it. Find some other way to accomplish what you're doing. This technique has all the problems of a global variable, squared. Unless you get your rewrite of the function exactly right, you could break all sorts of code you never even knew existed. And while you might be polite in not blowing over an existing override, somebody else probably will not be.
Overriding system is particularly touchy because it does not have a proper prototype. This is because it does things not expressible in the prototype system. This means your override cannot do some things that system can. Namely...
system {$program} #args;
This is a valid way to call system, though you need to read the exec docs to do it. You might think "oh, well I just won't do that then", but if any module that you use does it, or any module it uses does it, then you're out of luck.
That said, there's little different from overriding any other function politely. You have to trap the existing function and be sure you call it in your new one. Whether you do it before or after is up to you.
The problem in your code is that the proper way to check if a function is defined is defined &function. Taking a code ref, even of an undefined function, will always return a true code ref. I'm not sure why, maybe its like how \undef will return a scalar ref. Why calling this code ref is causing mysystem() to go infinitely recursive is anyone's guess.
There's an additional complexity in that you can't take a reference to a core function. \&CORE::system doesn't do what you mean. Nor can you get at it with a symbolic reference. So if you want to call CORE::system or an existing override depending on which is defined you can't just assign one or the other to a code ref. You have to split your logic.
Here is one way to do it.
package first;
use strict;
use warnings;
sub override_system {
my $after = shift;
my $code;
if( defined &CORE::GLOBAL::system ) {
my $original = \&CORE::GLOBAL::system;
$code = sub {
my $exit = $original->(#_);
return $after->($exit, #_);
};
}
else {
$code = sub {
my $exit = CORE::system(#_);
return $after->($exit, #_);
};
}
no warnings 'redefine';
*CORE::GLOBAL::system = $code;
}
sub mysystem {
my($exit, #args) = #_;
print("in first mysystem, got $exit and #args\n");
}
BEGIN { override_system(\&mysystem) }
package main;
system("echo hello world");
Note that I've changed mysystem() to merely be a hook that runs after the real system. It gets all the arguments and the exit code, and it can change the exit code, but it doesn't change what system() actually does. Adding before/after hooks is the only thing you can do if you want to honor an existing override. Its quite a bit safer anyway. The mess of overriding system is now in a subroutine to keep BEGIN from getting too cluttered.
You should be able to modify this for your needs.