Author: tim.bunce
Date: Thu Nov 6 14:59:07 2008
New Revision: 589
Added:
trunk/perftest.pl
Modified:
trunk/MANIFEST
trunk/bin/nytprofhtml
trunk/lib/Devel/NYTProf/Data.pm
trunk/lib/Devel/NYTProf/Test.pm
Log:
Add perftest.pl script for profiling NYTProf::Data and nytprofhtml
Assorted optimizations in NYTProf::Data, mainly caching.
Modified: trunk/MANIFEST
==============================================================================
--- trunk/MANIFEST (original)
+++ trunk/MANIFEST Thu Nov 6 14:59:07 2008
@@ -24,6 +24,7 @@
lib/Devel/NYTProf/Util.pm
lib/Devel/NYTProf/js/jquery.min.js
lib/Devel/NYTProf/js/jquery.tablesorter.min.js
+perftest.pl
ppport.h
t/00.load.t
t/20.runtests.t
Modified: trunk/bin/nytprofhtml
==============================================================================
--- trunk/bin/nytprofhtml (original)
+++ trunk/bin/nytprofhtml Thu Nov 6 14:59:07 2008
@@ -149,7 +149,9 @@
my ($profile, $filestr, $max_subs, $sortby) = @_;
$sortby ||= 'excl_time';
- my $subs_in_file = $profile->subs_defined_in_file($filestr, 0);
+ my $subs_in_file = ($filestr)
+ ? $profile->subs_defined_in_file($filestr, 0)
+ : $profile->subname_subinfo_map;
return "" unless $subs_in_file && %$subs_in_file;
my $inc_path_regex = get_abs_paths_alternation_regex([$profile->inc],
qr/^|\[/);
Modified: trunk/lib/Devel/NYTProf/Data.pm
==============================================================================
--- trunk/lib/Devel/NYTProf/Data.pm (original)
+++ trunk/lib/Devel/NYTProf/Data.pm Thu Nov 6 14:59:07 2008
@@ -165,9 +165,8 @@
sub _caches { return shift->{caches} ||= {} }
sub _clear_caches { return delete shift->{caches} }
-sub all_subinfos {
- my @all = values %{ shift->{sub_subinfo} };
- return @all;
+sub subname_subinfo_map {
+ return { %{ shift->{sub_subinfo} } }; # shallow copy
}
sub all_fileinfos {
@@ -176,6 +175,22 @@
return @all;
}
+sub fid_subs_map {
+ # return { fid => { subname => subinfo, ... }, fid => ... }
+ my $self = shift;
+
+ my $caches = $self->_caches;
+ return $caches->{fid_subs_map} if $caches->{fid_subs_map};
+
+ my $subname_subinfo_map = $self->subname_subinfo_map;
+ my %fid_subs_map;
+ while ( my ($subname, $subinfo) = each %$subname_subinfo_map ) {
+ $fid_subs_map{ $subinfo->fid || 0 }{ $subname } = $subinfo;
+ }
+
+ return $caches->{fid_subs_map} = \%fid_subs_map;
+}
+
sub fileinfo_of {
my $self = shift;
my $arg = shift;
@@ -200,6 +215,11 @@
# map of { eval_fid => base_fid, ... }
sub eval_fid_2_base_fid_map {
my ($self, $flatten_evals) = @_;
+ $flatten_evals ||= 0;
+
+ my $caches = $self->_caches;
+ my $cache_key = "eval_fid_2_base_fid_map:$flatten_evals";
+ return $caches->{$cache_key} if $caches->{$cache_key};
my $fid_fileinfo = $self->{fid_fileinfo} || [];
my $eval_fid_map = {};
@@ -213,6 +233,8 @@
}
$eval_fid_map->{ $fi->fid } = $base_fi->fid;
}
+
+ $caches->{$cache_key} = $eval_fid_map;
return $eval_fid_map;
}
@@ -664,7 +686,7 @@
Returns a reference to a hash containing information about subroutines
defined
in a source file. The $file argument can be an integer file id (fid) or a
file
-path. If $file is 0 then details for all known subroutines are returned.
+path.
Returns undef if the profile contains no C<sub_subinfo> data for the $file.
@@ -686,18 +708,12 @@
$incl_lines = 0 if $fid == 0;
my $caches = $self->_caches;
- my $cache_key = "_cache:subs_defined_in_file:$fid:$incl_lines";
+ my $cache_key = "subs_defined_in_file:$fid:$incl_lines";
return $caches->{$cache_key} if $caches->{$cache_key};
- my $sub_subinfo = $self->{sub_subinfo}
+ my $fi = $self->fileinfo_of($fid)
or return;
-
- my %subs;
- while (my ($sub, $subinfo) = each %$sub_subinfo) {
-
- next if $fid && ($subinfo->fid||0) != $fid;
- $subs{$sub} = $subinfo;
- }
+ my %subs = %{ $fi->subs || {} }; # shallow copy
if ($incl_lines) { # add in the first-line-number keys
croak "Can't include line numbers without a fid" unless $fid;
@@ -963,13 +979,17 @@
sub filename { shift->[0] }
sub eval_fid { shift->[1] }
- sub eval_fi { return $_[0]->profile->fileinfo_of($_[0]->eval_fid ||
return) }
sub eval_line { shift->[2] }
sub fid { shift->[3] }
sub flags { shift->[4] }
sub size { shift->[5] }
sub mtime { shift->[6] }
sub profile { shift->[7] }
+
+ # if fid is an eval then return fileinfo obj for the fid that executed
the eval
+ sub eval_fi { $_[0]->[8] ||=
$_[0]->profile->fileinfo_of($_[0]->eval_fid || return) }
+ # return a ref to a hash of { subname => subinfo, ... }
+ sub subs { $_[0]->[9] ||= $_[0]->profile->fid_subs_map->{
$_[0]->fid } }
sub line_time_data {
my ($self, $levels) = @_;
Modified: trunk/lib/Devel/NYTProf/Test.pm
==============================================================================
--- trunk/lib/Devel/NYTProf/Test.pm (original)
+++ trunk/lib/Devel/NYTProf/Test.pm Thu Nov 6 14:59:07 2008
@@ -1,6 +1,9 @@
package # hide from pause package indexer
Devel::NYTProf::Test;
+use strict;
+use warnings;
+
# this module is just to test the test suite
# see t/test60-subname.p for example
Added: trunk/perftest.pl
==============================================================================
--- (empty file)
+++ trunk/perftest.pl Thu Nov 6 14:59:07 2008
@@ -0,0 +1,20 @@
+#!perl -w
+
+# profile NYTProf & nytprofhtml
+
+print "generating an nytprof.out file\n";
+# some random code to generate a reasonably interesting profile
+# with a reasonable number of source files and source lines
+system(q{perl -d:NYTProf -S perlcritic . || true}) == 0 or exit 1;
+
+my $tmp = "nytprof.out.tmp";
+rename "nytprof.out", $tmp or die "Can't rename nytprof.out: $!\n";
+
+print "profiling nytprofhtml processing that nytprof.out file\n";
+system(qq{time perl -d:NYTProf -S nytprofhtml --file=$tmp}) == 0
+ or exit 1;
+unlink $tmp;
+
+print "run nytprofhtml on the nytprofhtml profile\n";
+system(qq{nytprofhtml --open}) == 0
+ or exit 1;
--~--~---------~--~----~------------~-------~--~----~
You've received this message because you are subscribed to
the Devel::NYTProf Development User group.
Group hosted at: http://groups.google.com/group/develnytprof-dev
Project hosted at: http://perl-devel-nytprof.googlecode.com
CPAN distribution: http://search.cpan.org/dist/Devel-NYTProf
To post, email: [email protected]
To unsubscribe, email: [EMAIL PROTECTED]
-~----------~----~----~----~------~----~------~--~---
