r59549 - in /trunk/libdevel-nytprof-perl: ./ bin/ debian/ lib/Devel/ lib/Devel/NYTProf/ t/

gregoa at users.alioth.debian.org gregoa at users.alioth.debian.org
Fri Jun 18 23:36:14 UTC 2010


Author: gregoa
Date: Fri Jun 18 23:36:08 2010
New Revision: 59549

URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=59549
Log:
New upstream release.

Removed:
    trunk/libdevel-nytprof-perl/perftest.pl
Modified:
    trunk/libdevel-nytprof-perl/Changes
    trunk/libdevel-nytprof-perl/MANIFEST
    trunk/libdevel-nytprof-perl/META.yml
    trunk/libdevel-nytprof-perl/bin/nytprofcsv
    trunk/libdevel-nytprof-perl/bin/nytprofhtml
    trunk/libdevel-nytprof-perl/bin/nytprofmerge
    trunk/libdevel-nytprof-perl/debian/changelog
    trunk/libdevel-nytprof-perl/lib/Devel/NYTProf.pm
    trunk/libdevel-nytprof-perl/lib/Devel/NYTProf/Core.pm
    trunk/libdevel-nytprof-perl/lib/Devel/NYTProf/Data.pm
    trunk/libdevel-nytprof-perl/lib/Devel/NYTProf/FileInfo.pm
    trunk/libdevel-nytprof-perl/lib/Devel/NYTProf/ReadStream.pm
    trunk/libdevel-nytprof-perl/lib/Devel/NYTProf/Reader.pm
    trunk/libdevel-nytprof-perl/lib/Devel/NYTProf/SubInfo.pm
    trunk/libdevel-nytprof-perl/lib/Devel/NYTProf/Util.pm
    trunk/libdevel-nytprof-perl/t/80-version.t

Modified: trunk/libdevel-nytprof-perl/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libdevel-nytprof-perl/Changes?rev=59549&op=diff
==============================================================================
--- trunk/libdevel-nytprof-perl/Changes (original)
+++ trunk/libdevel-nytprof-perl/Changes Fri Jun 18 23:36:08 2010
@@ -2,7 +2,7 @@
 
 Changes - List of significant changes to Devel::NYTProf
 
-(As of $Date: 2010-06-09 00:29:49 +0100 (Wed, 09 Jun 2010) $ $Revision: 1291 $)
+(As of $Date: 2010-06-17 15:51:01 +0100 (Thu, 17 Jun 2010) $ $Revision: 1310 $)
 
 =cut
 
@@ -11,6 +11,23 @@
 subroutine profiler docs need update
 add u key to treemap to trigger moving 'up' a level
 add "calls N subs" to treemap mouseover box
+
+=head2 Changes in Devel::NYTProf 4.02 (svn 1309) 17th June 2010
+
+  Fixed nytprofhtml performance problem for profiles with
+    many files/evals.
+
+  Added progress reporting to nytprofhtml.
+
+=head2 Changes in Devel::NYTProf 4.01 (svn 1296) 10th June 2010
+
+  Fixed links from block/sub level report pages to string eval report
+    pages.  RT#58284
+
+  Restored ordering of line - block - sub links on index page.
+
+  Clarified that saving the source code of string evals requires perl
+    version 5.8.9+, 5.10.1+, 5.12 or later. RT#58283
 
 =head2 Changes in Devel::NYTProf 4.00 (svn 1291) 8th June 2010
 

Modified: trunk/libdevel-nytprof-perl/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libdevel-nytprof-perl/MANIFEST?rev=59549&op=diff
==============================================================================
--- trunk/libdevel-nytprof-perl/MANIFEST (original)
+++ trunk/libdevel-nytprof-perl/MANIFEST Fri Jun 18 23:36:08 2010
@@ -48,7 +48,6 @@
 lib/Devel/NYTProf/js/jquery-min.js
 lib/Devel/NYTProf/js/jquery-tablesorter-min.js
 lib/Devel/NYTProf/js/style-tablesorter.css
-perftest.pl
 ppport.h
 slowops.h
 t/00-load.t

