RE: dprofpp.pl updates

Message-ID: <D99914D9109BD411823800508BD957180E1269@exch01.ops.endeca.com>

p4raw-id: //depot/perl@9701

1 files changed, 106 insertions, 4 deletions

diff --git a/utils/dprofpp.PL b/utils/dprofpp.PL
index 51e8d7839a..b1379bf7e3 100644
--- a/utils/dprofpp.PL
+++ b/utils/dprofpp.PL
@@ -57,12 +57,14 @@ dprofpp - display perl profile data
 
 =head1 SYNOPSIS
 
-dprofpp [B<-a>|B<-z>|B<-l>|B<-v>|B<-U>] [B<-s>|B<-r>|B<-u>] [B<-q>] [B<-F>] [B<-I|-E>] [B<-O cnt>] [B<-A>] [B<-R>] [B<-S>] [B<-g subroutine>] [profile]
-
+dprofpp [B<-a>|B<-z>|B<-l>|B<-v>|B<-U>] [B<-d>] [B<-s>|B<-r>|B<-u>] [B<-q>] [B<-F>] [B<-I|-E>] [B<-O cnt>] [B<-A>] [B<-R>] [B<-S>] [B<-g subroutine>] [B<-G> <regexp> [B<-P>]] [B<-f> <regexp>] [profile]
+  
 dprofpp B<-T> [B<-F>] [B<-g subroutine>] [profile]
 
 dprofpp B<-t> [B<-F>] [B<-g subroutine>] [profile]
 
+dprofpp B<-G> <regexp> [B<-P>] [profile]
+ 
 dprofpp B<-p script> [B<-Q>] [other opts]
 
 dprofpp B<-V> [profile]
@@ -147,6 +149,10 @@ Average time (in seconds) spent in each call of this routine
 
 Sort alphabetically by subroutine names.
 
+=item B<-d>
+
+Reverse whatever sort is used
+
 =item B<-A>
 
 Count timing for autoloaded subroutine as timing for C<*::AUTOLOAD>.
@@ -258,6 +264,25 @@ should show you which subroutines are using the most time.
 
 Ignore subroutines except C<subroutine> and whatever is called from it.
 
+=item B<-G> <regexp>
+
+Aggregate "Group" all calls matching the pattern together.
+For example this can be used to group all calls of a set of packages
+
+  -G "(package1::)|(package2::)|(package3::)"
+
+or to group subroutines by name:
+
+  -G "getNum"
+
+=item B<-P>
+
+Used with -G to aggregate "Pull"  together all calls that did not match -G.
+
+=item B<-f> <regexp>
+
+Filter all calls matching the pattern.
+
 =back
 
 =head1 ENVIRONMENT
