#!/bin/sh -- # A comment mentioning perl, indented bash's sake.
eval 'exec perl -S $0 ${1+"$@"}'
        if 0;

$SafeStart = 1;

chop($Program = `basename $0`);

$Usage = <<"END";

$Program: Count subroutine calls that a perl script makes.

Usage: $Program [<options>] <command> [<command_options>]

Options:
	-q	Be quiet.
	-b	Batch mode (no prompting).
	-h	Print this help.

END

$NewScript = "/tmp/$Program.$$";

open(PROF, ">$NewScript") || die "open for writing: $!"; 

LOOP:	
while (@ARGV) {
    $_ = shift;
    CASE: {
	/^-q$/ && ($Quiet = 1, last CASE);
	/^-b$/ && ($Batch = 1, last CASE);
	/^-(-.*)$/ && (unshift(@ARGV, $1), last CASE);
	/^(-h|-help)$/ && ((print $Usage), exit 0, last CASE);
	if ( /^-(..+)$/ ) {	# split bundled switches:
		local($y, $x) = ($1, '');
		foreach $x (reverse(split(//, $y))) { unshift(@ARGV,"-$x") };
		last CASE;
	}
	/^-/ && ((print "Invalid arg: $_\n$Usage"), exit 1, last CASE);
	unshift(@ARGV,$_);
	last LOOP;
    }
}

$CmdFile = shift;

if ( $CmdFile !~ m,/, ) {
	foreach $dir (split(/:/, $ENV{PATH})) {
		if ( -x "$dir/$CmdFile" ) {
			$CmdFile = "$dir/$CmdFile";
			last;
		}
	}
}

die "Cannot find command file: $CmdFile" if ! -x $CmdFile;
print STDERR "$Program: Using $CmdFile\n" unless $Quiet;

open(SCRIPT, "$CmdFile") || die "open for reading: $!";

while (<SCRIPT>) {
	if ( /^\s*sub\s+(\w+)\b/ ) {
		$name = $1;
		chop($find = $_);
		$var = "sub_$name";
		$line = "\$${var}\+\+; # from $Program\n";
		$tmp = $_;
		$tmp =~ s/\s*#.*$//;
		if ( $tmp !~ /\s+\{\s*$/ ) {
			$Script .= $_;
			$_ = <SCRIPT>;
			$tmp = $_;
			$tmp =~ s/\s*#.*$//;
		}
		if ( $tmp =~ /\{\s*$/ ) {
			$_ .= $line;
			$Subs{$name} = $find;
		} else {
			print STDERR "problem with sub $name: $tmp\n" unless $Quiet;
		}
	}
	$Script .= $_;
}

$msg1 = "$Program: subroutine call counts:"; $msg2 = $msg1; $msg2 =~ s/./-/g;

$print_cmds = "{ print STDERR \"\\n$msg2\\n$msg1\\n\"; ";

foreach $sub (sort(keys(%Subs))) {
	$print_cmds .= "print STDERR sprintf(\"%6d\", \$sub_${sub}) . \" $sub\\n\"; ";
}
$print_cmds .= "}\n";

$first_sub = 1;
foreach $line (split(/\n/, $Script)) {
	if ( $line =~ /^\s*sub\s+(\w+)\b/ ) {
		$name = $1;
		if ($first_sub) {
			$first_sub = 0;
			print PROF $print_cmds;
		}
	} elsif ( $line =~ /\bexit\b[\(\d\)\s]*\b/ ) {
		if ( $line !~ /exit\b[\(\d\)\s]*,/ && $line !~ /#.*exit/ ) {
			$line =~ s/exit/$print_cmds exit/g;
		}
	}
	print PROF $line . "\n";
}

close(PROF);

chmod 0755, $NewScript;
print STDERR "$Program: modified script is $NewScript\n" unless $Quiet;
$args = join(' ', @ARGV);

$cmd = "$NewScript $args";
$n = 2;
if ( $SafeStart && ! $Batch && ! $Quiet ) {
	print STDERR "$Program: Command is   ==> $cmd\n";
	print STDERR "$Program: Run it? [y]/n ";
	$x = <STDIN>;
	if ( $x =~ /n/i ) {
		print STDERR "$Program: Remove $NewScript ? [y]/n ";
		$x = <STDIN>;
		if ( $x !~ /n/i ) {
			unlink $NewScript;
		}
		exit 0;
	}
} elsif ( $Batch ) {
	print STDERR "$Program: running ==> $cmd\n" unless $Quiet;
} elsif ( $Quiet ) {
	;
} else {
	print STDERR "$Program: in $n seconds will run\n\t==> $cmd\n" unless $Quiet;
	sleep $n;
}

system($cmd);

unlink $NewScript;

exit 0;