Modified: trunk/libdevel-nytprof-perl/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libdevel-nytprof-perl/META.yml?rev=59549&op=diff
==============================================================================
--- trunk/libdevel-nytprof-perl/META.yml (original)
+++ trunk/libdevel-nytprof-perl/META.yml Fri Jun 18 23:36:08 2010
@@ -1,6 +1,6 @@
 --- #YAML:1.0
 name:               Devel-NYTProf
-version:            4.00
+version:            4.02
 abstract:           Powerful fast feature-rich perl source code profiler
 author:
     - Adam Kaplan <akaplan at cpan.org>, Tim Bunce <timb at cpan.org>

Modified: trunk/libdevel-nytprof-perl/bin/nytprofcsv
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libdevel-nytprof-perl/bin/nytprofcsv?rev=59549&op=diff
==============================================================================
--- trunk/libdevel-nytprof-perl/bin/nytprofcsv (original)
+++ trunk/libdevel-nytprof-perl/bin/nytprofcsv Fri Jun 18 23:36:08 2010
@@ -7,7 +7,7 @@
 # http://search.cpan.org/dist/Devel-NYTProf/
 #
 ##########################################################
-# $Id: nytprofcsv 1253 2010-05-30 08:30:17Z tim.bunce at gmail.com $
+# $Id: nytprofcsv 1310 2010-06-17 14:51:01Z tim.bunce at gmail.com $
 ##########################################################
 
 use warnings;
@@ -18,7 +18,7 @@
 
 use Devel::NYTProf::Reader;
 
-our $VERSION = '4.00';
+our $VERSION = '4.02';
 
 use constant NUMERIC_PRECISION => 5;
 
@@ -195,7 +195,7 @@
  0,0,0,#--------------------------------------------------------------------
  0,0,0,# My New Source File!
  0,0,0,#--------------------------------------------------------------------
- 0,0,0,# $Id: nytprofcsv 1253 2010-05-30 08:30:17Z tim.bunce at gmail.com $
+ 0,0,0,# $Id: nytprofcsv 1310 2010-06-17 14:51:01Z tim.bunce at gmail.com $
  0,0,0,#--------------------------------------------------------------------
  0,0,0,
  0,0,0,package NYT::Feeds::Util;

Modified: trunk/libdevel-nytprof-perl/bin/nytprofhtml
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libdevel-nytprof-perl/bin/nytprofhtml?rev=59549&op=diff
==============================================================================
--- trunk/libdevel-nytprof-perl/bin/nytprofhtml (original)
+++ trunk/libdevel-nytprof-perl/bin/nytprofhtml Fri Jun 18 23:36:08 2010
@@ -7,7 +7,7 @@
 ## http://search.cpan.org/~akaplan/Devel-NYTProf
 ##
 ##########################################################
-# $Id: nytprofhtml 1288 2010-06-08 10:10:39Z tim.bunce at gmail.com $
+# $Id: nytprofhtml 1310 2010-06-17 14:51:01Z tim.bunce at gmail.com $
 ###########################################################
 use warnings;
 use strict;
@@ -17,6 +17,18 @@
 use List::Util qw(sum max);
 use File::Copy;
 use File::Path qw(rmtree);
+
+# Handle --profself before loading Devel::NYTProf::Core
+# (because it parses NYTPROF for options)
+BEGIN {
+    if (grep { $_ eq '--profself' } @ARGV) {
+        # profile nytprofhtml itself
+        our $profself = "nytprof-nytprofhtml.out";
+        $ENV{NYTPROF} .= ":file=$profself:trace=1";
+        require Devel::NYTProf;
+        END { warn "Profile of $0 written to $profself\n" if our $profself; } 
+    }
+}
 
 use Devel::NYTProf::Reader;
 use Devel::NYTProf::Core;
@@ -31,7 +43,7 @@
 my $json_any = eval { require JSON::Any; JSON::Any->import; JSON::Any->new }
     or warn "Can't load JSON::Any module - HTML visualizations skipped.\n";
 
