Beefy Boxes and Bandwidth Generously Provided by pair Networks
laziness, impatience, and hubris
 
PerlMonks  

Changing every subroutine in many perl scripts

by nitin1704 (Sexton)
on Jul 24, 2012 at 14:51 UTC ( #983432=perlquestion: print w/ replies, xml ) Need Help??
nitin1704 has asked for the wisdom of the Perl Monks concerning the following question:

I need to add a few lines at the beginning of every subroutine, in about 50 perl files, each having about 10 subroutines.

I tried regular expressions as follows:

my $allText = read_file($file); my $call = <<'END'; my @mars_caller = caller(0); mars::print::call(\@mars_caller, \@_); END $allText =~ s/([\n\s]+sub[\n\s]+.*?{)/\1$call/sg;

However this method is not so reliable as it found the word "sub" in a comment or print statement followed by some lines and then found a "{" somewhere else in the program and replaced that with the substitution string. Instead it should just find the real subroutine definitions.

I hope I've made my problem clear. Is there a better way to do this? Thanks for helping!

Comment on Changing every subroutine in many perl scripts
Download Code
Re: Changing every subroutine in many perl scripts
by toolic (Chancellor) on Jul 24, 2012 at 15:07 UTC
      Should I use PPI::Transform to edit the subroutines?

      From the CPAN page, I got that I could do something like this:

      my $transform = PPI::Transform->new( param1 => 'value1', param2 => 'value2', ); # Change a file in place $transform->file( 'Change.pm' );

      But I don't understand what are the params and values when creating the new transform object.

        Okay, I got it now, after going through the CPAN documentation a bit more.

        use strict; use warnings; use PPI; my $file = '/path/to/perl/script.pl'; my $Document = PPI::Document->new($file) or die "oops"; for my $sub ( @{ $Document->find('PPI::Statement::Sub') || [] } ) { unless ( $sub->forward ) { my @elements = $sub->children; for ( my $i = 0 ; $i < @elements ; $i++ ) { if ( ref $elements[$i] eq "PPI::Structure::Block" ) { $elements[$i]->start->add_content("my mars code"); } } } } $Document->save($file.".new");
Re: Changing every subroutine in many perl scripts
by Anonymous Monk on Jul 24, 2012 at 18:10 UTC

    It might be a good idea to do this in code.

    sub marsify { my ($func) = @_; return sub { my @mars_caller = caller(0); mars::print::call(\@mars_caller, \@_); $func->(@_); } } # enumerate through package symbols, finding subroutines # for each sub found # patch symbol table: *subname = marsify(\&subname);

    I'm sure someone can fill me in -- I'm not familiar enough with the symbol table tricks to pull this off.

Re: Changing every subroutine in many perl scripts
by Jenda (Abbot) on Jul 25, 2012 at 08:19 UTC

    Do you need the text to be in the files or do you need to do something at the start of the subroutines' execution? If the later, have a look at Hook::LexWrap, Class::Wrap and possibly Devel::TraceSubs for an example how to wrap everything in a package.

    Jenda
    Enoch was right!
    Enjoy the last years of Rome.

      Okay, so I tried the following code:

      #!/usr/bin/perl use warnings; use strict; use Hook::LexWrap; my @mars_subs = qw (add increment); for (@mars_subs) { wrap $_, pre => sub { my @caller = caller(0); for (@caller) { print $_, " " if defined $_; } print "\n"; }; } print add( 1, 2 ), "\n"; sub add { my ( $num1, $num2 ) = @_; increment($num1); return $num1 + $num2; } sub increment { my $num = shift; return ++$num; }

      And the output I got is:

      main hooklexwrap.pl 17 main::__ANON__ 1 1 1794 UUUUUUUUUUUUU main hooklexwrap.pl 21 main::__ANON__ 1 1538 UUUUUUUUUUUUU 3

      How do I get the actual sub names like main::add instead of main::__ANON__ ?

        What are you trying to report? Are you trying to emit something for every executed function? In that case, close over the name of the wrapped function:

        my @mars_subs = qw( add increment ); for my $sub (@mars_subs) { wrap $sub, pre => sub { print "Calling '$sub'\n"; }; }

        Improve your skills with Modern Perl: the free book.

Log In?
Username:
Password:

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

How do I use this? | Other CB clients
Other Users?
Others pondering the Monastery: (6)
As of 2014-12-20 03:23 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    Is guessing a good strategy for surviving in the IT business?





    Results (95 votes), past polls