#!/usr/bin/perl

# Program:      scan-source.perl
# Written by:   dave graff
# Purpose:      look for and summarize the declarations and calls
#                of subroutines in a set of perl source files

use strict;
my $Usage = "$0 *.perl\n  will produce a summary of subs in perl files\n";

die $Usage unless ( @ARGV && -r $ARGV[0] );

my $erlog = "/tmp/scn-src.$$.errlog";
my %subdefs;  # hash to keep track of subroutine declarations
my %subrefs;  # hash to keep track of anonymous subroutine assignments
my %subsyns;  # hash to keep track of variables used as refs to named subs
my %subused;  # hash to keep track of subroutine calls

foreach my $file ( @ARGV )
{
    warn "Deparsing $file...\n";
    my @lines = `perl -MO=Deparse,-p $file 2> $erlog`;
    unless ( @lines ) {
        warn "Nothing deparsed from $file -- let's move on.\n";
        next;
    }
    my $log = do { open my $erfh, $erlog; local $/; <$erfh> };
    unless ( $log =~ /^$file syntax OK/ ) {
        warn "Syntax errors in $file -- let's move on.\n";
        next;
    }

# Store an array of subroutine defs in a hash element
# keyed by file name:

    (@{$subdefs{$file}}) = map{ m/^\s*sub (\w+) \{$/ } @lines;

# Store an array of anonymous subroutines, in case these are
# being assigned to variables as references:

    @{$subrefs{$file}} = map{ m/[\$\@\%](\w+)\S* \= sub \{/ } @lines;

# Store an array of variable names, where these are being
# used to hold references to named subroutines:

    @{$subsyns{$file}} = map{ m/[\%\$\@](\w+)\S* \= .*\\\&\w+/ } @lines;

# Now march through the lines looking for subroutine calls,
# keeping track of which subroutine we're in (if any);
# store arrays of sub calls in a hash keyed by "$file:$insub"
# (or "$file:NONSUB")

# NOTE: we won't even try keeping track with respect to
# anonymous subs.

    my $insub = "NONSUB"; # initial state is "not in a sub"
    foreach ( @lines ) {
        if ( /^\s*sub (\w+) \{/ ) {
            $insub = $1;
        }
        elsif ( /^\}$/ ) {
            $insub = "NONSUB";
        }
        # regex to spot a func or sub call (or most of them) --
        # this will need to change for Perl6:
        elsif ( /(\&\{?)?\$?(\w+)\S*?\(/ ) {
            $subused{"$file:$insub"}{$2}++
                unless ( "my local ref return" =~ /$2/ );
        }
    }
}
unlink $erlog;  # Don't keep this (and don't care if unlink fails)

# Now do some reporting

foreach my $file ( @ARGV )
{
    next unless exists $subdefs{$file};

    print "\n\nFile: $file";
    print( "\n subs defined:\n  ".
           join( "\n  ",@{$subdefs{$file}},"" ))
        if ( scalar( @{$subdefs{$file}} ));
    print( "\n anon.subs assigned to variables:\n  ".
           join( "\n  ",@{$subrefs{$file}},"" ))
        if ( scalar( @{$subrefs{$file}} ));
    print( "\n variables holding named sub refs:\n  ".
           join( "\n  ",@{$subsyns{$file}},"" ))
        if ( scalar( @{$subsyns{$file}} ));
    foreach my $insub ( grep( /$file:/, sort keys %subused )) {
        print( "\n\n subs/functions called from $insub:  ".
               join( "\n  ", sort keys %{$subused{$insub}},"" ))
            if ( scalar( keys %{$subused{$insub}} ));
    }
}
print "\n\n";