Beefy Boxes and Bandwidth Generously Provided by pair Networks
No such thing as a small change
 
PerlMonks  

Rewriting sub code on import to add logging

by gryphon (Abbot)
on May 13, 2008 at 23:00 UTC ( #686397=perlquestion: print w/ replies, xml ) Need Help??
gryphon has asked for the wisdom of the Perl Monks concerning the following question:

Greetings all,

I've got an application with a handful of modules in an inheritance tree, with a single super-class above it all from which the other modules eventually inherit, directly or indirectly. What I'd like to do is add in every sub a call to a logging method without having lots of duplicated code. So I thought what might work is to use the super-class's import() to find all the subroutines within the package and rewrite them, adding the call. I've failed miserably.

Ultimately, here's what I'd like to have happen:

sub something { my ( $self, $param ) = @_; return _stuff($param); }

...gets rewritten to...

sub something { log_msg('starting sub'); my ( $self, $param ) = @_; return _stuff($param); }

So far, this is what I've come up with (but I can't get it to work). This is import() from the super-class:

sub import { my $package_name = shift; if ( $package_name !~ /^Application::Stuff_I_Dont_Want_To_Alter::/ ) { no strict 'refs'; no warnings 'redefine'; foreach ( keys %{ *{ $package_name . '::' } } ) { next if ( $_ !~ /[a-z]/ or $_ =~ /::$/ or $_ eq 'isa' or $_ eq 'import' ); if ( *{ $package_name, '::', $_ }{'CODE'} ) { my $code = do{ *{ $package_name, '::', $_ }{'CODE'}; }; *{ $package_name, '::', $_ } = sub { warn "BEGIN sub block...\n"; my @rv = $code->(@_); warn "END sub block...\n"; return @rv; }; } } } }

So part of the problem (apart from my inability to get this to work at all) is that the warn statements are outside the $code->() call. Is there a way I can append them inside the subroutine itself?

gryphon
code('Perl') || die;

Comment on Rewriting sub code on import to add logging
Select or Download Code
Re: Rewriting sub code on import to add logging
by pc88mxer (Vicar) on May 13, 2008 at 23:44 UTC
    This sounds like just the kind of problem that Aspect Oriented programming was designed to solve. I don't know how practical AOP on perl is, but there is a module for it: Aspect-0.08.
Re: Rewriting sub code on import to add logging
by dragonchild (Archbishop) on May 13, 2008 at 23:46 UTC
    A better AOP would be Class::MOP, the foundation for Moose.

    My criteria for good software:
    1. Does it work?
    2. Can someone else come in, make a change, and be reasonably certain no bugs were introduced?
Re: Rewriting sub code on import to add logging
by mscharrer (Hermit) on May 14, 2008 at 00:09 UTC
    A short while ago some posted a question about concatenating sub-functions together and mentioned that he wrote a CPAN module for it. I can't find it now using Super Search or CPAN search, maybe other people can provide a link. This module seems pretty much what you need.
Re: Rewriting sub code on import to add logging
by snoopy (Deacon) on May 14, 2008 at 01:12 UTC
    You might be interested in Attribute::Handlers as a way of installing handlers base on subroutine attributes:
    #!/usr/bin/perl use warnings; use strict; use Attribute::Handlers; sub log : ATTR(CODE) { my ($pkg, $sym, $code) = @_; no strict 'refs'; no warnings 'redefine'; # # Install log handler # my $name = *{ $sym }{NAME}; warn "installing log handler for $pkg\:\:$name"; *{$pkg . '::' . $name} = sub { warn "BEGIN sub block...$pkg\:\:$name\n"; my @rv = $code->(@_); warn "END sub block...$pkg\:\:$name\n\n"; return @rv; } } sub something : log { print "I'm doing something with @_.\n"; return 42; } my ($result) = something(qw/foo bar/); print "result: $result\n";
    This produces:
    installing log handler for main::something at log.pl line 13. BEGIN sub block...main::something I'm doing something with foo bar. END sub block...main::something result: 42
    Update: Added no warnings 'redefine';
Re: Rewriting sub code on import to add logging
by citromatik (Curate) on May 14, 2008 at 10:51 UTC
    So part of the problem (apart from my inability to get this to work at all) is that the warn statements are outside the $code->() call. Is there a way I can append them inside the subroutine itself?

    You may find interesting this post. You can edit the source of the subroutines and evaluate it into code again:

    use B::Deparse; sub something { my ( $self, $param ) = @_; return _stuff($param); } my $subref = \&something; my $code = B::Deparse->new->coderef2text($subref); print "Before editing &something:\n",$code; $code =~ s/\{/\{\nlog_msg('starting sub');\n/; *something = eval "sub $code"; $code = B::Deparse->new->coderef2text(\&subref); print "\nAfter editing &something:\n",$code;

    Outputs:

    Before editing &something: { use warnings; use strict 'refs'; my($self, $param) = @_; return _stuff($param); } After editing &something: { use warnings; use strict 'refs'; log_msg('starting sub'); my($self, $param) = @_; return _stuff($param); }

    Hope this helps

    citromatik

Re: Rewriting sub code on import to add logging
by jettero (Monsignor) on May 14, 2008 at 16:07 UTC

    This method isn't exactly recommended. Look carefully at the other methods mentioned above (possibly except the B::Deparse method, which is likely at least as fragile as this).

    I ran into a problem like this a while back where I wanted to write a custom function profiler that used DBD::SQLite to store the profile data. It didn't work very well, but it was fun and it's no trouble for me to cut and paste the code in here. (I ripped off ideas from Memoize directly.)

    I think this can easily be adapted to what you're trying to do.

    -Paul

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: perlquestion [id://686397]
Approved by pc88mxer
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others studying the Monastery: (12)
As of 2014-07-10 15:03 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    When choosing user names for websites, I prefer to use:








    Results (212 votes), past polls