This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Use File::Temp for tempfiles if it is available.
[perl5.git] / utils / dprofpp.PL
index dfe9d3d..eabc7b1 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!
 
@@ -937,11 +944,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: $!";