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, "; }
In reply to smallprof.pl by QM
| For: | Use: | ||
| & | & | ||
| < | < | ||
| > | > | ||
| [ | [ | ||
| ] | ] |