BEGIN{
%SomePackage::copy:: = %SomePackage::;
%SomePackage:: = ();
# actually, you should probably only move the subs
# and leave the variables etc where they are.
}

package SomePackage;

sub AUTOLOAD
{
  # in here check caller() to see if you're crossing 
  # package boundaries and then call the pre-function
  # wrappers and then call the real function, paying
  # attention to wantarry etc then call the post-function
  # then return the data
}
[download]

perldebguts may tell you what you need to know. In purticular, I think you want a DB::sub. I'm in the middle of something else, though, so I don't want to break my concentration to do this. (OTOH, from this quick read of perldebguts, I found something that might be useful for me.)

package Foo;
use strict;
use warnings;

sub Hello_World { print "Hello Word\n"; }
my $callback = sub { Hello_World(); };
sub Bar {
    $callback->();
    print "This is the actual 'would be' exported sub\n";
}
1;

# Some script that uses it
#!/usr/bin/perl
use strict;
use warnings;
use Foo;
Foo::Bar();
[download]

When you talk about package scope, do you mean you want to listen to specific call flows?

If so, then Joost is right, and this is a job for Aspect . Version 0.10 will be out today.

Here is how to print foo each time Employee::calc_* is called, but only if Company::calc_salaries exists in the call flow. So if the call flow is Test::test_employee ... Employee::calc_salary, then it will not be printed:

  use Aspect;
  before { print 'foo' }
     call qr/^Employee::calc_/ &
     cflow company => 'Company::calc_salaries';
[download]

There is also the Listenable aspect (Aspect-0.10), for a full implementation of Observer. But because you have pointcuts, you can fire events only in some call flow. Which you cannot do with normal Observer.

Shouldn't that be & instead of && because of overloading and stuff?

If I understand you correctly, you want to trap each entry and exit to the subroutines of a certain package.

As theorbtwo has noted, you can trap each and every subroutine call that happens in perl with &DB::sub, and then you check for the called package. A small example is (for perl 5.8.2)

BEGIN { 
sub DB::sub { 
        my ($r, @r, $s);
        $s = $DB::sub;
        $s=~/^T::/ or goto &$s;
        warn "entering $s\n"; 
        if (wantarray) 
                { @r = &$s; }
        elsif (defined wantarray)
                { $r = &$s; }
        else
                { &$s; }
        warn "exitting $s\n";
        wantarray ? @r : $r;
        }
$^P |= 1;
} 
{ 
package T;
$r = "r";
sub f { $_[0].$r.n(); }
sub n { @l = l(); 2, chr(@l); }
sub l { -5..4; }
}
sub g { T::f($_[0]."a"); }; 
print g("b");
[download]

The above aspect, however, has some problems. It might be slow as it has to catch all subroutine calls, not only those in a certain package, it does not work for anonymous subs, and it might be difficult to make it work if you use the perl debugger or use DB::sub for any other purpose.

As a different approach, you could replace each subroutine in the package with a different subroutine. This, however, has the backdraw that the subroutines you want to trap have to be defined by the time you install the trapping code, as a special case you can not trap AUTOLOADED subs this way. An example is:

{ 
for $n (keys %T::) { if (defined &{$T::{$n}}) {
                my $s = $n; my $f = \&{$T::{$n}}; 
                $T::{$n} = sub { 
                        my ($r, @r);
                        warn "entering $s\n"; 
                        if (wantarray) 
                                { @r = &$f; }
                        elsif (defined wantarray)
                                { $r = &$f; }
                        else
                                { &$f; }
                        warn "exitting $s\n";
                        wantarray ? @r : $r;
                        }
        } }
} 
{ 
package T;
$r = "r";
sub f { print $_[0].$r.n(); }
sub n { @l = l(); 2, chr(@l); }
sub l { -5..4; }
}
sub g { T::f($_[0]."a"); }; g("b");
[download]

(Pity overloading "&{}" can not catch named subroutine calls, as that would have been a very elegant solution.)

Update: Note that these codes get much shorter if you only want to trace subroutine entry, not exit, as you don't have to mess with the contexts. You might only want to trace calls that come from a different package. That should be possible with caller.

Thanks for some good ideas and sample code.

Overloading "&{}" really would be elegant.

Maybe someone should bring that up on the p6 list in the hope that it can be done over there.

---

Examine what is said, not who speaks.

"Efficiency is intelligent laziness." -David Dunham
"Think for yourself!" - Abigail
"Memory, processor, disk in that order on the hardware side. Algorithm, algorithm, algorithm on the code side." - tachyon

Overloading "&{}" really would be elegant.

Maybe someone should bring that up on the p6 list in the hope that it can be done over there.

Thinking about it again, I'd think no. When you call a sub with f(), you can certainly not overload it as it's dereferencing a glob (like &{*f}()), not a reference, and you can not bless globs the way you can do it with references.

############
# SPY_SUBS #
############

sub spy_subs {
  my ( $pack , $callback ) = @_ ;
  $pack =~ s/::$// ;
  
  my $stash = *{"$pack\::"}{HASH} ;
  
  foreach my $Key ( keys %$stash ) {
    my $sub = "$pack\::$Key" ;
    if ( defined &$sub ) {
      my $org_sub = \&$sub ;
      *{$sub} = sub { &$callback(@_) ; &$org_sub(@_) ;} ;
    }
  }
}

###############
# PACKAGE FOO #
###############

package foo ;

  sub call {
    print "call>> @_\n" ;
  }
  
  sub foo {
    print "foo>> @_\n" ;
  }
  
  main::spy_subs('foo',\&call) ;
  
  foo(123);
[download]

call>> 123
foo>> 123
[download]

You can fix the caller issue by calling the original subroutine with goto &$org_sub;