# save all other slots of the typeglob
foreach my $slot (qw( SCALAR ARRAY HASH IO FORMAT )) {
    my $elem = *{ $src->{$symbol} }{$slot};
        next unless defined $elem;
        push @slots, $elem;
    }

    # clear out the source glob
    #       undef &{ *{$src->{$symbol}} } didn't work
    undef $src->{$symbol};

    # replace the sub in the source
    $src->{$symbol} = sub {
        logCall->($symbol, @_);
        return $sub->(@_);
    };

    # replace the other slot elements
    foreach my $elem (@slots) {
        $src->{$symbol} = $elem;
    }
}
[download]

• Create a fake class

  my $x = SubClass->new;  # inherits from SuperClass
  
  $x->method;  # calls SubClass::method
  {
    local @FAKE::ISA = @{ ref($x) . "::ISA" };
    $x->FAKE::method;  # calls SuperClass::method
  }
  $x->method;  # calls SubClass::method
  [download]

• localize the glob, and restore all but the code

  my $x = SubClass->new;  # inherits from SuperClass
  
  $x->method;  # calls SubClass::method
  {
    # save the glob...
    local *old = *{ ref($x) . "::method" };
  
    # localize the glob...
    local *{ ref($x) . "::method" };
  
    # and restore everything else
    ${ ref($x) . "::method" } = $old;
    @{ ref($x) . "::method" } = @old;
    %{ ref($x) . "::method" } = %old;
    # technically incomplete
    
    $x->method;  # calls SuperClass::method
  }
  $x->method;  # calls SubClass::method
  [download]

• icky eval + SUPER:: hack -- the SUPER:: doesn't work if you're not physically in the package!

  my $x = SubClass->new;  # inherits from SuperClass
  
  $x->method;  # calls SubClass::method
  {
    my $pkg = ref $x;
    eval qq{
      package $pkg;
      \$x->SUPER::method;  # calls SuperClass::method
    };
  }
  $x->method;  # calls SubClass::method
  [download]

  These are gross. That's why I want to be able to say:

  local &foo;
  [download]

  
  
  japhy -- Perl and Regex Hacker

Maybe you have to delete the symbol-table hash key?

# UNTESTED!
# Instead of undef &{B::A}
delete $B::A::{CODE};
[download]

Update: Oh well. :-(

Update again! Ah-ha! This seems to work fine, even preserving $B::A (though I wouldn't think it would...):

# Instead of undef &{B::A}
delete $B::{A};
[download]

Can anyone explain why that doesn't seem to destroy $B::A? It seems dangerous and prone to breakage, so you should probably use chromatic's suggestion below.

bbfu
Seasons don't fear The Reaper.
Nor do the wind, the sun, and the rain.
We can be like they are.

Can anyone explain why that doesn't seem to destroy $B::A?

Ah, but it seems to! Try replacing the bottom of the program with:

A->A;
# Why doesn't it just call A::A here because of inheritance?
B->A; # Not a CODE reference at noinherit.pl line 27. 
eval "print \$B::A"; # Use of uninitialized value in print at (eval 2)
+ line 1.
[download]

Hrm. I guess normal references to variables are bound at compile-time. Ah, well. Back to chromatic's method. *shrug*

bbfu
Seasons don't fear The Reaper.
Nor do the wind, the sun, and the rain.
We can be like they are.

Nope. I just tried it and it doesn't work. Nice thought, though...

#!/usr/bin/perl -w
use strict;

# Undefine a subroutine safely, by name.
# From a method described by chromatic.
sub undefSub
{
 no strict 'refs';
 my $name = shift;

 # save the glob...
 local *old = *{$name};

 # and restore everything else
 local *new;
 foreach my $type (qw(HASH IO FORMAT SCALAR ARRAY))
 {
  my $elem = *old{$type};
  next if !defined($elem);
  *new = $elem;
 }
 *{$name} = *new;
}

package A;
sub A { print "A::A $_[0]\n" }

package B;
@B::ISA = 'A';
$B::A   = "i'm \$B::A\n\n";

package main;

A->A;
B->A;    # calls A::A
print $B::A;

*{B::A} = sub { print "B::A $_[0]\n" };

A->A;
B->A;    # now calls B::A
eval 'print $B::A';

undefSub('B::A');

A->A;
B->A;  # now calls A::A
eval 'print $B::A';  # still intact!
[download]

There is caching of methods going on so it might help to do @B::ISA= @B::ISA; or something similar to flush the cache.

I dunno if this helps.