Force RVALUE macros when in PERL_DEBUG_COW
[p5sagit/p5-mst-13.2.git] / utils / dprofpp.PL
index dfe9d3d..e62c07a 100644 (file)
@@ -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<dprofpp> command interprets profile data produced by a profiler, such
 as the Devel::DProf profiler.  Dprofpp will read the file F<tmon.out> 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<test.pl> with Devel::DProf the following command should
-be used.
+to profile script F<test.pl> 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> <regexp>
 
 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<perl>, L<Devel::DProf>, 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: $!";