@@ -297,7 +322,7 @@ use Getopt::Std 'getopts';
 use Config '%Config';
 
 Setup: {
-	my $options = 'O:g:lzaAvuTtqrRsUFEIp:QVS';
+	my $options = 'O:g:G:Pf:dlzaAvuTtqrRsUFEIp:QVS';
 
 	$Monfile = 'tmon.out';
 	if( exists $ENV{DPROFPP_OPTS} ){
@@ -340,6 +365,11 @@ Setup: {
 # -g subr	count only those who are SUBR or called from SUBR
 # -S		Create statistics for all the depths
 
+# -G		Group all calls matching the pattern together.
+# -P		Used with -G to pull all other calls together.
+# -f		Filter all calls mathcing the pattern.
+# -d		Reverse sort
+
 	if( defined $opt_V ){
 		my $fh = 'main::fh';
 		print "$0 version: $VERSION\n";
@@ -357,6 +387,10 @@ Setup: {
 	$sort = 'by_calls' if defined $opt_l;
 	$sort = 'by_alpha' if defined $opt_a;
 	$sort = 'by_avgcpu' if defined $opt_v;
+	
+	if(defined $opt_d){
+		$sort = "r".$sort;
+	}
 	$incl_excl = 'Exclusive';
 	$incl_excl = 'Inclusive' if defined $opt_I;
 	$whichtime = 'User+System';
@@ -412,6 +446,23 @@ Main: {
 
 	parsestack( $fh, $names, $calls, $times, $ctimes, $idkeys );
 
+	#filter calls
+	if( $opt_f ){
+		for(my $i = 0;$i < @$idkeys - 2;){
+			$key = $$idkeys[$i];
+			if($key =~ /$opt_f/){
+				splice(@$idkeys, $i, 1);
+				$runtime -= $$times{$key};
+				next;
+			}
+			$i++;
+		}
+	}
+
+	if( $opt_G ){
+		group($names, $calls, $times, $ctimes, $idkeys );
+	}
+
 	settime( \$runtime, $hz ) unless $opt_g;
 
 	exit(0) if $opt_T || $opt_t;
@@ -430,6 +481,49 @@ Main: {
 		 $deep_times);
 }
 
+sub group{
+	my ($names, $calls, $times, $ctimes, $idkeys ) = @_;
+		print "Option G Grouping: [$opt_G]\n";
+		# create entries to store grouping
+		$$names{$opt_G} = $opt_G;
+		$$calls{$opt_G} = 0;
+		$$times{$opt_G} = 0;
+		$$ctimes{$opt_G} = 0;
+		$$idkeys[@$idkeys] = $opt_G;
+		# Sum calls for the grouping
+
+		my $other = "other";
+		if($opt_P){
+			$$names{$other} = $other;
+			$$calls{$other} = 0;
+			$$times{$other} = 0;
+			$$ctimes{$other} = 0;
+			$$idkeys[@$idkeys] = $other;
+		}
+
+		for(my $i = 0;$i < @$idkeys - 2;){
+			$key = $$idkeys[$i];
+			if($key =~ /$opt_G/){
+				$$calls{$opt_G} += $$calls{$key};
+				$$times{$opt_G} += $$times{$key};
+				$$ctimes{$opt_G} += $$ctimes{$key};
+				splice(@$idkeys, $i, 1);
+				next;
+			}else{
+				if($opt_P){
+					$$calls{$other} += $$calls{$key};
+					$$times{$other} += $$times{$key};
+					$$ctimes{$other} += $$ctimes{$key};
+					splice(@$idkeys, $i, 1);
+					next;
+				}
+			}
+			$i++;
+		}
+		print "Grouping [$opt_G] Calls: [$$calls{$opt_G}]\n".
+			  "Grouping [$opt_G] Times: [$$times{$opt_G}]\n".
+			  "Grouping [$opt_G] IncTimes: [$$ctimes{$opt_G}]\n";
+}
 
 # Sets $runtime to user, system, real, or user+system time.  The
 # result is given in seconds.
@@ -563,6 +657,7 @@ sub add_to_tree {
   pop @$curdeep_times;
 }
 
+
 sub parsestack {
 	my( $fh, $names, $calls, $times, $ctimes, $idkeys ) = @_;
 	my( $dir, $name );
@@ -734,7 +829,7 @@ sub exitstamp {
 	if( ! defined $x ){
 		die "Garbled profile, missing an enter time stamp";
 	}
-	if( $x->[0] ne $name ){
+	if( $x->[0] ne $name and $opt_G and ($name =~ /$opt_G/)){
 	  if ($x->[0] =~ /::AUTOLOAD$/) {
 	    if ($opt_A) {
 	      $name = $x->[0];
@@ -814,6 +909,12 @@ sub by_ctime { $ctimes->{$b} <=> $ctimes->{$a} }
 sub by_calls { $calls->{$b} <=> $calls->{$a} }
 sub by_alpha { $names->{$a} cmp $names->{$b} }
 sub by_avgcpu { $persecs->{$b} <=> $persecs->{$a} }
+# Reversed
+sub rby_time { $times->{$a} <=> $times->{$b} }
+sub rby_ctime { $ctimes->{$a} <=> $ctimes->{$b} }
+sub rby_calls { $calls->{$a} <=> $calls->{$b} }
+sub rby_alpha { $names->{$b} cmp $names->{$a} }
+sub rby_avgcpu { $persecs->{$a} <=> $persecs->{$b} }
 
 
 format CSTAT_top =
@@ -836,3 +937,4 @@ $pcnt, $secs, $csecs, $ncalls, $percall, $cpercall, $name
 close OUT or die "Can't close $file: $!";
 chmod 0755, $file or die "Can't reset permissions for $file: $!\n";
 exec("$Config{'eunicefix'} $file") if $Config{'eunicefix'} ne ':';
+