-our $VERSION = '4.00';
+our $VERSION = '4.02';
 
 if ($VERSION != $Devel::NYTProf::Core::VERSION) {
     die "$0 version '$VERSION' doesn't match version '$Devel::NYTProf::Core::VERSION' of $INC{'Devel/NYTProf/Core.pm'}\n";
@@ -57,13 +69,7 @@
     'open!'     => \my $opt_open,
     'help|h'    => sub { exit usage() },
     'minimal|m!'=> \my $opt_minimal,
-    'profself!'     => sub {
-        # profile nytprofhtml itself
-        our $profself = "nytprof-nytprofhtml.out";
-        $ENV{NYTPROF} .= ":file=$profself";
-        require Devel::NYTProf;
-        END { warn "Profile of $0 written to $profself\n" if our $profself; } 
-    },
+    'profself!'     => sub { }, # handled in BEGIN above
 ) or do { exit usage(); };
 
 
@@ -1302,9 +1308,11 @@
         );
         push @t_stmt_time, $time;
 
+
+        my %levels = reverse %{$profile->get_profile_levels};
         my $rep_links = join '&nbsp;&bull;&nbsp;', map {
             sprintf(qq{<a %s>%s</a>}, $reporter->href_for_file($fi, undef, $_), $_)
-        } values %{$profile->get_profile_levels};
+        } grep { $levels{$_} } qw(line block sub);
         print $fh "<td>$rep_links</td>";
 
         print $fh sprintf q{<td><a name="f%s" title="%s">%s</a> %s</td>},

Modified: trunk/libdevel-nytprof-perl/bin/nytprofmerge
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libdevel-nytprof-perl/bin/nytprofmerge?rev=59549&op=diff
==============================================================================
--- trunk/libdevel-nytprof-perl/bin/nytprofmerge (original)
+++ trunk/libdevel-nytprof-perl/bin/nytprofmerge Fri Jun 18 23:36:08 2010
@@ -18,7 +18,7 @@
 require Devel::NYTProf::Data;
 use List::Util qw(min);
 
