X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=utils%2Fdprofpp.PL;h=e62c07ac41d42d480b96d67a5301a0d99de910bf;hb=62703e7218aceb3f5d30f70a2307dd02e5eb8c63;hp=dfe9d3dbbfd1eebe1a6fc7454986f42d367bb238;hpb=1d9525ac4548fadba8931dabed738577ec3119a6;p=p5sagit%2Fp5-mst-13.2.git diff --git a/utils/dprofpp.PL b/utils/dprofpp.PL index dfe9d3d..e62c07a 100644 --- a/utils/dprofpp.PL +++ b/utils/dprofpp.PL @@ -14,9 +14,8 @@ use File::Spec; # This forces PL files to create target in same directory as PL file. # This is so that make depend always knows where to find PL derivatives. chdir(dirname($0)); -($file = basename($0)) =~ s/\.PL$//; -$file =~ s/\.pl$// if ($Config{'osname'} eq 'OS2'); # "case-forgiving" -$file =~ s/\.pl$/.com/ if ($Config{'osname'} eq 'VMS'); # "case-forgiving" +($file = basename($0)) =~ s/\.PL$//i; +$file .= '.COM' if ($^O eq 'VMS'); my $dprof_pm = File::Spec->catfile(File::Spec->updir, 'ext', 'Devel', 'DProf', 'DProf.pm'); my $VERSION = 0; @@ -31,6 +30,13 @@ close PM; if( $VERSION == 0 ){ die "Did not find VERSION in $dprof_pm"; } +my $stty = 'undef'; +foreach my $s (qw(/bin/stty /usr/bin/stty)) { + if (-x $s) { + $stty = qq["$s"]; + last; + } +} open OUT,">$file" or die "Can't create $file: $!"; print "Extracting $file (with variable substitutions)\n"; @@ -46,6 +52,7 @@ $Config{'startperl'} require 5.003; my \$VERSION = '$VERSION'; +my \$stty = $stty; !GROK!THIS! @@ -74,13 +81,12 @@ dprofpp B<-V> [profile] The I command interprets profile data produced by a profiler, such as the Devel::DProf profiler. Dprofpp will read the file F and -will display the 15 subroutines which are using the most time. By default +display the 15 subroutines which are using the most time. By default the times for each subroutine are given exclusive of the times of their child subroutines. To profile a Perl script run the perl interpreter with the B<-d> switch. So -to profile script F with Devel::DProf the following command should -be used. +to profile script F with Devel::DProf use the following: $ perl5 -d:DProf test.pl @@ -236,7 +242,7 @@ 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 w.r.t. inclusive time. +Branches are sorted with regard to inclusive time. =item B<-U> @@ -278,12 +284,20 @@ or to group subroutines by name: =item B<-P> -Used with -G to aggregate "Pull" together all calls that did not match -G. +Used with -G to aggregate "Pull" together all calls that did not match -G. =item B<-f> Filter all calls matching the pattern. +=item B<-h> + +Display brief help and exit. + +=item B<-H> + +Display long help and exit. + =back =head1 ENVIRONMENT @@ -319,11 +333,46 @@ L, L, times(2) =cut +sub shortusage { + print <<'EOF'; +dprofpp [options] [profile] + + -A Count autoloaded to *AUTOLOAD + -a Sort by alphabetic name of subroutines. + -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 + -H Display long manual page. + -h Display this short usage message. + -I Sub times are reported inclusive of child times. + -l Sort by number of calls to subroutines. + -O cnt Specifies maximum number of subroutines to display. + -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 + after profiling the script, without interpreting the data. + -q Do not print column headers. + -R Count anonyms separately even if from the same package + -r Use real elapsed time rather than user+system time. + -S Create statistics for all the depths + -s Use system time rather than user+system time. + -T Show call tree. + -t Show call tree, compressed. + -U Do not sort subroutines. + -u Use user time rather than user+system time. + -V Print dprofpp's version. + -v Sort by average amount of time spent in subroutines. + -z Sort by user+system time spent in subroutines. (default) +EOF +} + use Getopt::Std 'getopts'; use Config '%Config'; Setup: { - my $options = 'O:g:G:Pf:dlzaAvuTtqrRsUFEIp:QVS'; + my $options = 'O:g:G:Pf:dlzaAvuTtqrRsUFEIp:QVShH'; $Monfile = 'tmon.out'; if( exists $ENV{DPROFPP_OPTS} ){ @@ -337,39 +386,21 @@ Setup: { @ARGV = @tmpargv; } - getopts( $options ); + getopts( $options ) or die "Try 'dprofpp -h' for help.\n"; if( @ARGV ){ # there was a filename, it overrides any earlier name. $Monfile = shift; } -# -O cnt Specifies maximum number of subroutines to display. -# -a Sort by alphabetic name of subroutines. -# -z Sort by user+system time spent in subroutines. (default) -# -l Sort by number of calls to subroutines. -# -v Sort by average amount of time spent in subroutines. -# -T Show call tree. -# -t Show call tree, compressed. -# -q Do not print column headers. -# -u Use user time rather than user+system time. -# -s Use system time rather than user+system time. -# -r Use real elapsed time rather than user+system time. -# -U Do not sort subroutines. -# -E Sub times are reported exclusive of child times. (default) -# -I Sub times are reported inclusive of child times. -# -V Print dprofpp's version. -# -p script Specifies name of script to be profiled. -# -Q Used with -p to indicate the dprofpp should quit after -# profiling the script, without interpreting the data. -# -A count autoloaded to *AUTOLOAD -# -R count anonyms separately even if from the same package -# -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_h ) { + shortusage(); + exit; + } + if ( defined $opt_H ) { + require Pod::Usage; + Pod::Usage::pod2usage( {-verbose => 2, -input => $0 } ); + exit; + } if( defined $opt_V ){ my $fh = 'main::fh'; @@ -937,11 +968,17 @@ $incl_excl %Time ExclSec CumulS #Calls sec/call Csec/c Name . -format STAT = - ^>>> ^>>>> ^>>>>> ^>>>>> ^>>>>> ^>>>>> ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< -$pcnt, $secs, $csecs, $ncalls, $percall, $cpercall, $name -. +BEGIN { + my $fmt = ' ^>>> ^>>>> ^>>>>> ^>>>>> ^>>>>> ^>>>>> ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<'; + if (-t STDOUT and defined $stty and my ($cols) = `$stty -a` =~ /\bcolumns\s+(\d+)/) + { + $fmt .= '<' x ($cols - length $fmt) if $cols > 80; + } + eval "format STAT = \n$fmt" . ' +$pcnt, $secs, $csecs, $ncalls, $percall, $cpercall, $name +.'; +} !NO!SUBS! close OUT or die "Can't close $file: $!";