Author: tim.bunce
Date: Fri Dec 19 02:14:34 2008
New Revision: 653
Modified:
trunk/lib/Devel/NYTProf/Data.pm
trunk/lib/Devel/NYTProf/FileInfo.pm
trunk/t/test14.rdt
Log:
FileInfo dump() now takes option to not dump internal details.
Data dump callback uses that to not dump internal details of std lib
modules.
Modified: trunk/lib/Devel/NYTProf/Data.pm
==============================================================================
--- trunk/lib/Devel/NYTProf/Data.pm (original)
+++ trunk/lib/Devel/NYTProf/Data.pm Fri Dec 19 02:14:34 2008
@@ -316,20 +316,26 @@
if ($args->{skip_stdlib}) {
+ # for fid_fileinfo don't dump internal details of lib modules
+ if ($path->[0] eq 'fid_fileinfo' && @$path==2) {
+ my $is_lib = ($value->filename =~ $is_lib_regex) ? 1 : 0;
+ return { skip_internal_details => $is_lib };
+ }
+
# skip sub_subinfo data for 'library modules'
if ($path->[0] eq 'sub_subinfo' && @$path==2 && $value->[0]) {
my $fi = $self->fileinfo_of($value->[0]);
- return 0 if $fi->filename =~ $is_lib_regex;
+ return undef if $fi->filename =~ $is_lib_regex;
}
# skip fid_*_time data for 'library modules'
if ($path->[0] =~ /^fid_\w+_time$/ && @$path==2) {
my $fi = $self->fileinfo_of($path->[1]);
- return 0 if $fi->filename =~ $is_lib_regex
+ return undef if $fi->filename =~ $is_lib_regex
or $fi->filename =~ m!^/\.\.\./!;
}
}
- return 1;
+ return {};
};
_dump_elements($startnode, $separator, $filehandle, [], $callback);
@@ -360,23 +366,25 @@
my $key1 = $path->[0] || $keys->[0];
for my $key (@$keys) {
+ next if $key eq 'fid_srclines';
+
my $value = ($is_hash) ? $r->{$key} : $r->[$key];
# skip undef elements in array
next if !defined($value) && !$is_hash;
- next if $callback and not $callback->([ @$path, $key ], $value);
-
- next if $key eq 'fid_srclines';
+ my $dump_opts = {};
+ if ($callback) {
+ $dump_opts = $callback->([ @$path, $key ], $value);
+ next if not $dump_opts;
+ }
my $prefix = "$padN$key$colon";
if (UNIVERSAL::can($value,'dump')) {
- $value->dump($separator, $fh, [ @$path, $key ], $prefix);
+ $value->dump($separator, $fh, [ @$path, $key ], $prefix,
$dump_opts);
}
else {
- $value = $value->_values_for_dump
- if blessed $value && $value->can('_values_for_dump');
# special case some common cases to be more compact:
# fid_*_time [fid][line] = [N,N]
Modified: trunk/lib/Devel/NYTProf/FileInfo.pm
==============================================================================
--- trunk/lib/Devel/NYTProf/FileInfo.pm (original)
+++ trunk/lib/Devel/NYTProf/FileInfo.pm Fri Dec 19 02:14:34 2008
@@ -170,7 +170,8 @@
sub dump {
- my ($self, $separator, $fh, $path, $prefix) = @_;
+ my ($self, $separator, $fh, $path, $prefix, $opts) = @_;
+
my @values = @{$self}[
NYTP_FIDi_FILENAME, NYTP_FIDi_EVAL_FID, NYTP_FIDi_EVAL_LINE,
NYTP_FIDi_FID,
NYTP_FIDi_FLAGS, NYTP_FIDi_FILESIZE, NYTP_FIDi_FILEMTIME
@@ -179,32 +180,34 @@
# include count of number of string eval fids
my $evals = $self->has_evals(0) || [];
- push @values, scalar @$evals;
+ push @values, scalar @$evals; # XXX
printf $fh "%s[ %s ]\n", $prefix, join(" ", map { defined($_) ?
$_ : 'undef' } @values);
- my $subs = $self->subs;
- for my $subname (sort keys %$subs) {
- my $si = $subs->{$subname};
-
- printf $fh "%s%s%s%s%s%s-%s\n",
- $prefix, 'sub', $separator,
- $si->subname(' and '), $separator,
- $si->first_line, $si->last_line;
- }
-
- # return a ref to a hash of { line => { subname => [...] }, ... }
- my $sub_call_lines = $self->sub_call_lines;
- for my $line (sort { $a <=> $b } keys %$sub_call_lines) {
- my $subs_called = $sub_call_lines->{$line};
-
- for my $subname (sort keys %$subs_called) {
- my $sc = $subs_called->{$subname};
-
- printf $fh "%s%s%s%s%s%s%s[ %s ]\n",
- $prefix, 'call', $separator,
- $line, $separator, $subname, $separator,
- join(" ", map { defined($_) ? $_ : 'undef' } @$sc)
+ if (not $opts->{skip_internal_details}) {
+ my $subs = $self->subs;
+ for my $subname (sort keys %$subs) {
+ my $si = $subs->{$subname};
+
+ printf $fh "%s%s%s%s%s%s-%s\n",
+ $prefix, 'sub', $separator,
+ $si->subname(' and '), $separator,
+ $si->first_line, $si->last_line;
+ }
+
+ # { line => { subname => [...] }, ... }
+ my $sub_call_lines = $self->sub_call_lines;
+ for my $line (sort { $a <=> $b } keys %$sub_call_lines) {
+ my $subs_called = $sub_call_lines->{$line};
+
+ for my $subname (sort keys %$subs_called) {
+ my $sc = $subs_called->{$subname};
+
+ printf $fh "%s%s%s%s%s%s%s[ %s ]\n",
+ $prefix, 'call', $separator,
+ $line, $separator, $subname, $separator,
+ join(" ", map { defined($_) ? $_ : 'undef' } @$sc)
+ }
}
}
Modified: trunk/t/test14.rdt
==============================================================================
--- trunk/t/test14.rdt (original)
+++ trunk/t/test14.rdt Fri Dec 19 02:14:34 2008
@@ -10,7 +10,7 @@
attribute total_stmts_discounted 0
attribute total_stmts_duration 0
attribute total_stmts_measured 0
-attribute total_sub_calls 4
+attribute total_sub_calls 2
attribute xs_version 0
fid_block_time 1 17 [ 0 1 ]
fid_block_time 1 18 [ 0 1 ]
@@ -24,13 +24,6 @@
fid_fileinfo 1 call 17 AutoLoader::AUTOLOAD [ 1 0 0 0 0 0 0
]
fid_fileinfo 1 call 18 AutoLoader::AUTOLOAD [ 1 0 0 0 0 0 0
]
fid_fileinfo 2 [ AutoLoader.pm 2 2 0 0 0 ]
-fid_fileinfo 2 sub AutoLoader::AUTOLOAD 21-52
-fid_fileinfo 2 sub AutoLoader::BEGIN 186-186
-fid_fileinfo 2 sub
AutoLoader::__ANON__[/usr/local/perl589/lib/5.8.9/AutoLoader.pm:31] 31-31
-fid_fileinfo 2 sub AutoLoader::find_filename 54-126
-fid_fileinfo 2 sub AutoLoader::import 128-181
-fid_fileinfo 2 sub AutoLoader::unimport 183-193
-fid_fileinfo 2 call 23 AutoLoader::find_filename [ 2 0 0
0 0 0 0 ]
fid_fileinfo 3 [ test14.pm 3 2 0 0 1 ]
fid_fileinfo 3 sub test14::BEGIN 2-2
fid_fileinfo 3 sub test14::bar 10-12
--~--~---------~--~----~------------~-------~--~----~
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]
-~----------~----~----~----~------~----~------~--~---