-our $VERSION = '4.00';
+our $VERSION = '4.02';
     
 if ($VERSION != $Devel::NYTProf::Core::VERSION) {
     die "$0 version '$VERSION' doesn't match version '$Devel::NYTProf::Core::VERSION' of $INC{'Devel/NYTProf/Core.pm'}\n";

Modified: trunk/libdevel-nytprof-perl/debian/changelog
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libdevel-nytprof-perl/debian/changelog?rev=59549&op=diff
==============================================================================
--- trunk/libdevel-nytprof-perl/debian/changelog (original)
+++ trunk/libdevel-nytprof-perl/debian/changelog Fri Jun 18 23:36:08 2010
@@ -1,3 +1,9 @@
+libdevel-nytprof-perl (4.02-1) UNRELEASED; urgency=low
+
+  * New upstream release.
+
+ -- gregor herrmann <gregoa at debian.org>  Sat, 19 Jun 2010 01:34:55 +0200
+
 libdevel-nytprof-perl (4.00-1) unstable; urgency=low
 
   * New upstream release.

Modified: trunk/libdevel-nytprof-perl/lib/Devel/NYTProf.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libdevel-nytprof-perl/lib/Devel/NYTProf.pm?rev=59549&op=diff
==============================================================================
--- trunk/libdevel-nytprof-perl/lib/Devel/NYTProf.pm (original)
+++ trunk/libdevel-nytprof-perl/lib/Devel/NYTProf.pm Fri Jun 18 23:36:08 2010
@@ -7,11 +7,11 @@
 ## http://search.cpan.org/dist/Devel-NYTProf/
 ##
 ###########################################################
-## $Id: NYTProf.pm 1286 2010-06-07 22:14:07Z tim.bunce at gmail.com $
+## $Id: NYTProf.pm 1310 2010-06-17 14:51:01Z tim.bunce at gmail.com $
 ###########################################################
 package Devel::NYTProf;
 
-our $VERSION = '4.00';
+our $VERSION = '4.02';
 
 package    # hide the package from the PAUSE indexer
     DB;
@@ -38,7 +38,7 @@
 # DB::sub shouldn't be called, but needs to exist for perl <5.8.7 (<perl at 24265)
 # Could be called in obscure cases, e.g. if "perl -d" (not -d:NYTProf)
 # was used with Devel::NYTProf loaded some other way
-sub sub { die "DB::sub called unexpectly" }
+sub sub { die "DB::sub called unexpectedly" }
 
 sub CLONE { DB::disable_profiler }
 
@@ -393,21 +393,27 @@
 compiled before NYTProf was loaded. So using use_db_sub=1 can be useful in
 cases where you can't load the profiler early in the life of the application.
 
+Another side effect of C<use_db_sub=1> is that it enables recording of the
+source code of the C<< perl -e '...' >> and C<< perl - >> input for old
+versions of perl. See also L</savesrc=0>.
+
 =head2 savesrc=0
 
 Disable the saving of source code.
 
-By default NYTProf saves a copy of all source code, including string evals,
-into the profile data file.  This makes the file self-contained, so the
-reporting tools no longer depend on having the unmodified source code files
-available.
-(If you're using perl 5.10.0 or 5.8.8 (or earlier) then you need to also enable
-the L</use_db_sub=1> option otherwise perl doesn't make the source code
-available to NYTProf. Perl 5.8.9 and 5.10.1+ don't require that.)
+By default NYTProf saves a copy of all source code into the profile data file.
+This makes the file self-contained, so the reporting tools no longer depend on
+having the unmodified source code files available.
 
 With C<savesrc=0> some source code is still saved: the arguments to the
 C<perl -e> option, the script fed to perl via STDIN when using C<perl ->,
 and the source code of string evals.
+
+Saving the source code of string evals requires perl version 5.8.9+, 5.10.1+,
+or 5.12 or later.
+
+Saving the source code of the C<< perl -e '...' >> or C<< perl - >> input
+requires either a recent perl version, as above, or setting the L</use_db_sub=1> option.
 
 =head2 slowops=N
 
@@ -702,7 +708,7 @@
 is reduced detail and/or accuracy in reports.
 
 If you don't need statement-level profiling then you can disable it via L</stmts=0>.
-If you do need it but don't mind loosing block-level timings then set L</blocks=0>.
+If you do want it but don't mind loosing block-level timings then set L</blocks=0>.
 If you want need still more speed then set L</leave=0> to disable the
 adjustments made for statements that 'leave' the current control flow (doing
 this I<will> make timings for some kinds of statements less accurate).
@@ -710,8 +716,13 @@
 If you don't need subroutine profiling then you can disable it via L</subs=0>.
 If you do need it but don't need timings for perl opcodes then set L</slowops=0>.
 
+Generally speaking, setting blocks=0 and slowops=0 will give you a useful boost
+with the least loss of detail.
+
 Another approach is to only enable NYTProf in the sections of code that
 interest you. See L</RUN-TIME CONTROL OF PROFILING> for more details.
+
+To speed up L<nytprofhtml> try using the --minimal (-m) option.
 
 =head1 REPORTS
 
@@ -725,6 +736,12 @@
 Included in the bin directory of this distribution are some scripts which
 turn the raw profile data into more useful formats:
 
+=head2 nytprofhtml
+
+Creates attractive, richly annotated, and fully cross-linked html
+reports (including statistics, source code and color highlighting).
+This is the main report generation tool for NYTProf.
+
 =head2 nytprofcsv
 
 Creates comma delimited profile reports. Old and limited.
@@ -733,11 +750,6 @@
 
 Translates a profile into a format that can be loaded into KCachegrind
 L<http://kcachegrind.sourceforge.net>
-
-=head2 nytprofhtml
-
-Creates attractive, richly annotated, and fully cross-linked html
-reports (including statistics, source code and color highlighting).
 
 =head2 nytprofmerge
 

Modified: trunk/libdevel-nytprof-perl/lib/Devel/NYTProf/Core.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libdevel-nytprof-perl/lib/Devel/NYTProf/Core.pm?rev=59549&op=diff
==============================================================================
--- trunk/libdevel-nytprof-perl/lib/Devel/NYTProf/Core.pm (original)
+++ trunk/libdevel-nytprof-perl/lib/Devel/NYTProf/Core.pm Fri Jun 18 23:36:08 2010
@@ -7,14 +7,14 @@
 # http://search.cpan.org/dist/Devel-NYTProf/
 #
 ###########################################################
-# $Id: Core.pm 1253 2010-05-30 08:30:17Z tim.bunce at gmail.com $
+# $Id: Core.pm 1310 2010-06-17 14:51:01Z tim.bunce at gmail.com $
 ###########################################################
 package Devel::NYTProf::Core;
 
 
 use XSLoader;
 
-our $VERSION = '4.00';    # increment with XS changes too
+our $VERSION = '4.02';    # increment with XS changes too
 
 XSLoader::load('Devel::NYTProf', $VERSION);
 

Modified: trunk/libdevel-nytprof-perl/lib/Devel/NYTProf/Data.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libdevel-nytprof-perl/lib/Devel/NYTProf/Data.pm?rev=59549&op=diff
==============================================================================
--- trunk/libdevel-nytprof-perl/lib/Devel/NYTProf/Data.pm (original)
+++ trunk/libdevel-nytprof-perl/lib/Devel/NYTProf/Data.pm Fri Jun 18 23:36:08 2010
@@ -7,7 +7,7 @@
 # http://search.cpan.org/dist/Devel-NYTProf/
 #
 ###########################################################
-# $Id: Data.pm 1278 2010-06-07 15:07:31Z tim.bunce at gmail.com $
+# $Id: Data.pm 1310 2010-06-17 14:51:01Z tim.bunce at gmail.com $
 ###########################################################
 package Devel::NYTProf::Data;
 
@@ -55,7 +55,7 @@
     trace_level
 );
 
-our $VERSION = '4.00';
+our $VERSION = '4.02';
 
 
 =head2 new
@@ -87,6 +87,8 @@
     );
 
     return undef if $args->{callback};
