#!/usr/bin/perl

# Program:      scan-perl-vars.perl
# Written by:   dave graff
# Purpose:      look for and summarize the declarations and calls
#                of lexically-scoped variables in a perl script

use strict;
my $Usage = "$0 [--listall] my_script.perl\n".
    " will list 'my' vars that have been declared more than once in a script\n".
    " (with --listall, will list all lexical variables, with line numbers)\n";

my $listyp = ' more than once';
if ( @ARGV > 1 and $ARGV[0] eq '--listall' ) {
    $listyp = ''; 
    shift;
}
die $Usage unless ( @ARGV == 1 && -r $ARGV[0] );

my $erlog = "/tmp/scn-src.$$.errlog";

my $file = shift;
warn "Deparsing $file...\n";
my @lines = `perl -MO=Deparse,-p $file 2> $erlog`;
die "Nothing deparsed from $file -- sorry.\n"
    unless ( @lines );

my $log = `cat $erlog`;
die "Syntax errors in $file -- come back when you're ready.\n"
    unless ( $log =~ /^$file syntax OK/ );

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

my %vardecs;  # HoA keyed by var name, stores line #(s) of declaration(s)

my $lineno = 0;
open( DP, ">$file.deparse" ) or warn "couldn't write deparsed code to $file.deparse:$!\n";

foreach (@lines) {
    $lineno++;
    print DP "$lineno\t$_";
    while (( my $nxt = index( $_, 'my' )) >= 0 ) {
        if ( /\bmy\(([^\)]+)/ ) {
            foreach my $name (split(/,/,$1)) {
                push @{$vardecs{$name}}, $lineno;
            }
        }
        elsif ( /\bmy\s+([\%\$\*\@]\S+)/ ) {
            push @{$vardecs{$1}}, $lineno;
            my $nxt = 0;
        }
        $_ = substr( $_, $nxt+3 );
    }
}
close DP;

# Now do some reporting

die "No lexically-scoped variables in $file\n" unless ( keys %vardecs );

my $nlisted = 0;
foreach (sort keys %vardecs) {
    next unless ( scalar @{$vardecs{$_}} > 1 or $listyp eq '');
    print join( ' ', $_, @{$vardecs{$_}}, "\n" );
    $nlisted++;
}
print "\nTotal of $nlisted 'my' variables declared$listyp in $file\n";
print "(see $file.deparse for correct line-number references)\n"
    if ( $nlisted );