Front page | perl.perl5.porters |
Postings from August 2008
dprofpp enhanced
From:
Daniel Pfeiffer
Date:
August 24, 2008 05:55
Subject:
dprofpp enhanced
Message ID:
48B14E7C.6090506@t-online.de
--- /tmp/dprofpp 2008-08-24 13:35:33.000000000 +0200
+++ /tmp/dprofpp-5.10.1 2008-08-24 13:43:47.242108430 +0200
@@ -59,17 +59,9 @@
# In the following, perl variables are not expanded during extraction.
print OUT <<'!NO!SUBS!';
-=head1 NAME
-
-dprofpp - display perl profile data
-
-=head1 SYNOPSIS
-
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<-T|-t> [B<-F>] [B<-c regexp>] [B<-g subroutine>] [B<-i regexp>] [B<-w num>] [profile]
dprofpp B<-G> <regexp> [B<-P>] [profile]
@@ -221,6 +213,18 @@
Display system times rather than user+system times.
+=item B<-S>
+
+Display I<merged> subroutine call tree to stdout. Statistics are
+displayed for each branch of the tree.
+
+When a function is called multiple (I<not necessarily consecutive>)
+times in the same branch then all these calls go into one branch of
+the next level. A repeat count is output together with combined
+inclusive, exclusive and kids time.
+
+Branches are sorted with regard to inclusive time.
+
=item B<-T>
Display subroutine call tree to stdout. Subroutine statistics are
@@ -232,17 +236,25 @@
displayed. When a function is called multiple consecutive times at the same
calling level then it is displayed once with a repeat count.
-=item B<-S>
+=item B<-c regexp>
-Display I<merged> subroutine call tree to stdout. Statistics are
-displayed for each branch of the tree.
+Cut call tree display under any node matching regexp, such that the subtree
+root appears as a leaf.
-When a function is called multiple (I<not necessarily consecutive>)
-times in the same branch then all these calls go into one branch of
-the next level. A repeat count is output together with combined
-inclusive, exclusive and kids time.
+=item B<-i regexp>
-Branches are sorted with regard to inclusive time.
+Ignore any subtree who's root matches regexp.
+
+=item B<-o>
+
+Changes the format of -t, -T or -S to that of Emacs' M-x outline-mode. This
+allows highlighting the first 9 tree levels in different colors, navigating
+along the structure of the tree and hiding parts of it.
+
+=item B<-w number>
+
+Gives the indentation width for call trees. A value of 0 is convenient for
+piping the output to C<sort -u>.
=item B<-U>
@@ -339,16 +351,19 @@
-A Count autoloaded to *AUTOLOAD
-a Sort by alphabetic name of subroutines.
+ -c regexp Cut display under matching functions (-T/-t)
-d Reverse sort
-E Sub times are reported exclusive of child times. (default)
-f Filter all calls mathcing the pattern.
-G Group all calls matching the pattern together.
- -g subr Count only those who are SUBR or called from SUBR
+ -g subr Count or show only those who are SUBR or called from SUBR
-H Display long manual page.
-h Display this short usage message.
-I Sub times are reported inclusive of child times.
+ -i regexp Ignore matching functions and all below them (-T/-t).
-l Sort by number of calls to subroutines.
-O cnt Specifies maximum number of subroutines to display.
+ -o Alternate tree format for Emacs M-x outline-mode.
-P Used with -G to pull all other calls together.
-p script Specifies name of script to be profiled.
-Q Used with -p to indicate the dprofpp should quit
@@ -364,6 +379,7 @@
-u Use user time rather than user+system time.
-V Print dprofpp's version.
-v Sort by average amount of time spent in subroutines.
+ -w num Tab width for -T/-t, defaults to 3.
-z Sort by user+system time spent in subroutines. (default)
EOF
}
@@ -372,7 +388,7 @@
use Config '%Config';
Setup: {
- my $options = 'O:g:G:Pf:dlzaAvuTtqrRsUFEIp:QVShH';
+ my $options = 'O:g:G:Pf:dlzaAvuTtc:i:oqrRsUFEIp:QVShHw:';
$Monfile = 'tmon.out';
if( exists $ENV{DPROFPP_OPTS} ){
@@ -482,7 +498,7 @@
if( $opt_f ){
for(my $i = 0;$i < @$idkeys - 2;){
$key = $$idkeys[$i];
- if($key =~ /$opt_f/){
+ if($key =~ /$opt_f/o){
splice(@$idkeys, $i, 1);
$runtime -= $$times{$key};
next;
@@ -616,7 +632,8 @@
} else {
$time = sprintf '%.*f', $time_precision, $deep_times->{incl_time}/$hz;
}
- print ' ' x (2*$level), "$name x $deep_times->{count} \t${time}s\n"
+ print $opt_o ? (%{$deep_times->{kids}} ? '*' x ($level+1) . ' ' : ' ' x ($level+2)) : ' ' x ($opt_w*$level) ,
+ "$name x $deep_times->{count} \t${time}s\n"
if $deep_times->{count};
for $kid (sort kids_by_incl %{$deep_times->{kids}}) {
@@ -689,6 +706,20 @@
pop @$curdeep_times;
}
+my $prune;
+sub show {
+ my( $in, $name ) = @_;
+ return if defined $prune && $in > $prune;
+ if( $opt_c && $name =~ /$opt_c/o ) {
+ $prune = $in;
+ } elsif( $opt_i && $name =~ /$opt_i/o ) {
+ $prune = $in;
+ return;
+ } else {
+ undef $prune;
+ }
+ 1;
+}
sub parsestack {
my( $fh, $names, $calls, $times, $ctimes, $idkeys ) = @_;
@@ -698,12 +729,17 @@
my @stack = ();
my @tstack = ();
my %outer;
- my $tab = 3;
my $in = 0;
+ if( $opt_o ) {
+ $in = $opt_w = 1;
+ } elsif( !defined $opt_w ) {
+ $opt_w ||= 3;
+ }
# remember last call depth and function name
- my $l_in = $in;
- my $l_name = '';
+ my $l_in = $in - 1;
+ my @l_names;
+ my $desc;
my $repcnt = 0;
my $repstr = '';
my $dprof_stamp;
@@ -765,7 +801,7 @@
$t - $overhead) if $opt_S;
exitstamp( \@stack, \@tstack,
$t - $overhead,
- $times, $ctimes, $name, \$in, $tab,
+ $times, $ctimes, $name, \$in,
$curdeep_times, \%outer );
}
next unless $in_level or $name eq $opt_g;
@@ -777,26 +813,55 @@
$in_level++;
}
$overhead += $over_per_call;
- if( $opt_T ){
+ if( $opt_T || $opt_t ) {
+ if( show $in, $name ) {
+ if ( $opt_T ) {
+ if ( !$opt_o ) {
print ' ' x $in, "$name\n";
- $in += $tab;
+ } elsif ( $l_in != $in ) {
+ print $l_in > $in && $desc ? ' ' x ($l_in+1) : '*' x $l_in . ' ',
+ "$_\n"
+ for @l_names;
+ $desc = $l_in < $in;
+ $l_in = $in;
+ @l_names = $name;
+ } else {
+ push @l_names, $name;
}
- elsif( $opt_t ){
+ } else {
# suppress output on same function if the
# same calling level is called.
- if ($l_in == $in and $l_name eq $name) {
+ if ( $l_in == $in && @l_names && $l_names[-1] eq $name ) {
$repcnt++;
} else {
$repstr = ' ('.++$repcnt.'x)'
if $repcnt;
- print ' ' x $l_in, "$l_name$repstr\n"
- if $l_name ne '';
+ if ( !$opt_o ) {
+ print ' ' x $l_in, "@l_names$repstr\n"
+ if @l_names;
+ @l_names = $name;
+ } elsif ( @l_names ) {
+ $l_names[-1] .= $repstr
+ if $repcnt;
+ if ( $l_in != $in ) {
+ print $l_in > $in && $desc ? ' ' x ($l_in+1) : '*' x $l_in . ' ',
+ "$_\n"
+ for @l_names;
+ $desc = $l_in < $in;
+ @l_names = $name;
+ } else {
+ push @l_names, $name;
+ }
+ } else {
+ @l_names = $name;
+ }
$repstr = '';
$repcnt = 0;
$l_in = $in;
- $l_name = $name;
}
- $in += $tab;
+ }
+ }
+ $in += $opt_w;
}
if( ! defined $names->{$name} ){
$names->{$name} = $name;
@@ -819,9 +884,21 @@
die "Bad profile: $_";
}
}
- if( $opt_t ){
+ if( $opt_t ) {
$repstr = ' ('.++$repcnt.'x)' if $repcnt;
- print ' ' x $l_in, "$l_name$repstr\n";
+ if( $opt_o ) {
+ $l_names[-1] .= $repstr
+ if @l_names;
+ print $l_in > $in && $desc ? ' ' x ($l_in+1) : '*' x $l_in . ' ',
+ "$_\n"
+ for @l_names;
+ } else {
+ print ' ' x $l_in, "@l_names$repstr\n";
+ }
+ } elsif( $opt_o ) {
+ print $l_in > $in && $desc ? ' ' x ($l_in+1) : '*' x $l_in . ' ',
+ "$_\n"
+ for @l_names;
}
while (my ($key, $count) = each %outer) {
@@ -845,7 +922,7 @@
$name = $x->[0];
exitstamp( \@stack, \@tstack,
$t - $overhead, $times,
- $ctimes, $name, \$in, $tab,
+ $ctimes, $name, \$in,
$curdeep_times, \%outer );
add_to_tree($curdeep_times, $name,
$t - $overhead)
@@ -860,7 +937,7 @@
}
sub exitstamp {
- my($stack, $tstack, $t, $times, $ctimes, $name, $in, $tab, $deep, $outer) = @_;
+ my($stack, $tstack, $t, $times, $ctimes, $name, $in, $deep, $outer) = @_;
my( $x, $c, $z );
$x = pop( @$stack );
@@ -883,7 +960,7 @@
}
}
if( $opt_T || $opt_t ){
- $$in -= $tab;
+ $$in -= $opt_w;
}
# collect childtime
$c = pop( @$tstack );
@@ -972,6 +1049,7 @@
my $fmt = ' ^>>> ^>>>> ^>>>>> ^>>>>> ^>>>>> ^>>>>> ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<';
if (-t STDOUT and defined $stty and my ($cols) = `$stty -a` =~ /\bcolumns\s+(\d+)/)
{
+ $cols ||= $ENV{COLUMNS} || 0; # In Emacs stty reports 0.
$fmt .= '<' x ($cols - length $fmt) if $cols > 80;
}
-
dprofpp enhanced
by Daniel Pfeiffer