eval '(exit $?0)' && eval 'exec perl -S $0 ${1+"$@"}'
                  && eval 'exec perl -S $0 $argv:q'
                  if 0;

# The above invocation finds perl in the path, wherever it may be (except on Windows :)

# smallprof summary script (See Devel::SmallProf)

use strict;
use warnings;

# match anything with a dot, followed by zero or more non-dot characters, at end of string
our $FILE_SUFFIX = '\.[^.]*$';

use File::Basename;

use File::DosGlob qw( dosglob );
# convert filename wildcards to actual filenames
our $SCRIPT_NAME;
if ( $^O =~ /win/i ) # only if DOS
{
	$SCRIPT_NAME = fileparse($0,$FILE_SUFFIX);
	
	@ARGV = dosglob( @ARGV );
}
else
{
	$SCRIPT_NAME = basename($0);
}

use Getopt::Declare;

our $DEFAULT_INPUT_FILE = 'smallprof.out';

# option strings, also used as hash keys
our $COUNT_OPT       = 'k';
our $WALL_TIME_OPT   = 'W';
our $TOTAL_WALL_OPT  = 'w';
our $CPU_TIME_OPT    = 'C';
our $TOTAL_CPU_OPT   = 'c';
our $LINE_NUM_OPT    = 'l';
our $TEXT_OPT        = 't';
our $INPUT_FILE_OPT  = '[<input_file:if>...]';
our $REVERSE_OPT     = 'r'; # option key modifier

# other hash keys and strings of note
our $NEW_LINE        = 'NEW_LINE';
our $SEQ             = 'SEQ';
our $REVERSE         = 'REVERSE';
our $TYPE            = 'TYPE';
our $STRING_COMPARE  = 'cmp';
our $NUMERIC_COMPARE = '<=>';

our $sequence = 'A';

our %SORT_ORDER = ( $TOTAL_CPU_OPT   => { $SEQ => $sequence++, $REVERSE => 1, $TYPE => $NUMERIC_COMPARE },
                    $CPU_TIME_OPT    => { $SEQ => $sequence++, $REVERSE => 1, $TYPE => $NUMERIC_COMPARE },
                    $TOTAL_WALL_OPT  => { $SEQ => $sequence++, $REVERSE => 1, $TYPE => $NUMERIC_COMPARE },
                    $WALL_TIME_OPT   => { $SEQ => $sequence++, $REVERSE => 1, $TYPE => $NUMERIC_COMPARE },
                    $COUNT_OPT       => { $SEQ => $sequence++, $REVERSE => 1, $TYPE => $NUMERIC_COMPARE },
                    $LINE_NUM_OPT    => { $SEQ => $sequence++, $REVERSE => 0, $TYPE => $NUMERIC_COMPARE },
                    $TEXT_OPT        => { $SEQ => $sequence++, $REVERSE => 0, $TYPE => $STRING_COMPARE },
                  );

$sequence = '1'; # command line options will be sequenced from '1'

our @DEFAULT_OPT_ORDER_KEYS = sort { $SORT_ORDER{$a}{$SEQ} cmp $SORT_ORDER{$b}{$SEQ} } keys %SORT_ORDER;
our @DEFAULT_OPT_ORDER_PRINT = map {"-$_"} @DEFAULT_OPT_ORDER_KEYS;