+
+    print "Processing $file data\n" unless $args->{quiet};
 
     bless $profile => $class;
 
@@ -157,7 +159,7 @@
             push @{$src_keyed{$key}}, $fi;
         }
 
-        if (trace_level() >= 1) {
+        if (trace_level() >= 2) {
             my @subs  = map { $_->subs_defined } @$siblings;
             my @evals = map { $_->has_evals(0) } @$siblings;
             warn sprintf "%d:%d: has %d sibling evals (subs %d, evals %d, keys %d) in %s; fids: %s\n",

Modified: trunk/libdevel-nytprof-perl/lib/Devel/NYTProf/FileInfo.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libdevel-nytprof-perl/lib/Devel/NYTProf/FileInfo.pm?rev=59549&op=diff
==============================================================================
--- trunk/libdevel-nytprof-perl/lib/Devel/NYTProf/FileInfo.pm (original)
+++ trunk/libdevel-nytprof-perl/lib/Devel/NYTProf/FileInfo.pm Fri Jun 18 23:36:08 2010
@@ -175,9 +175,7 @@
     # { line => { fid_of_eval_at_line => $fi, ... } }
 
     my %evals_by_line;
-    my $fid = $self->fid;
-    for my $fi ($self->profile->all_fileinfos) {
-        next unless (($fi->eval_fid || 0) == $fid);
+    for my $fi ($self->has_evals) {
         $evals_by_line{ $fi->eval_line }->{ $fi->fid } = $fi;
     }
 
@@ -283,7 +281,7 @@
 
         warn sprintf "collapse_sibling_evals: processing donor fid %d: %s\n",
                 $donor_fi->fid, $donor_fi->filename
-            if trace_level();
+            if trace_level() >= 3;
 
         # XXX nested evals not handled yet
         warn sprintf "collapse_sibling_evals: nested evals in %s not handled",
@@ -297,10 +295,10 @@
             for my $si (@subs_defined) {
                 warn sprintf " - moving from fid %d: sub %s\n",
                         $donor_fi->fid, $si->subname
-                    if trace_level();
+                    if trace_level() >= 4;
                 $si->_alter_fileinfo($donor_fi, $survivor_fi);
                 warn sprintf " - moving done\n"
-                    if trace_level();
+                    if trace_level() >= 4;
             }
         }
 
@@ -378,7 +376,7 @@
             warn sprintf "collapse_sibling_evals: merging %d subs into %s: %s\n",
                     scalar @$to_merge, $survivor_subname,
                     join ", ", map { $_->subname } @$to_merge
-                if trace_level();
+                if trace_level() >= 3;
 
             for my $delete_si (@$to_merge) {
                 my $delete_subname = $delete_si->subname;
@@ -405,8 +403,8 @@
         }
     }
 
-    warn sprintf "collapse_sibling_evals done\n"
-        if trace_level();
+    warn sprintf "collapse_sibling_evals done for ".$survivor_fi->filename."\n"
+        if trace_level() >= 2;
 
     return $survivor_fi;
 }

