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.
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; } |
|
---|
Replies are listed 'Best First'. | |
---|---|
RE: list_call
by mikfire (Deacon) on Aug 02, 2000 at 02:21 UTC |
Back to
Code Catacombs