redefining exported subs in perl

i've explained in a previous post that i changed the way i was logging debug statements within language::befunge. i mentioned that i applied some tricks and promised to explain them - so here are the explanations.

the goal is to minimize time spent for debug statements. previously, i was doing:
and debug was a method defined as:
sub debug {
my ($self, @stuff) = @_;
return unless $self->debug_mode;
warn @stuff;

so, to log a debug message, i was doing:
  • a method call on $interpreter
  • a second method call to check an attribute
  • finally the actual logging (skipped if we're not in debug mode)
this is bad, especially since method calls cannot be resolved at compile time by perl, and thus are actually resolved during run-time. but what's worse is that this always happens, even if we're not in debug mode (which is around 99% of the time).

so, one obvious way to improve was to move from a method to a plain sub. this would remove the run-time cost of resolving the method. the debug mode can be stored as a package scalar instead of an attribute.

but we can do even better. knowing that:
  • perl optimizes out calls to empty subs
  • we are not in debug mode most of the time
we can define the debug sub as an empty sub!

here's our code at that point:
package Language::Befunge::Debug;

use 5.010;
use strict;
use warnings;

use base qw{ Exporter };
our @EXPORT = qw{ debug };

sub debug {}
of course, we need to provide a way to activate debugging. a naive approach would be to redefine our debug() sub in our debug package:
sub enable {
*debug = sub { warn @_; };
alas, this won't work. well, it will work for calls such as:

but calls using exported debug() will still log nothing. indeed, it's important to understand that exporter installs a copy of exported sub in the package. therefore, changing the definition of the original does not change the exported copies.

so, to redefine exported subs, one is forced to walk the symbol table of all packages and redefine subs on the fly. here's what i ended up doing:

my %redef;
sub enable {
%redef = ( debug => sub { warn @_; } );

sub disable {
%redef = ( debug => sub {} );

my %orig; # original subs
sub _redef {
my $parent = shift;
if ( not defined $parent ) {
$parent = '::';
foreach my $sub ( keys %redef ) {
$orig{ $sub } = \&$sub;
no strict 'refs';
no warnings 'redefine';
foreach my $ns ( grep /^\w+::/, keys %{$parent} ) {
$ns = $parent . $ns;
_redef($ns) unless $ns eq '::main::';
foreach my $sub (keys %redef) {
next # before replacing, check that...
unless exists ${$ns}{$sub} # ... named sub exist...
&& \&{ ${$ns}{$sub} } == $orig{$sub}; # ... and refer to the one we want to replace
*{$ns . $sub} = $redef{$sub};
there, it will redefine my sub in all packages, even the ones that hold an exported copy.

now, do you think this would warrant a sub::redefine module on cpan? after all, i found nothing on cpan that would achieve that. otoh, i'm not sure it's that common to do this kind of things... so tell if you're interested, and i'll turn that in a cpan module for your own use.


  1. Actually, perl isn't going to optimise anything there. What gets optimisied is -

    sub debug () { }

    since perl can see the empty proto and empty (or single scalar) body. That then would get resolved to a CONST op, which the peephole optimiser can use to throw away pointless if branches and similar.

    Plus, method calls aren't looked up every time, the resolution is cached, so although it's still slower than a sub call it's not as much slower as you seem to think (though 5.8 blows its caches very very easily, 5.10 is better in this regard).

    Profile. Then optimize.

  2. @matt: as explained in the previous post, i was able to speedup the application by ~20% with this...
    (perl 5.10)

  3. Sorry for commenting on an ooold post, but I think you might find this interesting.

    I just accidentally hit on an easier way of doing this. I couldn't find any documentation, but it works in 5.8 and 5.10. Simply undef the old sub before redefining the new one. Bonus: no redefine warnings either!

    sub foo {print "foo\n";}
    BEGIN {*foo_export = \&foo;} # No undef!
    sub foo {print "foo2\n";}
    sub bar {print "bar\n";}
    BEGIN {*bar_export = \&bar; undef &bar;}
    sub bar {print "bar2\n";}