Author: tim.bunce
Date: Mon Oct 27 17:50:33 2008
New Revision: 560
Modified:
trunk/NYTProf.xs
trunk/bin/nytprofhtml
trunk/lib/Devel/NYTProf/Data.pm
trunk/lib/Devel/NYTProf/Reader.pm
Log:
Add ::Data method to read source, which gives preference to source embedded
in the data.
Rename fid_filecontents to fid_srclines.
If the file can't be read then report the reason on the report page
(a bit of a hack at the moment, but far better than the previous 'blank'
page.)
Silence an undef warning from xsub listing.
Modified: trunk/NYTProf.xs
==============================================================================
--- trunk/NYTProf.xs (original)
+++ trunk/NYTProf.xs Mon Oct 27 17:50:33 2008
@@ -1188,12 +1188,12 @@
if (src_av) {
I32 lines = av_len(src_av);
int line;
+ if (trace_level >= 4)
+ warn("fid %d has %d src lines", found->id, lines+1);
for (line = 1; line <= lines; ++line) { /* lines start at 1 */
SV **svp = av_fetch(src_av, line, 0);
STRLEN len = 0;
char *src = (svp) ? SvPV(*svp, len) : "";
- if (!*src) /* skip empty lines */
- continue;
/* outputting the tag and fid for each (non empty) line
* is a little inefficient, but not enough to worry about
*/
output_tag_int(NYTP_TAG_SRC_LINE, found->id);
@@ -2739,7 +2739,7 @@
HV *live_pids_hv = newHV();
HV *attr_hv = newHV();
AV* fid_fileinfo_av = newAV();
- AV* fid_filecontents_av = newAV();
+ AV* fid_srclines_av = newAV();
AV* fid_line_time_av = newAV();
AV* fid_block_time_av = NULL;
AV* fid_sub_time_av = NULL;
@@ -2753,7 +2753,7 @@
NV profiler_duration = 0.0;
av_extend(fid_fileinfo_av, 64); /* grow it up front. */
- av_extend(fid_filecontents_av, 64);
+ av_extend(fid_srclines_av, 64);
av_extend(fid_line_time_av, 64);
if (FILE_STATE(in) != NYTP_FILE_STDIO) {
@@ -2987,12 +2987,12 @@
}
/* first line in the file seen */
- if (!av_exists(fid_filecontents_av, file_num)) {
+ if (!av_exists(fid_srclines_av, file_num)) {
file_av = newAV();
- av_store(fid_filecontents_av, file_num,
newRV_noinc((SV*)file_av));
+ av_store(fid_srclines_av, file_num,
newRV_noinc((SV*)file_av));
}
else {
- file_av = (AV *)SvRV(*av_fetch(fid_filecontents_av,
file_num, 1));
+ file_av = (AV *)SvRV(*av_fetch(fid_srclines_av,
file_num, 1));
}
av_store(file_av, line_num, src);
@@ -3291,7 +3291,7 @@
SvREFCNT_dec(live_pids_hv);
SvREFCNT_dec(attr_hv);
SvREFCNT_dec(fid_fileinfo_av);
- SvREFCNT_dec(fid_filecontents_av);
+ SvREFCNT_dec(fid_srclines_av);
SvREFCNT_dec(fid_line_time_av);
SvREFCNT_dec(fid_block_time_av);
SvREFCNT_dec(fid_sub_time_av);
@@ -3334,7 +3334,7 @@
profile_hv = newHV();
(void)hv_stores(profile_hv, "attribute",
newRV_noinc((SV*)attr_hv));
(void)hv_stores(profile_hv, "fid_fileinfo",
newRV_noinc((SV*)fid_fileinfo_av));
- (void)hv_stores(profile_hv, "fid_filecontents",
newRV_noinc((SV*)fid_filecontents_av));
+ (void)hv_stores(profile_hv, "fid_srclines",
newRV_noinc((SV*)fid_srclines_av));
(void)hv_stores(profile_hv, "fid_line_time",
newRV_noinc((SV*)fid_line_time_av));
(void)hv_stores(profile_modes, "fid_line_time", newSVpvf("line"));
if (fid_block_time_av) {
Modified: trunk/bin/nytprofhtml
==============================================================================
--- trunk/bin/nytprofhtml (original)
+++ trunk/bin/nytprofhtml Mon Oct 27 17:50:33 2008
@@ -247,7 +247,7 @@
'linestart',
{ func => sub {
my ($value, $linenum, $linesrc) = @_;
- (my $anchor = $linenum || $value) =~ s/\W/_/g;
+ (my $anchor = defined($linenum) ? $linenum : $value) =~
s/\W/_/g;
sprintf qq{<tr><td class="h"><a name="%s"></a>%s</td>},
$anchor, $linenum;
},
}
Modified: trunk/lib/Devel/NYTProf/Data.pm
==============================================================================
--- trunk/lib/Devel/NYTProf/Data.pm (original)
+++ trunk/lib/Devel/NYTProf/Data.pm Mon Oct 27 17:50:33 2008
@@ -379,7 +379,7 @@
$value = $value->_values_for_dump
if blessed $value && $value->can('_values_for_dump');
- next if $key eq 'fid_filecontents';
+ next if $key eq 'fid_srclines';
# special case some common cases to be more compact:
# fid_*_time [fid][line] = [N,N]
@@ -1018,8 +1018,8 @@
}
-# should return the filename that the application used
-# when loading the file
+ # should return the filename that the application used
+ # when loading the file
sub filename_without_inc {
my $self = shift;
my $f = [$self->filename];
@@ -1044,6 +1044,23 @@
# remove sub_caller info for calls made *from within* this file
delete $_->{$fid} for values %$sub_caller;
return;
+ }
+
+ sub srclines_array {
+ my $self = shift;
+ my $profile = $self->profile;
+ #warn Dumper($profile->{fid_srclines});
+ if (my $srclines = $profile->{fid_srclines}[ $self->fid ]) {
+ return [ @$srclines ]; # shallow clone
+ }
+ # open file
+ my $filename = $self->filename;
+ # if it's a .pmc then assume that's the file we want to look at
+ # (because the main use for .pmc's are related to perl6)
+ $filename .= "c" if $self->is_pmc;
+ open my $fh, "<", $filename
+ or return undef;
+ return [ <$fh> ];
}
} # end of package
Modified: trunk/lib/Devel/NYTProf/Reader.pm
==============================================================================
--- trunk/lib/Devel/NYTProf/Reader.pm (original)
+++ trunk/lib/Devel/NYTProf/Reader.pm Mon Oct 27 17:50:33 2008
@@ -404,7 +404,10 @@
print OUT $taintmsg if $tainted;
print OUT $datastart;
- if (!open(IN, "<", $filestr)) {
+ my $LINE = 1; # actual line number. PATTERN variable, DO NOT
CHANGE
+ my $fileinfo = $profile->fileinfo_of($filestr);
+ my $src_lines = $fileinfo->srclines_array;
+ if (!$src_lines) {
# ignore synthetic file names that perl assigns when reading
# code returned by a CODE ref in @INC
@@ -417,13 +420,14 @@
. "or ensure [EMAIL PROTECTED] is correct."
unless $filestr eq '-e'
or our $_generate_report_inc_hint++;
- warn "Unable to open '$filestr' for reading: $!.$hint\n"
+ my $msg = "Unable to open '$filestr' for reading: $!.$hint\n";
+ warn $msg
unless our
$_generate_report_filestr_warn->{$filestr}++; # only once
- next;
+ $src_lines = [ $msg ];
+ $LINE = 0;
}
- my $LINE = 1; # actual line number. PATTERN variable, DO NOT
CHANGE
- foreach my $line (<IN>) {
+ while ( my $line = shift @$src_lines ) {
chomp $line;
foreach my $regexp (@{$self->{user_regexp}}) {
$line =~ s/$regexp->{pattern}/$regexp->{replace}/g;
@@ -495,6 +499,7 @@
$LINE = '';
my $src = "sub $subname; # xsub\n\t";
+ my $filestr = '';
foreach my $hash (@{$self->{line}}) {
@@ -504,12 +509,12 @@
print OUT $func->(
$subname, undef,
undef, $LINE, $src, $profile,
- [ $subinfo ], {}
+ [ $subinfo ], {}, $filestr
);
}
else {
print OUT $func->(
- $subname, $LINE, $src, $profile, [ $subinfo ], {}
+ $subname, $LINE, $src, $profile, [ $subinfo ], {},
$filestr
);
}
}
--~--~---------~--~----~------------~-------~--~----~
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]
-~----------~----~----~----~------~----~------~--~---
