Stories
Slash Boxes
Comments
NOTE: use Perl; is on undef hiatus. You can read content, but you can't post it. More info will be forthcoming forthcomingly.

All the Perl that's Practical to Extract and Report

use Perl Log In

Log In

[ Create a new account ]

Ovid (2709)

Ovid
  (email not shown publicly)
http://publius-ovidius.livejournal.com/
AOL IM: ovidperl (Add Buddy, Send Message)

Stuff with the Perl Foundation. A couple of patches in the Perl core. A few CPAN modules. That about sums it up.

Journal of Ovid (2709)

Thursday March 15, 2007
12:33 PM

Find out which subs I'm using

[ #32697 ]

This is a massive hack, but it sort of works. Comes with no warranty.

Assuming you have two files with Perl in them, attempts to find subroutines in the first which are used in the second. I'm almost embarrassed to post this as it's so crufty and somewhat dependent on coding style (not using PPI, for example), but this solves most of the problem it was meant to solve.

My next bit should be to write a Vim function which figures out what file I am "require"ing or "use"ing on the cursor's current line and automatically make that the "from" file and the file I'm editing the "to" file.

#!/usr/bin/perl

use strict;
use warnings;

use Regexp::Assemble;
use Text::Table;

my $min_sub_name_length = 4;

my $from = shift or die "usage: $0 from_perl to_perl";
my $to   = shift or die "usage: $0 from_perl to_perl";

open my $fh, '<', $from or die "Cannot open ($from) for reading: $!";
my @subs;

while (<$fh>) {
    push @subs => $1
      if /^\s*sub\s+([[:word:]]+)/ && length $1 >= $min_sub_name_length;
}
close $fh or die $!;

my $ra = Regexp::Assemble->new;
$ra->add($_) foreach @subs;
my $possible_sub = $ra->re;

open $fh, '<', $to or die "Cannot open ($to) for reading: $!";
while (<$fh>) {
    chomp;
    if (/\b$possible_sub\b/) {
        print_subs(@subs);
        print "Line $.:  $_\n";
    }
}

{
    my $table_printed = 0;

    sub print_subs {
        return if $table_printed++;
        my @subs = sort @_;
        print " -- Possible subs we're looking for --\n\n";
        my $tb = Text::Table->new;
        $tb->load( [ splice @subs, 0, 3 ] ) while @subs;
        print $tb;
        print "\n";
    }
}

And I get output similar to:

:!find_subs_in_other_file lib/General/Config.pm cronjobs/searchlog
-- Possible subs we're looking for --

append_newline_if_not_exists back                   check_domain_syntax
chown_by_name                config                 domain_tld_lookup
generate_row                 generate_side_table    generate_table
get_brand_from_username      get_config             get_dedicated_transfer
get_os                       get_prior_bandwidth    get_server_fqdn
hashed_directory             html_email             htmlify
plain_email                  process_template_files round
validate_ip

Line 32:  %config = get_config("/usr/local/controlpanel/conf/cron.conf");
Line 34:  $dbh = DBI->connect("DBI:$config{sql_server}:$config{sql_database}:$config{sql_host}"," $config{sql_username}","$config{sql_password}", { AutoCommit => 1 }) || notify("Could not connect to a database server");
Line 137:          my $admin_email = config('admin_email');
Line 236:  =back

Not perfect, but it's a helpful start.

The Fine Print: The following comments are owned by whoever posted them. We are not responsible for them in any way.
 Full
 Abbreviated
 Hidden
More | Login | Reply
Loading... please wait.