my $option_spec = qq{
Description: 

	$SCRIPT_NAME summarizes the output from Devel::SmallProf (aka -d:SmallProf), computes single times (which SmallProf doesn't do), and sorts the output according to one or more fields. (SmallProf profiles Perl scripts, generating execution counts and cumulative execution times for each line.)
	
Options:

	-$COUNT_OPT	Sort by execution count
		{ \$::SORT_ORDER{$COUNT_OPT}{$REVERSE} = 1; \$::SORT_ORDER{$COUNT_OPT}{$SEQ} = \$::sequence++; }
	
	-$COUNT_OPT$REVERSE_OPT	[ditto]	(ascending)
		{ \$::SORT_ORDER{$COUNT_OPT}{$REVERSE} = 0; \$::SORT_ORDER{$COUNT_OPT}{$SEQ} = \$::sequence++ }
	
	-$WALL_TIME_OPT	Sort by "wallclock" time (real time elapsed)
		{ \$::SORT_ORDER{$WALL_TIME_OPT}{$REVERSE} = 1; \$::SORT_ORDER{$WALL_TIME_OPT}{$SEQ} = \$::sequence++ }

	-$WALL_TIME_OPT$REVERSE_OPT	[ditto]	(ascending)
		{ \$::SORT_ORDER{$WALL_TIME_OPT}{$REVERSE} = 0; \$::SORT_ORDER{$WALL_TIME_OPT}{$SEQ} = \$::sequence++ }
	
	-$TOTAL_WALL_OPT	Sort by total "wallclock" time (real time elapsed)	
		{ \$::SORT_ORDER{$TOTAL_WALL_OPT}{$REVERSE} = 1; \$::SORT_ORDER{$TOTAL_WALL_OPT}{$SEQ} = \$::sequence++ }

	-$TOTAL_WALL_OPT$REVERSE_OPT	[ditto]	(ascending)
		{ \$::SORT_ORDER{$TOTAL_WALL_OPT}{$REVERSE} = 0; \$::SORT_ORDER{$TOTAL_WALL_OPT}{$SEQ} = \$::sequence++ }
		
	-$CPU_TIME_OPT	Sort by "CPU" time (processor time on task)
		{ \$::SORT_ORDER{$CPU_TIME_OPT}{$REVERSE} = 1; \$::SORT_ORDER{$CPU_TIME_OPT}{$SEQ} = \$::sequence++ }
	
	-$CPU_TIME_OPT$REVERSE_OPT	[ditto]	(ascending)
		{ \$::SORT_ORDER{$CPU_TIME_OPT}{$REVERSE} = 0; \$::SORT_ORDER{$CPU_TIME_OPT}{$SEQ} = \$::sequence++ }
	
	-$TOTAL_CPU_OPT	Sort by total "CPU" time (processor time on task)
		{ \$::SORT_ORDER{$TOTAL_CPU_OPT}{$REVERSE} = 1; \$::SORT_ORDER{$TOTAL_CPU_OPT}{$SEQ} = \$::sequence++ }

	-$TOTAL_CPU_OPT$REVERSE_OPT	[ditto]	(ascending)
		{ \$::SORT_ORDER{$TOTAL_CPU_OPT}{$REVERSE} = 0; \$::SORT_ORDER{$TOTAL_CPU_OPT}{$SEQ} = \$::sequence++ }
	
	-$LINE_NUM_OPT	Sort by line number (in each file)
		{ \$::SORT_ORDER{$LINE_NUM_OPT}{$REVERSE} = 0; \$::SORT_ORDER{$LINE_NUM_OPT}{$SEQ} = \$::sequence++ }
	
	-$LINE_NUM_OPT$REVERSE_OPT	[ditto]	(descending)
		{ \$::SORT_ORDER{$LINE_NUM_OPT}{$REVERSE} = 1; \$::SORT_ORDER{$LINE_NUM_OPT}{$SEQ} = \$::sequence++ }

	-$TEXT_OPT	Sort by line text
		{ \$::SORT_ORDER{$TEXT_OPT}{$REVERSE} = 0; \$::SORT_ORDER{$TEXT_OPT}{$SEQ} = \$::sequence++ }
	
	-$TEXT_OPT$REVERSE_OPT	[ditto]	(descending)
		{ \$::SORT_ORDER{$TEXT_OPT}{$REVERSE} = 1; \$::SORT_ORDER{$TEXT_OPT}{$SEQ} = \$::sequence++ }
	
	$INPUT_FILE_OPT	one or more files to read (default is $DEFAULT_INPUT_FILE)

Option order is important, and case is preserved. The default order is:

	@DEFAULT_OPT_ORDER_PRINT

Sort direction defaults to descending for time values, and ascending for other values.
 
Sort options which have not been specified are used last, to maintain predictability and DWIMery.
	
Examples:

	Run $SCRIPT_NAME using all defaults (reads $DEFAULT_INPUT_FILE)
	
		$SCRIPT_NAME
	
	Sort by execution count:
	
		$SCRIPT_NAME -$COUNT_OPT
		
	Sort by execution count, then by total CPU time in ascending order:
	
		$SCRIPT_NAME -$COUNT_OPT -$TOTAL_CPU_OPT$REVERSE_OPT

Notes:

	Wildcarding is allowed (and obeys the rules of the underlying operating system). For example, to read in all *.out files in the current directory, use
	
		$SCRIPT_NAME *.out

When specifying paths to files, use forward slashes ("/"). You may not see a problem with backslashes ("\\") unless you are trying a network address. Perl sees "\\\\" as a single backslash, because "\\" escapes the next character following it, including "\\". A single backslash will work in most cases, unless the character following means something special to Perl. {Don't blame me, it's Bill Gates who started the awkwardness.}

	Remote "root" paths on Windoze (such as //pcname/some_dir) take a long time to resolve. Simply adding a wildcard (such as //pcname/some_dir/*) greatly improves the runtime.
};

my $options = Getopt::Declare->new( $option_spec )
  or die "\n**** Error processing command line options, terminating $SCRIPT_NAME\n";


################## down to business ####################

# create a custom sort subroutine given the command line options
my $sort_sub = create_sort_sub();

my $default_input_file = "smallprof.out";
push @ARGV, $default_input_file unless @ARGV;

my @new_lines;
my $current_file = '';
my $last_file = '';

LINE:
while (<>)
{
	if ( my ($this_file) = /^\s+profile\s+of\s+(.*?)\s+page\s+\d+\s?$/i )
	{
		$current_file = $this_file;
		if ( ( $last_file ne $current_file )
		 and ( @new_lines ) )
		{
			process_file(\@new_lines, $last_file, $sort_sub);
			undef @new_lines;
		}
		$last_file = $current_file;
		next LINE;
	}

	if ( my( $count, $total_wall, $total_cpu, $line_num, $text ) = /^\s+(\d+)\s+([\d.]+)\s+([\d.]+)\s+(\d+):(.*)$/ )
	{
		next unless $count; # don't summarize anything that wasn't executed
		my $wall_time = $count ? $total_wall / $count : $total_wall;
		my $cpu_time  = $count ? $total_cpu  / $count : $total_cpu;
		my $new_line   = sprintf "%10d  %10.5f  %10.3f  %10.5f  %10.3f  %8d:%s\n",
		                 $count, $wall_time, $total_wall, $cpu_time, $total_cpu, $line_num, $text;
		push @new_lines, { $COUNT_OPT       => $count, 
		                   $WALL_TIME_OPT   => $wall_time,
		                   $TOTAL_WALL_OPT  => $total_wall,
		                   $CPU_TIME_OPT    => $cpu_time,
		                   $TOTAL_CPU_OPT   => $total_cpu,
		                   $LINE_NUM_OPT    => $line_num,
		                   $TEXT_OPT        => $text,
		                   $NEW_LINE        => $new_line };
	}
}

# last file
if ( @new_lines )
{
	process_file(\@new_lines, $last_file, $sort_sub);
}

exit;

#####################################
sub process_file
{
	my $new_lines_ref = shift;
	my @new_lines = @{$new_lines_ref};
	my $current_file = shift;
	
	my $sort_sub = shift;
	
	# header for each file
	printf "%s\n%s%s\n%s\n", "="x70, " "x10, $current_file, "="x70;
	printf "%10s  %10s  %10s  %10s  %10s  %8s:%s\n", "Count", "Wall Time", "Total Wall", "CPU Time", "Total CPU", "Line", "Text";
	
	@new_lines = sort $sort_sub @new_lines;

	foreach my $line ( @new_lines )
	{
		print $line->{$NEW_LINE};
	}
}	
	
######################################
sub create_sort_sub
{
	my @sort_order = sort { $SORT_ORDER{$a}{$SEQ} cmp $SORT_ORDER{$b}{$SEQ} } keys %SORT_ORDER;
	
	my @AB = ('a','b');
	my @sort_sub_strings;
	foreach my $key ( @sort_order )
	{
		push @sort_sub_strings, "\t(\$" 
		                      . $AB[$SORT_ORDER{$key}{$REVERSE}]
		                      . "->{$key} "
		                      . $SORT_ORDER{$key}{$TYPE}
		                      . " \$"
		                      . $AB[1-$SORT_ORDER{$key}{$REVERSE}]
		                      . "->{$key})";
	}
	
	my $sort_sub_string = join " or \n", @sort_sub_strings;
	$sort_sub_string = "\n# line " . __LINE__ . " eval=in=create_sort_sub\n"
	                 . "sub {\n" . $sort_sub_string . "\n}";
	
	my $sub = eval $sort_sub_string
	   or die "Error eval'ing sub string, ";
}