#!/usr/bin/perl -w
# function_call_eval.pl
# written by Meryll Larkin
# March 2, 2013
# Updated June 6, 2016
# find all functions in script
# determine which of them call the others
# output:
# list of functions by which calls which
# list of functions by which is called by which
#

use strict;
use Data::Dumper;

my %functions;
# functions => {
#    function_name => {
#        start_line_no  =>  35
#        end_line_no    =>  65
#        function1      =>  i_call
#        function2      =>  i_call
#        function3      =>  i_call
#        function4      =>  calls_me
#    }

# preserve line order in script
my @functions;
$functions[0] = "MAIN";

my $DEBUG = 1;
my $line_count = 0;

my $script  = $ARGV[0] || &get_script_name;

open (INPUT, $script) || die "cannot open $script for reading " . $! . "\n";

# first make a hash of all the subroutines/functions
$functions{"MAIN"}{"start_line_no"} = '1';
my $previous_function = "MAIN";

# use script name in output file name - remove the path first
$script =~ s/^.*\///;

my $output = $script . "_out.txt";

open (OUTPUT, ">>$output") || die "cannot open $output for writing " . $! . "\n";

print OUTPUT "Evaluating functions of script:  $script\n\n";

while (<INPUT>) {
     chomp(my $line = $_);
     $line_count++;
     # ignore comment lines
     next if ($line =~ /\s*\#/);
     # find lines that have names of functions on them
     next if ($line !~ /^\s*sub\s+\w+/);
     my $function = $line;
     # strip off "sub "
     $function =~ s/^\s*sub\s+//;
     # strip off " {";
     $function =~ s/\s+\{\s*$//;
     print "$function $line_count\n" if ($DEBUG);
     print OUTPUT "$function $line_count\n" if ($DEBUG);
     push (@functions, $function);
     $functions{$previous_function}{"end_line_no"} =  ($line_count -1);
     $functions{$function}{"start_line_no"} = $line_count;
     $previous_function = $function;
}
$functions{$previous_function}{"end_line_no"} = ($line_count - 1);
# print Dumper(\%functions) if ($DEBUG);
# print "\n" if ($DEBUG);

for my $key (sort (keys %functions)) {
    my $start = $functions{$key}{"start_line_no"};
    my $end = $functions{$key}{"end_line_no"};
    print "$key\n" if ($DEBUG);
    print "    start = $start   end = $end\n" if($DEBUG);
}
close INPUT;

print "\n" .'#***************************************************' . "\n";
print OUTPUT "\n" . '#***************************************************' ."\n";
print "\nMy Function Calls Out To:\n\n";
print OUTPUT "\nMy Function Calls Out to:\n\n";
$line_count = 0;
my %function_calls;
my @calls;
open (INPUT, $script) || die "cannot open $script for reading " . $! . "\n";

while (<INPUT>) {
     chomp(my $line = $_);
     $line_count++;
     # ignore comment lines
     next if ($line =~ /\s*\#/);
     # ignore empty lines and close bracket lines
     next if ($line !~ /\w+/);
     # ignore lines that are function declarations
     next if ($line =~ /^\s*sub\s+\w+/);
     for my $key (keys %functions) {
         if ($line =~ /$key/) {
             if ($line =~ /\W$key\W/) {
                 # still not certain this is calling a function
                 if (( $line =~ /&$key/) || ($line =~ /$key\s*\(/)) {
                     # print "Found:  $key on line number $line_count\n" if ($DEBUG);
                     # can't use function call as key due to needs to be unique
                     $function_calls{"$line_count"} = $key;
                     # print "function_calls \{ $line_count \} = $key\n";
                 }
             }
         }
         next;
     }
}
close INPUT;

my @calls_inside_function;

for my $function  (@functions) {
    print "$function\n";
    print OUTPUT "$function\n";
    my $start = $functions{$function}{"start_line_no"};
    my $end = $functions{$function}{"end_line_no"};
    for ($start .. $end) {
        my $line_no = $_;
        $line_no = "$line_no";
        if (exists $function_calls{$line_no}) {
            my $call = $function_calls{$line_no};
            print "  $call\n";
            print OUTPUT "  $call\n";
            $functions{$function}{$call} = "i_call";
            $functions{$call}{$function} = "calls_me";
        }
    }
}
print "\n" . '#***************************************************' . "\n";
print OUTPUT "\n" . '#***************************************************' . "\n";
print "\nThese Functions Call To Me:\n\n";
print OUTPUT "\nThese Functions Call To ME:\n\n";

for my $function (@functions) {
    print "$function\n";
    print OUTPUT "$function\n";
    for my $key (keys %{ $functions{$function} } ) {
        if ( $functions{$function}{$key} eq "calls_me" ) {
        print "    $key\n";
        print OUTPUT "    $key\n";
        }
    }
    print "\n";
    print OUTPUT "\n";
}

close OUTPUT;
print "Output also printed to file:  $output\n";
exit (0);


#############################################################

sub get_script_name {
    print "Please provide name of script: ";
    chomp (my $script = <STDIN>);
    return $script;
}

#############################################################

#--END --