Modified: trunk/libdevel-nytprof-perl/lib/Devel/NYTProf/ReadStream.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libdevel-nytprof-perl/lib/Devel/NYTProf/ReadStream.pm?rev=59549&op=diff
==============================================================================
--- trunk/libdevel-nytprof-perl/lib/Devel/NYTProf/ReadStream.pm (original)
+++ trunk/libdevel-nytprof-perl/lib/Devel/NYTProf/ReadStream.pm Fri Jun 18 23:36:08 2010
@@ -188,9 +188,10 @@
 
 =item SRC_LINE => $fid, $line, $text
 
-Used to capture the source code of the program and modules profiled.
-Currently only used for C<< perl -e '...' >> and C<< perl - >> runs
-and requires use of the C<use_db_sub=1> option.
+Used to reproduce the source code of the files and evals profiled.
+Requires perl 5.8.9+ or 5.10.1+ or 5.12 or later. For earlier versions of perl
+the source code of C<< perl -e '...' >> and C<< perl - >> 'files' is available
+if the C<use_db_sub=1> option was used when profiling.
 
 =item PID_END => $pid, $end_time
 

Modified: trunk/libdevel-nytprof-perl/lib/Devel/NYTProf/Reader.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libdevel-nytprof-perl/lib/Devel/NYTProf/Reader.pm?rev=59549&op=diff
==============================================================================
--- trunk/libdevel-nytprof-perl/lib/Devel/NYTProf/Reader.pm (original)
+++ trunk/libdevel-nytprof-perl/lib/Devel/NYTProf/Reader.pm Fri Jun 18 23:36:08 2010
@@ -7,11 +7,11 @@
 ## http://search.cpan.org/dist/Devel-NYTProf/
 ##
 ###########################################################
-## $Id: Reader.pm 1290 2010-06-08 22:30:13Z tim.bunce at gmail.com $
+## $Id: Reader.pm 1309 2010-06-17 14:50:32Z tim.bunce at gmail.com $
 ###########################################################
 package Devel::NYTProf::Reader;
 
-our $VERSION = '4.00';
+our $VERSION = '4.01';
 
 use warnings;
 use strict;
@@ -142,14 +142,16 @@
     my $self = shift;
     my ($opts) = @_;
 
-    print "Writing report to $self->{output_dir} directory\n"
-        unless $opts->{quiet};
-
     my $level_additional_sub = $opts->{level_additional};
     my $profile              = $self->{profile};
     my $modes                = $profile->get_profile_levels;
