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:

$interpreter->debug(@stuff);

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:

Language::Befunge::Debug::debug(@stuff);

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 @_; } );
  _redef();
}

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

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.