Beefy Boxes and Bandwidth Generously Provided by pair Networks
We don't bite newbies here... much

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!

Replies are listed 'Best First'.
Re: Changing every subroutine in many perl scripts
by toolic (Bishop) 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( '' );

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

    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 17 main::__ANON__ 1 1 1794 UUUUUUUUUUUUU main 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.

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.

Log In?

What's my password?
Create A New User
Node Status?
node history
Node Type: perlquestion [id://983432]
Approved by toolic
and a moth chases the moon...

How do I use this? | Other CB clients
Other Users?
Others browsing the Monastery: (14)
As of 2017-11-21 14:51 GMT
Find Nodes?
    Voting Booth?
    In order to be able to say "I know Perl", you must have:

    Results (302 votes). Check out past polls.