-    for my $level (grep { {reverse %$modes}->{$_} } qw(sub block line)) {
-        $self->_generate_report($profile, $level);
+    my @levels = grep { {reverse %$modes}->{$_} } qw(sub block line);
+    for my $level (@levels) {
+        print "Writing $level reports to $self->{output_dir} directory\n"
+            unless $opts->{quiet};
+        $self->_generate_report($profile, $level,
+            show_progress => (not $opts->{quiet} and -t STDOUT)
+        );
         $level_additional_sub->($profile, $level)
             if $level_additional_sub;
     }
@@ -177,7 +179,7 @@
 ##
 sub _generate_report {
     my $self = shift;
-    my ($profile, $LEVEL) = @_;
+    my ($profile, $LEVEL, %opts) = @_;
 
     $self->current_level($LEVEL);
 
@@ -186,12 +188,22 @@
 
     #$profile->dump_profile_data({ filehandle => \*STDERR, separator=>"\t", });
 
-    foreach my $fi (@all_fileinfos) {
-
+    my @fis = @all_fileinfos;
+    if ($LEVEL ne 'line') {
         # we only generate line-level reports for evals
         # for efficiency and because some data model editing only
         # is only implemented for line-level data
-        next if $fi->is_eval and $LEVEL ne 'line';
+        @fis = grep { not $_->is_eval } @fis;
+    }
+
+    my $progress;
+    foreach my $fi (@fis) {
+
+        if ($opts{show_progress}) {
+            local $| = 1;
+            ++$progress;
+            printf "\r %d%% ... ", $progress/@fis*100;
+        }
 
         my $meta = $fi->meta;
         my $filestr = $fi->filename;
@@ -223,7 +235,7 @@
         warn sprintf "%s %s max lines: stmts %d, subcalls %d, subdefs %d, evals %d\n",
                 $filestr, $LEVEL, scalar @$lines_array,
                 $subcalls_max_line, $subdefs_max_line, $evals_max_line
-            if trace_level();
+            if trace_level() >= 4;
 
         my %stats_accum;           # holds all line times. used to find median
         my %stats_by_line;         # holds individual line stats
@@ -351,7 +363,7 @@
                 $msg = "No source code available for synthetic (fake) file $filestr.",
             }
             elsif ($fi->is_eval) {
-                $msg = "No source code available for string eval $filestr.\nSee savesrc option in documentation.",
+                $msg = "No source code available for string eval $filestr.\nYou probably need to use a more recent version of perl. See savesrc option in documentation.",
             }
             elsif ($filestr =~ m{^/loader/0x[0-9a-zA-Z]+/}) {
                 # a synthetic file name that perl assigns when reading
@@ -359,7 +371,7 @@
                 $msg = "No source code available for 'file' loaded via CODE reference in \@INC.\nSee savesrc option in documentation.",
             }
             elsif (not $fi->is_file) {
-                $msg = "No source code available for non-file '$filestr'.\nSee savesrc option in documentation.",
+                $msg = "No source code available for non-file '$filestr'.\nYou probably need to use a more recent version of perl. See savesrc option in documentation.",
             }
             else {
 
@@ -486,6 +498,7 @@
         print OUT $self->get_param('footer', [$profile, $filestr]);
         close OUT;
     }
+    print "\n" if $opts{show_progress};
 }
 
 
@@ -495,6 +508,7 @@
 
     my $fi = $self->{profile}->fileinfo_of($file);
     #return "" if $fi->is_fake;
+    $level = 'line' if $fi->is_eval;
 
     my $url = $self->fname_for_fileinfo($fi, $level);
     $url .= '.html';

Modified: trunk/libdevel-nytprof-perl/lib/Devel/NYTProf/SubInfo.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libdevel-nytprof-perl/lib/Devel/NYTProf/SubInfo.pm?rev=59549&op=diff
==============================================================================
--- trunk/libdevel-nytprof-perl/lib/Devel/NYTProf/SubInfo.pm (original)
+++ trunk/libdevel-nytprof-perl/lib/Devel/NYTProf/SubInfo.pm Fri Jun 18 23:36:08 2010
@@ -42,15 +42,7 @@
 
 sub excl_time  { shift->[NYTP_SIi_EXCL_RTIME] }
 
-sub subname    {
-    my $subname = shift->[NYTP_SIi_SUB_NAME];
-    return $subname if not ref $subname;
-    # the subname of a merged sub is a ref to an array of the merged subnames
-    # XXX could be ref to an array of the merged subinfos
-    # XXX or better to add a separate accessor instead of abusing subname like this
-    return $subname if not defined(my $join = shift);
-    return join $join, @$subname;
-}
+sub subname    { shift->[NYTP_SIi_SUB_NAME] }
 
 sub subname_without_package {
     my $subname = shift->[NYTP_SIi_SUB_NAME];
@@ -187,7 +179,7 @@
 
             warn sprintf "_alter_called_by_fileinfo: %s from fid %d to fid %d\n",
                     $self->subname, $remove_fid, $new_fid
-                if trace_level();
+                if trace_level() >= 4;
 
             # merge $cb into $new_cb
             while ( my ($line, $cb_li) = each %$cb ) {
@@ -216,7 +208,7 @@
 
     warn sprintf "Merging sub %s into %s (%s)\n",
             $donor_subname, $self_subname, join(" ", %opts)
-        if trace_level();
+        if trace_level() >= 4;
 
     # see also "case NYTP_TAG_SUB_CALLERS:" in load_profile_data_from_stream()
     push @{ $self->meta->{merged_sub_names} }, $donor->subname;
@@ -264,7 +256,7 @@
         return;
     }
 
-    if (trace_level()) {
+    if (trace_level() >= 5) {
         carp sprintf "_merge_in_caller_info%s merging from $src_line_info -> $dst_line_info:", $tag;
         warn sprintf " . %s\n", fmt_sc($src_line_info);
         warn sprintf " + %s\n", fmt_sc($dst_line_info);
@@ -289,7 +281,7 @@
     $dst_cs->{$_} = $src_cs->{$_} for keys %$src_cs;
 
     warn sprintf " = %s\n", fmt_sc($dst_line_info)
-        if trace_level();
+        if trace_level() >= 5;
 
     return;
 }

Modified: trunk/libdevel-nytprof-perl/lib/Devel/NYTProf/Util.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libdevel-nytprof-perl/lib/Devel/NYTProf/Util.pm?rev=59549&op=diff
==============================================================================
--- trunk/libdevel-nytprof-perl/lib/Devel/NYTProf/Util.pm (original)
+++ trunk/libdevel-nytprof-perl/lib/Devel/NYTProf/Util.pm Fri Jun 18 23:36:08 2010
@@ -7,7 +7,7 @@
 # http://search.cpan.org/dist/Devel-NYTProf/
 #
 ###########################################################
-# $Id: Util.pm 1275 2010-06-07 14:10:32Z tim.bunce at gmail.com $
+# $Id: Util.pm 1306 2010-06-16 23:07:50Z tim.bunce at gmail.com $
 ###########################################################
 package Devel::NYTProf::Util;
 
@@ -96,12 +96,18 @@
     my @inc = @$inc_ref
         or return;
 
-    my $inc_regex = get_abs_paths_alternation_regex(\@inc);
-
-    # anchor at start, capture anchor
-    $inc_regex = qr{($anchor)$inc_regex};
-
-    return sub { $_[0] =~ s{$inc_regex}{$1$replacement} };
+    our %make_path_strip_editor_cache;
+    my $key = join "\t", $anchor, $replacement, @inc;
+
+    return $make_path_strip_editor_cache{$key} ||= do {
+
+        my $inc_regex = get_abs_paths_alternation_regex(\@inc);
+
+        # anchor at start, capture anchor
+        $inc_regex = qr{($anchor)$inc_regex};
+
+        sub { $_[0] =~ s{$inc_regex}{$1$replacement} };
+    };
 }
 
 

Modified: trunk/libdevel-nytprof-perl/t/80-version.t
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libdevel-nytprof-perl/t/80-version.t?rev=59549&op=diff
==============================================================================
--- trunk/libdevel-nytprof-perl/t/80-version.t (original)
+++ trunk/libdevel-nytprof-perl/t/80-version.t Fri Jun 18 23:36:08 2010
@@ -1,17 +1,8 @@
-use Test::More tests => 10;
+use Test::More tests => 4;
 
 use_ok('Devel::NYTProf::Core');
 my $version = $Devel::NYTProf::Core::VERSION;
 ok $version, 'lib/Devel/NYTProf/Core.pm $VERSION should be set';
-
-use_ok('Devel::NYTProf::Data');
-is $Devel::NYTProf::Data::VERSION, $version, 'lib/Devel/NYTProf/Data.pm $VERSION should match';
-
-use_ok('Devel::NYTProf::Util');
-is $Devel::NYTProf::Util::VERSION, $version, 'lib/Devel/NYTProf/Util.pm $VERSION should match';
-
-use_ok('Devel::NYTProf::Reader');
-is $Devel::NYTProf::Reader::VERSION, $version, 'lib/Devel/NYTProf/Reader.pm $VERSION should match';
 
 use_ok('Devel::NYTProf');
 is $Devel::NYTProf::VERSION, $version, 'lib/Devel/NYTProf.pm $VERSION should match';




More information about the Pkg-perl-cvs-commits mailing list