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 (exc
+ept on Windows :)

# smallprof summary script (See Devel::SmallProf)

use strict;
use warnings;

# match anything with a dot, followed by zero or more non-dot characte
+rs, 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++, $REVERS
+E => 1, $TYPE => $NUMERIC_COMPARE },
                    $CPU_TIME_OPT    => { $SEQ => $sequence++, $REVERS
+E => 1, $TYPE => $NUMERIC_COMPARE },
                    $TOTAL_WALL_OPT  => { $SEQ => $sequence++, $REVERS
+E => 1, $TYPE => $NUMERIC_COMPARE },
                    $WALL_TIME_OPT   => { $SEQ => $sequence++, $REVERS
+E => 1, $TYPE => $NUMERIC_COMPARE },
                    $COUNT_OPT       => { $SEQ => $sequence++, $REVERS
+E => 1, $TYPE => $NUMERIC_COMPARE },
                    $LINE_NUM_OPT    => { $SEQ => $sequence++, $REVERS
+E => 0, $TYPE => $NUMERIC_COMPARE },
                    $TEXT_OPT        => { $SEQ => $sequence++, $REVERS
+E => 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_O
+RDER{$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:S
+mallProf), computes single times (which SmallProf doesn't do), and so
+rts the output according to one or more fields. (SmallProf profiles P
+erl scripts, generating execution counts and cumulative execution tim
+es for each line.)
    
Options:

    -$COUNT_OPT    Sort by execution count
        { \$::SORT_ORDER{$COUNT_OPT}{$REVERSE} = 1; \$::SORT_ORDER{$CO
+UNT_OPT}{$SEQ} = \$::sequence++; }
    
    -$COUNT_OPT$REVERSE_OPT    [ditto]    (ascending)
        { \$::SORT_ORDER{$COUNT_OPT}{$REVERSE} = 0; \$::SORT_ORDER{$CO
+UNT_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 elap
+sed)    
        { \$::SORT_ORDER{$TOTAL_WALL_OPT}{$REVERSE} = 1; \$::SORT_ORDE
+R{$TOTAL_WALL_OPT}{$SEQ} = \$::sequence++ }

    -$TOTAL_WALL_OPT$REVERSE_OPT    [ditto]    (ascending)
        { \$::SORT_ORDER{$TOTAL_WALL_OPT}{$REVERSE} = 0; \$::SORT_ORDE
+R{$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 tas
+k)
        { \$::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{$TEX
+T_OPT}{$SEQ} = \$::sequence++ }
    
    -$TEXT_OPT$REVERSE_OPT    [ditto]    (descending)
        { \$::SORT_ORDER{$TEXT_OPT}{$REVERSE} = 1; \$::SORT_ORDER{$TEX
+T_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 f
+or 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 oper
+ating 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 networ
+k address. Perl sees "\\\\" as a single backslash, because "\\" escap
+es the next character following it, including "\\". A single backslas
+h will work in most cases, unless the character following means somet
+hing special to Perl. {Don't blame me, it's Bill Gates who started th
+e 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 $S
+CRIPT_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 exe
+cuted
        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 Ti
+me", "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, ";
}