I've been given a tricky task which is to write a log entry at certain points within a large million+ line code base.

The points that I need to log can be found from a list of 500+ template types. A template type is simply a string like "end_assignment_affiliate" or "interview_accepted".

I'm trying to work out how to write a perl script that will take the list of 500 templates and then search through the code to find the methods that make use of each specific template string (I then hope to use the list of methods to find all the entry points into the system for each template type).

So for example I may have

sub aSub {
 my($arg) = @_
 ...
 if ($template eq 'interview_accepted') {
 ...
}

I want to determine that method aSub contains interview_accepted. interview_accepted may be contained within multiple subroutines.

It's quite easy to grep the code base for the message type and find the line number in files where that message exists, however I'm having a hard time trying to identify the containing method.

Clearly if I can do this programmatically it will be more robust, repeatable and much quicker.

Does anyone know of any modules or tricks that I can use to achieve this?

Update

I'm currently playing with using File::ReadBackwards to find the string, and then from that point find the first sub [name] { point. I'm wondering though if there is a more elegant solution?

My CPAN module Devel::Examine::Subs can do this with the has() method or function. Here's a sample script using the OO version, which will do what you want. Just enter the directory you want to search (recursively) as argument one, and the search term as argument two:

#!/usr/bin/perl
use warnings;
use strict;
use 5.18.0;

use Devel::Examine::Subs;
use File::Find;

my $des = Devel::Examine::Subs->new();

my $dir = $ARGV[0];
my $search = $ARGV[1];

find({ wanted => \&check_subs, no_chdir => 1 },
       $dir,
);

sub check_subs {

    if (! -f or ! /(?:\.pm|\.pl)$/){
        return;
    } 

    my $file = "$File::Find::name";

    my @has = $des->has({file => $file, search => $search});

    return if ! @has;

    say "\n$file:" ;
    say "\t$_" for @has;
}

Called like this perl des.pl business-isp/ template results in this example output:

business-isp/lib/Business/ISP/Reports.pm:
    income_by_item
    renewal_notices

business-isp/lib/Business/ISP/GUI/Accounting.pm:
    _display_plan_stats
    process_renew
    display_add_plan
    email_invoice
    process_purchase
    display_payment_form
    client_delete
    _contact_info_table
    show_plan
    display_uledger
    add_plan

business-isp/lib/Business/ISP/GUI/Base.pm:
    start
    _header
    display_config
    _render_error
    _blank_header
    _footer

UPDATE: I've modified the script slightly so it can be used in a loop with a bunch of search terms. Just populate your template names into the @searches array, and specify the directory structure to search in $dir.

#!/usr/bin/perl
use warnings;
use strict;
use 5.18.0;

use Devel::Examine::Subs;
use File::Find;

my $des = Devel::Examine::Subs->new();

my $dir = 'business-isp/';
my @searches = qw(template this that other);

for my $search (@searches){

    say "\n***** SEARCHING FOR: $search *****\n";

    find({ wanted => sub { check_subs($search) }, no_chdir => 1 },
           $dir
    );
}

sub check_subs {

    my $search = shift;

    if (! -f or ! /(?:\.pm|\.pl)$/){
        return;
    } 

    my $file = "$File::Find::name";

    my @has = $des->has({file => $file, search => $search});

    return if ! @has;

    say "\n$file:" ;
    say "\t$_" for @has;
}

UPDATE: Here's a script that uses the new has() method with the lines parameter set. It retrieves the entire line that the search hits, along with the line number it's on:

#!/usr/bin/perl
use warnings;
use strict;
use 5.18.0;

use Devel::Examine::Subs;
use File::Find;

my $des = Devel::Examine::Subs->new();

my $dir = 'business-isp/';
my @searches = qw(date);

for my $search (@searches){

    say "\n***** SEARCHING FOR: $search *****\n";

    find({ wanted => sub { check_subs($search) }, no_chdir => 1 },
           $dir
    );
}

sub check_subs {

    my $search = shift;

    if (! -f or ! /(?:\.pm|\.pl)$/){
        return;
    } 

    my $file = "$File::Find::name";

    my %subs = $des->has({file => $file, search => $search, lines => 1});

    return if not %subs;

    print "\n$file:\n\n";

    for my $sub (keys %subs){    

        print "$sub:\n";

        for my $line_info (@{$subs{$sub}}){
            while (my ($k, $v) = each (%$line_info)){
                print "\tLine num: $k, Line Data: $v\n";
            }
        }
    }
}

Output:

business-isp/lib/Business/ISP/Sanity.pm:

validate_data:
    Line num: 168, Line Data:  $self->validate_value({
audit:
    Line num: 72, Line Data:  my $date = $self->date({ get => $schedule });
    Line num: 77, Line Data:  # update the audit list if the process is claiming to be
    Line num: 86, Line Data:  date => $self->date({ get => 'day' }),
    Line num: 108, Line Data:  date => { -like => "$date%" },
    Line num: 123, Line Data:  my $executed_date = $executed->date;
    Line num: 126, Line Data:  "Process $process has already run its $schedule cycle on $executed_date";
validate_renew:
    Line num: 304, Line Data:  $self->validate_value({
validate_value:
    Line num: 193, Line Data:  # return if validate_value is disabled!
    Line num: 204, Line Data:  print "Sanity validate_value_debug: $tag, $value\n"; 

business-isp/lib/Business/ISP/GUI/Accounting.pm:

confirm_payment:
    Line num: 1312, Line Data:  my $date = $self->string_date();
    Line num: 1316, Line Data:  $self->pb_param( date => $date );
display_invoice:
    Line num: 1867, Line Data:  my $date = $invoice->[0]->{ date };
    Line num: 1928, Line Data:  $template->param( date => $date );

more