Revision: 1182
Author: [email protected]
Date: Wed Mar 31 14:52:53 2010
Log: Skip sequences of blank lines. (It turns out that perl doesn't save
chunks of POD
into the internal array that savesrc uses. So pod chunks leave big ugly
blank sections
of reports. They're now collapsed into a single line with "- -" as the line
number.)
More ::Reader reductions.
Don't show file-has-been-modified warning if using savesrc.
http://code.google.com/p/perl-devel-nytprof/source/detail?r=1182
Modified:
/trunk/Changes
/trunk/bin/nytprofhtml
/trunk/lib/Devel/NYTProf/FileInfo.pm
/trunk/lib/Devel/NYTProf/Reader.pm
=======================================
--- /trunk/Changes Tue Mar 30 14:46:39 2010
+++ /trunk/Changes Wed Mar 31 14:52:53 2010
@@ -22,6 +22,9 @@
Corrected typos in nytprofhtml docs thanks to [email protected]
+ Sequences are blank lines are skipped in generated reports.
+ Applies to savesrc mode in which perl doesn't store pod.
+
=head2 Changes in Devel::NYTProf 3.11 (svn 1171) 12th March 2010
Fixed assorted issues on Windows thanks to Jan Dubois.
=======================================
--- /trunk/bin/nytprofhtml Wed Mar 31 13:30:49 2010
+++ /trunk/bin/nytprofhtml Wed Mar 31 14:52:53 2010
@@ -105,7 +105,7 @@
$reporter->set_param(
'header',
sub {
- my ($profile, $filestr, $output_filestr, $level) = @_;
+ my ($profile, $fi, $output_filestr, $level) = @_;
my $profile_level_buttons =
get_level_buttons($profile->get_profile_levels,
$output_filestr, $level);
@@ -114,30 +114,20 @@
For ${ \($profile->{attribute}{application}) }
};
- get_html_header("Profile of !~FILENAME~!")
- . get_page_header(
+ my $html_header = get_html_header("Profile of !~FILENAME~!");
+ my $page_header = get_page_header(
profile => $profile,
title => "NYTProf Performance Profile",
subtitle => $subhead,
- )
- . qq{
-<div class="body_content">
-<br />
-<table>
-<tr>
-<td class="h" align="right">File</td>
-<td align="left">!~FILENAME~!</td>
-</tr>
-<tr>
-<td class="h" align="right">Statements Executed</td>
-<td align="left">!~TOTAL_CALLS~!</td>
-</tr>
-<tr>
-<td class="h" align="right">Statement Execution Time</td>
-<td align="left">!~TOTAL_TIME~!</td>
-</tr>
-</table>
-};
+ );
+ my $intro = sprintf qq{<table class="file_summary">%s</table>},
+ join "\n", map { sprintf q{<tr><td class="h">%s</td><td
align="left">%s</td></tr>}, @$_ }
+ [ "Filename", sprintf q{<a href="file://%s">%s</a>},
+ $fi->filename, _escape_html($fi->filename) ],
+ [ "Statements Executed", sprintf "%d executed in %s",
+ $fi->sum_of_stmts_count,
fmt_time($fi->sum_of_stmts_time) ];
+
+ return join "\n", $html_header, $page_header, q{<div
class="body_content"><br />}, $intro;
}
);
@@ -188,7 +178,7 @@
my $sortby_desc = ($sortby eq 'excl_time') ? "exclusive
time" : "inclusive time";
$sub_links .= qq{
<table id="subs_table" border="1" cellpadding="0"
class="tablesorter">
- <caption>${qualifier}Subroutines — ordered by
$sortby_desc</caption>
+ <caption>${qualifier}Subroutines</caption>
<thead>
<tr>
<th>Calls</th>
@@ -254,10 +244,8 @@
$sub_links .= "</tr>\n";
}
- $sub_links .= q{
- </tbody>
- </table>
- };
+ $sub_links .= q{</tbody>};
+ $sub_links .= q{</table>};
# make table sortable if it contains all the subs
push @on_ready_js, q{
@@ -277,7 +265,8 @@
$reporter->set_param(
'datastart',
sub {
- my ($profile, $filestr) = @_;
+ my ($profile, $fi) = @_;
+ my $filestr = $fi->filename;
my $sub_table = subroutine_table($profile, $filestr, undef, undef);
@@ -328,7 +317,7 @@
);
$reporter->set_param( footer => sub {
- my ($profile, $filestr) = @_;
+ my ($profile, $fi) = @_;
my $footer = get_footer($profile);
return "</tbody></table></div>$footer</body></html>";
} );
=======================================
--- /trunk/lib/Devel/NYTProf/FileInfo.pm Wed Mar 31 13:30:49 2010
+++ /trunk/lib/Devel/NYTProf/FileInfo.pm Wed Mar 31 14:52:53 2010
@@ -240,14 +240,17 @@
# returning the still-relative filename is better than returning an
undef
return $filename;
}
+
+# has source code stored within the profile data file
+sub has_savesrc {
+ my $self = shift;
+ return $self->profile->{fid_srclines}[ $self->fid ];
+}
sub srclines_array {
my $self = shift;
- my $profile = $self->profile;
- #warn Dumper($profile->{fid_srclines});
-
- my $fid = $self->fid;
- if (my $srclines = $profile->{fid_srclines}[ $fid ]) {
+
+ if (my $srclines = $self->has_savesrc) {
my $copy = [ @$srclines ]; # shallow clone
shift @$copy; # line 0 not used
return $copy;
@@ -259,6 +262,7 @@
}
if ($self->flags & NYTP_FIDf_IS_FAKE) {
+ my $fid = $self->fid;
return [ "# fid$fid: NYTP_FIDf_IS_FAKE - e.g., unknown caller of
an eval.\n" ];
}
=======================================
--- /trunk/lib/Devel/NYTProf/Reader.pm Wed Mar 31 13:30:49 2010
+++ /trunk/lib/Devel/NYTProf/Reader.pm Wed Mar 31 14:52:53 2010
@@ -69,25 +69,6 @@
taintmsg => "# WARNING!\n"
. "# The source file used in generating this report has been
modified\n"
. "# since generating the profiler database. It might be out
of sync\n",
-
- # -- OTHER STUFF --
- replacements => [
- { pattern => '!~FILENAME~!',
- replace => "\$FILE"
- },
- { pattern => '!~LEVEL~!',
- replace => "\$LEVEL"
- },
- { pattern => '!~TOTAL_CALLS~!',
- replace => "\$fi->meta->{'calls'}"
- },
- { pattern => '!~TOTAL_TIME~!',
- replace => "fmt_time(\$fi->meta->{'time'})"
- },
- ],
- callsfunc => undef,
- timefunc => undef,
- 'time/callsfunc' => undef,
};
bless($self, $class);
@@ -234,11 +215,6 @@
my $meta = $fi->meta;
my $filestr = $meta->{filename};
- # test file modification date. Files that have been touched after
the
- # profiling was done may very well produce useless output since
the source
- # file might differ from what it looked like before.
- my $tainted = $self->file_has_been_modified($filestr);
-
my %stats_accum; # holds all line times. used to find
median
my %stats_by_line; # holds individual line stats
my $runningTotalTime = 0; # holds the running total
@@ -323,27 +299,12 @@
my $fname = $meta->{html_safe} . $self->{suffix};
# localize header and footer for variable replacement
- my $header = $self->get_param('header', [$profile, $filestr,
$fname, $LEVEL]);
- my $taintmsg = $self->get_param('taintmsg', [$profile,
$filestr]);
- my $datastart = $self->get_param('datastart', [$profile,
$filestr]);
- my $dataend = $self->get_param('dataend', [$profile,
$filestr]);
+ my $header = $self->get_param('header', [$profile, $fi,
$fname, $LEVEL]);
+ my $taintmsg = $self->get_param('taintmsg', [$profile, $fi]);
+ my $datastart = $self->get_param('datastart', [$profile, $fi]);
+ my $dataend = $self->get_param('dataend', [$profile, $fi]);
my $FILE = $filestr;
- foreach my $transform (@{$self->{replacements}}) {
- my $pattern = $transform->{pattern};
- my $replace = $transform->{replace};
-
- if ($pattern =~ m/^!~\w+~!$/) {
-
- # replace variable content
- $replace = eval $replace;
- $header =~ s/$pattern/$replace/g;
- $taintmsg =~ s/$pattern/$replace/g;
- $datastart =~ s/$pattern/$replace/g;
- $dataend =~ s/$pattern/$replace/g;
- }
- }
-
# open output file
#warn "$self->{output_dir}/$fname";
open(OUT, ">", "$self->{output_dir}/$fname")
@@ -351,10 +312,15 @@
# begin output
print OUT $header;
- print OUT $taintmsg if $tainted;
+
+ # If we don't have savesrc for the file then we'll be reading the
current
+ # file contents which may have changed since the profile was run.
+ # In this case we need to warn the user as the report would be
garbled.
+ print OUT $taintmsg if !$fi->has_savesrc and
$self->file_has_been_modified($filestr);
+
print OUT $datastart;
- my $LINE = 1; # actual line number. PATTERN variable, DO NOT
CHANGE
+ my $LINE = 1; # line number in source code
my $src_lines = $fi->srclines_array;
if (!$src_lines) { # no savesrc, and no file available
@@ -391,17 +357,24 @@
my $line_sub = $self->{mk_report_source_line}
or die "mk_report_source_line not set";
+ my $prev_line = '-';
while ( @$src_lines ) {
my $line = shift @$src_lines;
chomp $line;
+ # detect a series of blank lines, e.g. a chunk of pod savesrc
didn't store
+ my $skip_blanks = ($prev_line eq '' && $line eq '' &&
$src_lines->[0] =~ /^\s*$/);
+
if ($line =~ m/^\# \s* line \s+ (\d+) \b/x) {
# XXX we should be smarter about this - patches welcome!
+ # We should at least ignore the common AutoSplit case
+ # which we detect and workaround elsewhere.
warn "Ignoring '$line' directive at line $LINE - profile
data for $filestr will be out of sync with source!\n"
unless our $line_directive_warn->{$filestr}++; # once
per file
}
- print OUT $line_sub->($LINE, $line,
+ print OUT $line_sub->(
+ ($skip_blanks) ? "- -" : $LINE, $line,
$stats_by_line{$LINE} || {},
\%stats_for_file,
$subs_defined_hash->{$LINE} || [],
@@ -410,9 +383,15 @@
$filestr,
$evals_at_line->{$LINE},
);
+
+ if ($skip_blanks) {
+ while ($src_lines->[0] =~ /^\s*$/) {
+ shift @$src_lines;
+ $LINE++;
+ }
+ }
}
continue {
- # Increment line number counters
$LINE++;
}
--
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]
To unsubscribe, reply using "remove me" as the subject.
