Beefy Boxes and Bandwidth Generously Provided by pair Networks
Perl-Sensitive Sunglasses
 
PerlMonks  

Package level scope callbacks.

by BrowserUk (Pope)
on Jul 31, 2004 at 16:51 UTC ( #378941=perlquestion: print w/replies, xml ) Need Help??

BrowserUk has asked for the wisdom of the Perl Monks concerning the following question:

Is there any way to arrange for a callback to program level code as a running program crosses package boundaries?

I'd like to be able to have a subroutine in my module that gets called whenever the running program calls a function or method within the scope of that package, and perhaps another as it exits.

I can't even begin to see a way to do this, but then are are a lot of things in the Devel::* group of modules that do stuff with introspection that I wouldn't have thought possible had I not seen them in action.


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, algoritm, algorithm on the code side." - tachyon

Replies are listed 'Best First'.
Re: Package level scope callbacks.
by Joost (Canon) on Jul 31, 2004 at 17:39 UTC
Re: Package level scope callbacks.
by fergal (Chaplain) on Jul 31, 2004 at 17:28 UTC
    The only thing I can think of (and it's not pretty) is to do something like
    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 }
    slow, ugly, complicated but it should do what you want.
Re: Package level scope callbacks.
by theorbtwo (Prior) on Jul 31, 2004 at 17:38 UTC

    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.)


    Warning: Unless otherwise stated, code is untested. Do not use without understanding. Code is posted in the hopes it is useful, but without warranty. All copyrights are relinquished into the public domain unless otherwise stated. I am not an angel. I am capable of error, and err on a fairly regular basis. If I made a mistake, please let me know (such as by replying to this node).

Re: Package level scope callbacks.
by Limbic~Region (Chancellor) on Jul 31, 2004 at 17:12 UTC
    BrowserUk,
    I am likely to be completely off base, but wouldn't a closure do what you wanted? I guess I don't really understand what you mean, but just in case:
    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();

    Cheers - L~R

Re: Package level scope callbacks.
by mvc (Scribe) on Aug 01, 2004 at 08:26 UTC

    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';

    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?
Re: Package level scope callbacks.
by ambrus (Abbot) on Aug 01, 2004 at 14:48 UTC

    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");
    (Thanks to wog for bringing $^P in my attention in Re^2: How's your Perl? (II).)

    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");

    (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.

Re: Package level scope callbacks.
by gmpassos (Priest) on Aug 01, 2004 at 21:27 UTC
    If what you want is to have a sub called when a sub of a package is called maybe this code can be useful for you:
    ############ # 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);
    Output:
    call>> 123 foo>> 123
    But note that this will interfere with caller(), since you have an extra sub for each call. With some extra code this can be fixed, but for now is just that.

    Graciliano M. P.
    "Creativity is the expression of the liberty".

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

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: perlquestion [id://378941]
Approved by Limbic~Region
Front-paged by broquaint
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others drinking their drinks and smoking their pipes about the Monastery: (3)
As of 2021-05-10 02:45 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?
    Perl 7 will be out ...





    Results (104 votes). Check out past polls.

    Notices?