Beefy Boxes and Bandwidth Generously Provided by pair Networks
Problems? Is your data what you think it is?
 
PerlMonks  

list_call

by mikfire (Deacon)
on Aug 01, 2000 at 19:29 UTC ( #25478=sourcecode: print w/ replies, xml ) Need Help??

Category: text processing
Author/Contact Info Mik Firestone mik@speed.stdio.com This code is provided as is. If it causes the end of the world as we know it, it is not
Description: A down and dirty little script that reads a file, looking for subroutine definitions. It extracts these and then parses through a whole bunch of other files looking for calls to those functions. It isn't perfect, but it works pretty well.

Usage: list_call source file [ ...]
where source is the file from which to extract the calls and file is the file to be searched.
#!/usr/bin/perl -w
use strict;
#------------
# This code is provided as is.  There is no implied warrenty
# and it may do anything from nothing to causing the end
# of the world as we know it.  I take no responsibilty for
# and such cause.
#
# It is under the Artistic license, but if you use it and
# fix it, I sure would appreciate the patch.
#
# Mik Firestone, Aug 1 2000
#
# mik@speed.stdio.com
#-------------

die "$0 <source> <target> ..." unless @ARGV > 1;
my %keyword = ();

my ( $source, @targets ) = @ARGV;

my $package = '';
#---
# Try to extract the keywords, precompile the regex and store
#---
open SRC, $source or die "Couldn't open $source : $!";
while( <SRC> ) {
    $package = $1 if ( ! $package && /^package\s+(.+);/ );
    next unless ( /^sub\s+(.+){\s*$/ );

    my $name;
    $name = $1;
    next if ( substr($name,0,1) eq "_" );

    $name =~ s/\s+$//;
    $keyword{$name} = qr/([\w:{}]+)->$name/;
}
close SRC;

for my $file ( @targets ) {
    my ( $line );

    open FILE, $file or die "Couldn't open $file : $!";

    LINE:
        while( $line = <FILE> ) {
            next LINE if ( $line =~ /^\s*#/ || $line =~ /^\s*$/ );
            last LINE if $line =~ /__END__/;


            for ( keys %keyword ) {
                my $regex = $keyword{$_};
                if ( $line =~ /$regex/ ) {
                    my $starts_at = $.;
                    my $lpack = $1 || '';

                    next LINE if ( $file eq $source ) && ( $line =~ /^
+sub/ );
                    next LINE if ( $line =~ /Usage/ );
                    next LINE if ( $lpack =~ /::/ && $lpack ne $packag
+e );

                    while( $line !~ /;/ && ! eof(FILE) ) {
                        $line .= <FILE>;
                        next LINE if $line =~ /^EOF/m;
                    }
                    $line =~ s/^\s*//;
                    printf "%s (%d) %s", uc $file, $starts_at, $line;
                    next LINE;
                }
            }
        }
    #LINE
    close FILE;
}

Comment on list_call
Download Code
RE: list_call
by mikfire (Deacon) on Aug 02, 2000 at 02:21 UTC
    Wouldn't you know it? Reading this over I noticed a hidden assumption in the code.

    I am assuming you have only one package statement per file. This isn't the safest, but it does reflect the way I almost always do my code. Let me think for a few minutes and I may post a fix.

    Mea culpa,
    mikfire

Back to Code Catacombs

Log In?
Username:
Password:

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

How do I use this? | Other CB clients
Other Users?
Others surveying the Monastery: (9)
As of 2015-07-02 01:55 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    The top three priorities of my open tasks are (in descending order of likelihood to be worked on) ...









    Results (25 votes), past polls