#!/home/grinnz/projects/cpandoc-browser/perls/5.38.2/bin/perl ########################################################## ## This script is part of the Devel::NYTProf distribution ## ## Copyright, contact and other information can be found ## at the bottom of this file, or by going to: ## https://metacpan.org/pod/Devel::NYTProf ## ########################################################### =head1 NAME nytprofhtml - Generate reports from Devel::NYTProf data =head1 SYNOPSIS Typical usage: $ perl -d:NYTProf some_perl_app.pl $ nytprofhtml --open Options synopsis: $ nytprofhtml [-h] [-d] [-m] [-o ] [-f ] [--open] =encoding ISO8859-1 =cut use warnings; use strict; use Carp; use Config qw(%Config); use Getopt::Long; use List::Util qw(sum max); use File::Copy; use File::Spec; use File::Which qw(which); 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; use Devel::NYTProf::Util qw( fmt_float fmt_time fmt_incl_excl_time calculate_median_absolute_deviation get_abs_paths_alternation_regex html_safe_filename ); use Devel::NYTProf::Constants qw(NYTP_SCi_CALLING_SUB); our $VERSION = '6.14'; 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"; } my $has_json = eval { require JSON::MaybeXS; JSON::MaybeXS->import(); 1 } or warn "Can't load JSON::MaybeXS module - HTML visualizations skipped ($@)\n"; my $script_ext = ($^O eq "MSWin32") ? "" : ".pl"; my $nytprofcalls = File::Spec->catfile($Config{'bin'}, 'nytprofcalls'); $nytprofcalls = which 'nytprofcalls' if not -e $nytprofcalls; die "Unable to find nytprofcalls in $Config{bin} or on the PATH" unless $nytprofcalls; my $flamegraph = File::Spec->catfile($Config{'bin'}, 'flamegraph') . $script_ext; $flamegraph = which "flamegraph$script_ext" if not -e $flamegraph; die "Unable to find flamegraph$script_ext in $Config{bin} or on the PATH" unless $flamegraph; my @treemap_colors = (0,2,4,6,8,10,1,3,5,7,9); # These control the limits for what the script will consider ok to severe times # specified in standard deviations from the mean time use constant SEVERITY_SEVERE => 2.0; # above this deviation, a bottleneck use constant SEVERITY_BAD => 1.0; use constant SEVERITY_GOOD => 0.5; # within this deviation, okay use constant NUMERIC_PRECISION => 5; my @on_ready_js; GetOptions( 'file|f=s' => \(my $opt_file = 'nytprof.out'), 'lib|l=s' => \my $opt_lib, 'out|o=s' => \(my $opt_out = 'nytprof'), 'delete|d!' => \my $opt_delete, 'open!' => \my $opt_open, 'help|h' => sub { exit usage() }, 'minimal|m!'=> \my $opt_minimal, 'flame!' => \(my $opt_flame = 1), 'mergeevals!'=> \(my $opt_mergeevals = 1), 'flamewidth=i' => \(my $opt_flame_width = 1200), 'profself!' => sub { }, # handled in BEGIN above 'debug!' => \my $opt_debug, ) or do { exit usage(); }; DB::set_option('blocks', 0) if $opt_minimal; sub usage { print <, -f Read profile data from the specified file [default: nytprof.out] --out , -o Write report files to this directory [default: nytprof] --delete, -d Delete any old report files in first --open Open the generated report in a web browser --lib , -l Add to the beginning of \@INC --no-flame Disable flame graph (and call stacks processing) --flamewidth Width of the flame graph [default: 1200] --minimal, -m Don't generate graphviz .dot files or block/sub-level reports --no-mergeevals Disable merging of string evals --help, -h Print this message This script is part of the Devel::NYTProf distribution. See http://metacpan.org/release/Devel-NYTProf/ for details and copyright. END return 0; } # handle output location if (!-e $opt_out) { # will be created } elsif (!-d $opt_out) { die "$0: Specified output directory '$opt_out' already exists as a file!\n"; } elsif (!-w $opt_out) { die "$0: Unable to write to output directory '$opt_out'\n"; } else { if (defined($opt_delete)) { print "Deleting existing $opt_out directory\n"; rmtree($opt_out); } } # handle custom lib path if (defined($opt_lib)) { warn "$0: Specified lib directory '$opt_lib' does not exist.\n" unless -d $opt_lib; require lib; lib->import($opt_lib); } $SIG{USR2} = \&Carp::cluck if exists $SIG{USR2}; # some platforms don't have SIGUSR2 (Windows) my $reporter = new Devel::NYTProf::Reader($opt_file, { quiet => 0, skip_collapse_evals => !$opt_mergeevals, }); # place to store this $reporter->output_dir($opt_out); # set formatting for html $reporter->set_param( 'header', sub { my ($profile, $fi, $output_filestr, $level) = @_; my $profile_level_buttons = ($fi->is_eval) ? '' : get_level_buttons($profile->get_profile_levels, $output_filestr, $level); my $subhead = qq{  $profile_level_buttons
For ${ \($profile->{attribute}{application}) } }; my $html_header = get_html_header("Profile of ".$fi->filename_without_inc); my $page_header = get_page_header( profile => $profile, title => "NYTProf Performance Profile", subtitle => $subhead, ); my $filename_escaped = _escape_html($fi->filename); my @intro_rows = ( [ "Filename", $fi->is_file ? sprintf(q{%s}, $fi->filename, $filename_escaped) : $filename_escaped ], [ "Statements", sprintf "Executed %d statements in %s", $fi->sum_of_stmts_count, fmt_time($fi->sum_of_stmts_time) ], ); if ($fi->is_eval) { push @intro_rows, [ "Eval Invoked At", sprintf q{%s line %d}, $reporter->href_for_file($fi->eval_fi, $fi->eval_line), _escape_html($fi->eval_fi->filename), $fi->eval_line ]; my @sibling_html; for my $e_fi ($fi->sibling_evals) { if ($e_fi == $fi) { push @sibling_html, 1+@sibling_html; } else { push @sibling_html, sprintf qq{%d}, $reporter->href_for_file($e_fi), 1+@sibling_html; } } push @intro_rows, [ "Sibling evals", join ", ", @sibling_html ] if @sibling_html >= 2; } my $intro_table = join "\n", map { sprintf q{%s%s}, @$_ } @intro_rows; return join "\n", $html_header, $page_header, q{

}, qq{$intro_table
}, } ); $reporter->set_param( 'taintmsg', qq{
WARNING!
\n
The source file used to generate this report was modified after the profiler data was generated. The data might be out of sync with the modified source code so you should regenerate it. Meanwhile, the data on this page might not make much sense!
\n} ); $reporter->set_param( 'sawampersand', sub { my ($profile, $fi) = @_; my $line = $profile->{attribute}{sawampersand_line}; return qq{
NOTE!
\n

While profiling this file Perl noted the use of one or more special variables that impact the performance of all regular expressions in the program.

Use of the "\$`", "\$&", and "\$'" variables should be replaced with faster alternatives.
See the WARNING at the end of the Capture Buffers section of the perlre documentation.

The use is detected by perl at compile time but by NYTProf during execution. NYTProf first noted it when executing line $line. That was probably the first statement executed by the program after perl compiled the code containing the variables. If the variables can't be found by studying the source code, try using the Devel::FindAmpersand or B::Lint modules.

\n} } ) if $] < 5.017008; $reporter->set_param( 'merged_fids', sub { my ($profile, $fi) = @_; my $merged_fids = $fi->meta->{merged_fids}; my $evals_shown = 1 + scalar @$merged_fids; my @siblings = $fi->sibling_evals; my $merged_siblings = sum(map { scalar @{$_->meta->{merged_fids}||[]} } @siblings); my $evals_total = @siblings + $merged_siblings; my @msg; push @msg, sprintf qq{ The data used to generate this report page was merged from %s
of the string eval on line %d of %s. }, ($evals_shown == $evals_total) ? sprintf("all %d executions", $evals_shown) : sprintf("%d of the %d executions", $evals_shown, $evals_total), $fi->eval_line, $fi->eval_fi->filename; push @msg, qq{ The source code shown below is the text of just one of the calls to the eval.
\n This report page might not make much sense because the argument source code of those eval calls varied.
\n } if $fi->meta->{merged_fids_src_varied}; return sprintf qq{
NOTE!
\n
%s
}, join "
", @msg; }, ); sub calc_mad_from_objects { my ($ary, $meth, $ignore_zeros) = @_; return calculate_median_absolute_deviation([map { scalar $_->$meth } @$ary], $ignore_zeros); } sub subroutine_table { my ($profile, $fi, $max_subs, $sortby) = @_; $sortby ||= 'excl_time'; my $subs_in_file = ($fi) ? $profile->subs_defined_in_file($fi, 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/^|\[/); my $filestr = ($fi) ? $fi->filename : undef; # XXX slow - use Schwartzian transform or via XS or Sort::Key my @subs = sort { $b->$sortby <=> $a->$sortby or $a->subname cmp $b->subname } values %$subs_in_file; # in the overall summary, don't show subs that were never called @subs = grep { $_->calls > 0 } @subs if !$fi; my $dev_incl_time = calc_mad_from_objects(\@subs, 'incl_time', 1); my $dev_excl_time = calc_mad_from_objects(\@subs, 'excl_time', 1); my $dev_calls = calc_mad_from_objects(\@subs, 'calls', 1); my $dev_call_count = calc_mad_from_objects(\@subs, 'caller_count', 1); my $dev_call_fids = calc_mad_from_objects(\@subs, 'caller_fids', 1); my @subs_to_show = ($max_subs) ? splice @subs, 0, $max_subs : @subs; my $qualifier = (@subs > @subs_to_show) ? "Top $max_subs " : ""; my $max_pkg_name_len = max(map { length($_->package) } @subs_to_show); my $sub_links; my $sortby_desc = ($sortby eq 'excl_time') ? "exclusive time" : "inclusive time"; $sub_links .= qq{ }; my $profiler_active = $profile->{attribute}{profiler_active}; my @rows; $sub_links .= "\n"; for my $sub (@subs_to_show) { $sub_links .= ""; $sub_links .= determine_severity($sub->calls || 0, $dev_calls); $sub_links .= determine_severity($sub->caller_count || 0, $dev_call_count); $sub_links .= determine_severity($sub->caller_fids || 0, $dev_call_fids); $sub_links .= determine_severity($sub->excl_time || 0, $dev_excl_time, 1, sprintf("%.1f%%", $sub->excl_time/$profiler_active*100) ); $sub_links .= determine_severity($sub->incl_time || 0, $dev_incl_time, 1, sprintf("%.1f%%", $sub->incl_time/$profiler_active*100) ); my @hints; # package and subname my $subname = $sub->subname; if (my $merged_sub_names = $sub->meta->{merged_sub_names}) { push @hints, sprintf "merge of %d subs", 1+scalar @$merged_sub_names; } my ($pkg, $subr) = ($subname =~ /^(.*::)(.*?)$/) ? ($1, $2) : ('', $subname); # remove OWN filename from eg __ANON__[(eval 3)[/long/path/name.pm:99]:53] # becomes __ANON__[(eval 3)[:99]:53] # XXX doesn't work right if $filestr isn't full filename $subr =~ s/\Q$filestr\E:(\d+)/:$1/g if $filestr; # remove @INC prefix from other paths $subr =~ s/$inc_path_regex//; # for __ANON__[/very/long/path...] $sub_links .= qq{}, $max_pkg_name_len+2, $pkg, $reporter->href_for_sub($subname), $subr, (@hints) ? " (".join("; ",@hints).")" : ""; $sub_links .= "\n"; } $sub_links .= q{}; $sub_links .= q{
${qualifier}Subroutines
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
}; # hidden span is for tablesorter to sort on $sub_links .= sprintf(qq{%s::%s}, $pkg, $subr); if ($sub->is_xsub) { my $is_opcode = ($pkg eq 'CORE' or $subr =~ /^CORE:/); unshift @hints, ($is_opcode) ? 'opcode' : 'xsub'; } if (my $recdepth = $sub->recur_max_depth) { unshift @hints, sprintf "recurses: max depth %d, inclusive time %s", $recdepth, fmt_time($sub->recur_incl_time); } $sub_links .= sprintf qq{%*s%s%s
}; # make table sortable if it contains all the subs push @on_ready_js, q< $("#subs_table").tablesorter({ sortList: [[3,1]], headers: { 3: { sorter: 'fmt_time' }, 4: { sorter: 'fmt_time' } } }); $(".floatHeaders").each( function(){ $(this).floatThead(); } ); show_fragment_target(); $(window).on('hashchange', function(e){ show_fragment_target(); }); > if @subs_to_show == @subs; return $sub_links; } $reporter->set_param( 'datastart', sub { my ($profile, $fi) = @_; my $filestr = $fi->filename; my $sub_table = subroutine_table($profile, $fi, undef, undef); if ($sub_table and not $opt_minimal) { my $dot_file = html_safe_filename($filestr) . ".dot"; $sub_table .= qq{ Call graph for these subroutines as a Graphviz dot language file. }; our %dot_file_generated; if ($dot_file_generated{$dot_file}++) { # just once for line/block/sub my $subs_in_file = $profile->subs_defined_in_file($filestr, 0); # include subs defined in this file # and/or called from subs defined in this file #warn "$dot_file: @{[ keys %$subs_in_file ]}\n"; my $sub_filter = sub { my ($si, $calledby) = @_; return 1 if not defined $calledby; my $subname = $si->subname; my $include = ($subs_in_file->{$subname} || $subs_in_file->{$calledby}); #warn "Call graph $subname<-$calledby: ".($include ? "SHOW" : "skip")."\n"; return $include; }; output_subs_callgraph_dot_file($reporter, $dot_file, $sub_filter, 0); } } return qq{ $sub_table \n }; } ); $reporter->set_param( footer => sub { my ($profile, $fi) = @_; my $footer = get_footer($profile); return "
Line State
ments
Time
on line
Calls Time
in subs
Code
$footer"; } ); $reporter->set_param(mk_report_source_line => \&mk_report_source_line); $reporter->set_param(mk_report_xsub_line => \&mk_report_xsub_line ); $reporter->set_param(mk_report_separator_line => \&mk_report_separator_line ); sub mk_report_source_line { my ($linenum, $line, $stats_for_line, $stats_for_file, $profile, $fi) = @_; my $l = sprintf(qq{%s}, $linenum, $linenum); my $s = report_src_line(undef, $linenum, $line, $profile, $fi, $stats_for_line); return "$l$s\n" if not %$stats_for_line; return join "", "$l", determine_severity($stats_for_line->{'calls'}, $stats_for_file->{'calls'}), determine_severity($stats_for_line->{'time'}, $stats_for_file->{'time'}, 1, \sprintf("Avg %s", fmt_time($stats_for_line->{'time/call'})||'--' )), determine_severity($stats_for_line->{'subcall_count'}, $stats_for_file->{subcall_count}, 0), determine_severity($stats_for_line->{'subcall_time'}, $stats_for_file->{subcall_time}, 1), $s, "\n"; } sub mk_report_xsub_line { my ($subname, $line, $stats_for_line, $stats_for_file, $profile, $fi) = @_; (my $anchor = $subname) =~ s/\W/_/g; return join "", sprintf(qq{%s}, $anchor, ''), "", report_src_line(undef, undef, $line, $profile, $fi, $stats_for_line), "\n"; } sub mk_report_separator_line { my ($profile, $fi) = @_; return join "", sprintf(qq{%s}, '', ' '), "", '', "\n"; } sub _escape_html { local $_ = shift; s/\t/ /g; # XXX incorrect for most non-leading tabs s/&/&/g; s//>/g; s{\n}{
}g; # for xsub pseudo-sub declarations s{"}{"}g; # for attributes like title="..." return $_; } sub report_src_line { my ($value, undef, $linesrc, $profile, $fi, $stats_for_line) = @_; $linesrc = _escape_html($linesrc); our $inc_path_regex ||= get_abs_paths_alternation_regex([$profile->inc]); my @prologue; # for each of the subs defined on this line, who called them my $subdef_info = $stats_for_line->{subdef_info} || []; for my $sub_info (@$subdef_info) { my $callers = $sub_info->caller_fid_line_places; next unless $callers && %$callers; my $subname = $sub_info->subname; my @callers; while (my ($fid, $fid_line_info) = each %$callers) { for my $line (keys %$fid_line_info) { my $sc = $fid_line_info->{$line}; warn "$linesrc $subname caller info missing" if !@$sc; next if !@$sc; push @callers, [ $fid, $line, @$sc ]; } } my $total_calls = sum(my @caller_calls = map { $_->[2] } @callers); push @prologue, sprintf "# spent %s within %s which was called%s:", fmt_incl_excl_time($sub_info->incl_time, $sub_info->excl_time), $subname, ($total_calls <= 1) ? "" : sprintf(" %d times, avg %s/call", $total_calls, fmt_time($sub_info->incl_time / $total_calls)); push @prologue, sprintf "# (data for this subroutine includes %d others that were merged with it)", scalar @{$sub_info->meta->{merged_sub_names}} if $sub_info->meta->{merged_sub_names}; my $max_calls = max(@caller_calls); # order by most frequent caller first, then by time @callers = sort { $b->[2] <=> $a->[2] || $b->[3] <=> $a->[3] } @callers; for my $caller (@callers) { my ($fid, $line, $count, $incl_time, $excl_time, undef, undef, undef, undef, $calling_subs) = @$caller; my @subnames = sort keys %{$calling_subs || {}}; my $subname = (@subnames) ? " by " . join(" or ", @subnames) : ""; my $caller_fi = $profile->fileinfo_of($fid); if (!$caller_fi) { # should never happen warn sprintf "Caller of %s, from fid %d line %d has no fileinfo (%s)", $sub_info, $fid, $line, $subname; die 2; next; } my $avg_time = ""; $avg_time = sprintf ", avg %s/call", fmt_time($incl_time / $count) if $count > 1; my $times = sprintf " (%s+%s)", fmt_time($excl_time), fmt_time($incl_time - $excl_time); my $filename = $caller_fi->filename($fid); my $line_desc = "line $line of $filename"; $line_desc =~ s/ of \Q$filename\E$//g if $filename eq $fi->filename; # remove @INC prefix from paths $line_desc =~ s/$inc_path_regex//g; my $href = $reporter->href_for_file($caller_fi, $line); push @prologue, sprintf q{# %*s times%s%s at %s%s}, length($max_calls), $count, $times, $subname, $href, $line_desc, $avg_time; $prologue[-1] =~ s/^(# +)1 times/$1 once/; # better English } } my $prologue = ''; $prologue = sprintf qq{
%s
}, join("\n", @prologue) if @prologue; my $epilogue = ''; my $ws; # give details of each of the subs called by this line my $subcall_info = $stats_for_line->{subcall_info}; if ($subcall_info && %$subcall_info) { my @calls_to = sort { $subcall_info->{$b}[1] <=> $subcall_info->{$a}[1] or # incl_time $a cmp $b } keys %$subcall_info; my $max_calls_to = max(map { $_->[0] } values %$subcall_info); $ws ||= ($linesrc =~ m/^((?: |\s)+)/) ? $1 : ''; my $subs_called_html = join "\n", map { my $subname = $_; my ($count, $incl_time, $reci_time, $rec_depth) = (@{$subcall_info->{$subname}})[0,1,5,6]; my $html = sprintf qq{%s# spent %s making %*d call%s to }, $ws, fmt_time($incl_time+$reci_time, 5), length($max_calls_to), $count, $count == 1 ? "" : "s"; (my $subname_trimmed = $subname) =~ s/$inc_path_regex//g; $html .= sprintf qq{%s}, $reporter->href_for_sub($subname), $subname_trimmed; $html .= sprintf qq{, avg %s/call}, fmt_time(($incl_time+$reci_time) / $count), if $count > 1; if ($rec_depth) { $html .= sprintf qq{, recursion: max depth %d, sum of overlapping time %s}, $rec_depth, fmt_time($reci_time); } $html; } @calls_to; $epilogue .= sprintf qq{
%s
}, $subs_called_html; } # give details of each of the string evals executed on this line my $evals_called = $stats_for_line->{evalcall_info}; if ($evals_called && %$evals_called) { $ws ||= ($linesrc =~ m/^((?: |\s)+)/) ? $1 : ''; my @eval_fis = sort { $b->sum_of_stmts_time(1) <=> $a->sum_of_stmts_time(1) or $a->filename cmp $b->filename } values %$evals_called; my $evals_called_html = join "\n", map { my $eval_fi = $_; my $sum_of_stmts_time = $eval_fi->sum_of_stmts_time; my ($what, $extra) = ("string eval", ""); my $merged_fids = $eval_fi->meta->{merged_fids}; if ($merged_fids) { $what = sprintf "%d string evals (merged)", 1+@$merged_fids; } my @nested_evals = $eval_fi->has_evals(1); my $nest_eval_time = 0; if (@nested_evals) { $nest_eval_time = sum map { $_->sum_of_stmts_time } @nested_evals; $extra .= sprintf ", %s here plus %s in %d nested evals", fmt_time($sum_of_stmts_time), fmt_time($nest_eval_time), scalar @nested_evals if $nest_eval_time; } if (my @subs_defined = $eval_fi->subs_defined(1)) { my $sub_count = @subs_defined; my $call_count = sum map { $_->calls } @subs_defined; my $excl_time = sum map { $_->excl_time } @subs_defined; $extra .= sprintf "
%s# includes %s spent executing %d call%s to %d sub%s defined therein.", $ws, fmt_time($excl_time, 2), $call_count, ($call_count != 1) ? 's' : '', $sub_count, ($sub_count != 1) ? 's' : '' if $call_count; } my $link = sprintf(q{%s}, $reporter->href_for_file($eval_fi), $what); my $html = sprintf qq{%s# spent %s executing statements in %s%s}, $ws, fmt_time($sum_of_stmts_time+$nest_eval_time, 5), $link, $extra; $html; } @eval_fis; $epilogue .= sprintf qq{
%s
}, $evals_called_html; } return qq{$prologue$linesrc$epilogue}; } # set output options $reporter->set_param('suffix', '.html'); # output a css file too (optional, but good for pretty pages) $reporter->_output_additional('style.css', get_css()); # generate the files $reporter->report(); output_subs_index_page($reporter, "index-subs-excl.html", 'excl_time'); output_index_page($reporter, "index.html"); output_js_files($reporter); open_browser_on("$opt_out/index.html") if $opt_open; exit 0; # # SUBROUTINES # # output an html indexing page or subroutines sub output_subs_index_page { my ($r, $filename, $sortby) = @_; my $profile = $reporter->{profile}; open my $fh, '>', "$opt_out/$filename" or croak "Unable to open file $opt_out/$filename: $!"; print $fh get_html_header("Subroutine Index - NYTProf"); print $fh get_page_header(profile => $profile, title => "Performance Profile Subroutine Index"); print $fh qq{

}; # Show top subs across all files print $fh subroutine_table($profile, undef, 0, $sortby); my $footer = get_footer($profile); print $fh "
$footer"; close $fh; } # output an html indexing page with some information to help navigate potential # large numbers of profiled files. Optional, recommended sub output_index_page { my ($r, $filename) = @_; my $profile = $reporter->{profile}; ### open my $fh, '>', "$opt_out/$filename" or croak "Unable to open file $opt_out/$filename: $!"; my $application = $profile->{attribute}{application}; (my $app = $application) =~ s:.*/::; # basename $app =~ s/ .*//; print $fh get_html_header("NYTProf $app"); print $fh get_page_header(profile => $profile, title => "Performance Profile Index", skip_link_to_index=>1); print $fh qq{

}; # overall description my @all_fileinfos = $profile->all_fileinfos; my $eval_fileinfos = $profile->eval_fileinfos; my $summary = sprintf "Profile of %s for %s (of %s),", $application, fmt_time($profile->{attribute}{profiler_active}), fmt_time($profile->{attribute}{profiler_duration}); $summary .= " executing"; $summary .= sprintf " %d statements and", $profile->{attribute}{total_stmts_measured} -$profile->{attribute}{total_stmts_discounted} if $profile->{option}{stmts}; $summary .= sprintf " %d subroutine calls", $profile->{attribute}{total_sub_calls}; $summary .= sprintf " in %d source files", @all_fileinfos - $eval_fileinfos; $summary .= sprintf " and %d string evals", $eval_fileinfos if $eval_fileinfos; printf $fh qq{
%s.
}, _escape_html($summary); # generate name-sorted select options for files, if there are many if ($profile->noneval_fileinfos > 30) { print $fh qq{
}; print $fh qq{
\n"; } my $call_stacks_file = "all_stacks_by_time.calls"; my $call_stacks_svg = "all_stacks_by_time.svg"; if ($profile->{option}{calls} && $opt_flame) { my $mk_flamegraph = sub { my $total_sub_calls = $profile->{attribute}{total_sub_calls}; my $is_big = ($total_sub_calls <= 1_000_000); warn sprintf "Extracting subroutine call data%s ...\n", ($is_big) ? "" : " (There were $total_sub_calls of them, so this may take some time, or cancel and use --no-flame to skip this step.)"; system("\"$nytprofcalls\" $opt_file > $opt_out/$call_stacks_file") == 0 or die "Generating $opt_out/$call_stacks_file failed\n"; my %subname_subinfo_map = %{ $profile->subname_subinfo_map }; warn "Extracting subroutine links\n"; my $subattr = "$opt_out/flamegraph_subattr.txt"; open my $subattrfh, ">", $subattr or die "Error creating $subattr: $!\n"; while ( my ($subname, $si) = each %subname_subinfo_map ) { next unless $si->incl_time; print $subattrfh join("\t", $subname, q{href=}.$reporter->url_for_sub($subname), )."\n"; } close $subattrfh or die "Error writing $subattr: $!\n"; warn "Generating subroutine stack flame graph ...\n"; # factor to scale the values to microseconds my $factor = 1_000_000 / $profile->{attribute}{ticks_per_sec}; # total (width) for flamegraph is profiler_active in ticks my $run_us = $profile->{attribute}{profiler_active} * $profile->{attribute}{ticks_per_sec}; system("\"$flamegraph\" --nametype=sub --countname=microseconds --factor=$factor --width=$opt_flame_width --nameattr=$subattr --hash --total=$run_us $opt_out/$call_stacks_file > $opt_out/$call_stacks_svg") == 0 or die "Generating $opt_out/$call_stacks_svg failed\n"; print $fh qq{
\n}; print $fh qq{SVG not supported\n}; print $fh qq{

The Flame Graph above is a visualization of the time spent in distinct call stacks. The colors and x-axis position are not meaningful.

\n}; print $fh qq{
\n}; 1; }; eval { $mk_flamegraph->() } or warn $@; } # Show top subs across all files my $max_subs = 15; # keep it less than a page so users can see the file table my $all_subs = keys %{$profile->{sub_subinfo}}; print $fh subroutine_table($profile, undef, $max_subs, undef); if ($all_subs > $max_subs) { print $fh sprintf qq{ }, "index-subs-excl.html", $all_subs; } if ($has_json) { output_subs_treemap_page($reporter, "subs-treemap-excl.html", "Subroutine Exclusive Time Treemap", sub { shift->excl_time }); print $fh q{
You can view a treemap of subroutine exclusive time, grouped by package.
}; } else { print $fh q{
(Can't create visual treemap of subroutine exclusive times without the JSON::MaybeXS module.)
}; } if (not $opt_minimal) { output_subs_callgraph_dot_file($reporter, "packages-callgraph.dot", undef, 1); print $fh q{NYTProf also generates call-graph files in } .q{Graphviz format: } .q{inter-package calls}; output_subs_callgraph_dot_file($reporter, "subs-callgraph.dot", undef, 0); print $fh q{, all inter-subroutine calls}; print $fh q{ (probably too complex to render easily)} if $all_subs > 200; # arbitrary print $fh q{.
}; } print $fh q{
You can hover over some table cells and headings to view extra information.}; print $fh q{
Some table column headings can be clicked on to sort the table by that column.}; print $fh q{
}; output_file_table($fh, $profile, 1); my $footer = get_footer($profile); print $fh "
$footer"; close $fh; } # = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = # treemap subs sub js_for_new_treemap { my ($name, $new_args, $tree_data) = @_; return '' unless $has_json; my $default_new_args = { titleHeight => 0, # no titles addLeftClickHandler => 1, # zoom in #addRightClickHandler => 1, # zoom out (XXX but disables right click menu) offset => 0, # (0/2/4) extra padding around nested levels Color => { allow => 1, # value range for the $color property minValue => 0, maxValue => scalar @treemap_colors, # corresponding color range [R,G,B]: minColorValue => [0, 255, 50], maxColorValue => [255, 0, 50], }, Tips => { allow => 1, offsetX => 20, offsetY => 20, }, selectPathOnHover => 1, # adds "over-" css class to elements }; exists $new_args->{$_} or $new_args->{$_} = $default_new_args->{$_} for keys %$default_new_args; my $new_args_json = encode_json($new_args); my $tree_data_json = encode_json($tree_data); my $js = qq{ function init_$name() { var tm_args = $new_args_json; //This method is invoked when a DOM element is created. //Its useful to set DOM event handlers here or manipulate //the DOM Treemap nodes. tm_args.onCreateElement = function(content, tree, isLeaf, leaf){ //Add background image for cushion effect if(isLeaf) { var style = leaf.style, width = parseInt(style.width) - 2, height = parseInt(style.height) - 2; // don't add gradient if too small to be worth the cost if (width < 10 || height < 10) { // is narrow if (width < 50 && height < 50) // is small return; } leaf.innerHTML = tree.name + ""; style.width = width + "px"; style.height = height + "px"; } }; // add content to the tooltip when a node is hovered // move to separate function later tm_args.Tips.onShow = function(tip, node, isLeaf, domElement) { tip.innerHTML = node.data.tip; }; TM.Squarified.implement({ 'onLeftClick': function(elem) { // zoom in one level //if is leaf var node = TreeUtil.getSubtree(this.tree, elem.parentNode.id); if(node.children && node.children.length == 0) { var oldparent = node, newparent = node; while(newparent.id != this.shownTree.id) { oldparent = newparent; newparent = TreeUtil.getParent(this.tree, newparent.id); } this.view(oldparent.id); } else { this.enter(elem); } } }); TM.Squarified.implement({ createBox: function(json, coord, html) { if((coord.width * coord.height > 1) && json.data.\$area > 0) { if(!this.leaf(json)) var box = this.headBox(json, coord) + this.bodyBox(html, coord); else var box = this.leafBox(json, coord); return this.contentBox(json, coord, box); } else { return ""; //return empty string } } }); var $name = new TM.Squarified(tm_args); var json = $tree_data_json; $name.loadJSON(json); } }; return $js; } sub pl { # dumb but sufficient pluralization my ($fmt, $n) = @_; sprintf $fmt.($n == 1 ? "" : "s"), $n; } sub package_subinfo_map_to_tm_data { my ($package_tree_subinfo_map, $area_sub) = @_; my $sub_tip_html = sub { my $si = shift; my @html; push @html, sprintf "

%s

", $si->subname; push @html, sprintf "Called %s from %s in %s", pl("%d time", $si->calls), pl("%d place", scalar $si->caller_places), pl("%d file", scalar $si->caller_fids); my $total_time = $si->profile->{attribute}{profiler_duration}; my $incl_time = $si->incl_time; push @html, sprintf "Inclusive time: %s, %.2f%%", fmt_time($incl_time), $total_time ? $incl_time/$total_time*100 : 0; my $excl_time = $si->excl_time; push @html, sprintf "Exclusive time: %s, %.2f%%", fmt_time($excl_time), $total_time ? $excl_time/$total_time*100 : 0 if $excl_time ne $incl_time; if (my $mrd = $si->recur_max_depth) { push @html, sprintf "Recursion: max depth %d, recursive inclusive time %s", $mrd, fmt_time($si->recur_incl_time); } return join("
", @html)."

"; }; my $leaf_data_sub = sub { my ($subinfo, $area_from, $color) = @_; my $data = { '$area' => $area_from->($subinfo), '$color' => $color, tip => $sub_tip_html->($subinfo), map({ $_ => $subinfo->$_() } qw(subname incl_time excl_time)) }; return $data; }; our $nid; my $node_mapper; $node_mapper = sub { my ($k, $v, $title) = @_; $title = ($title) ? '::'.$k : $k; my $n = { id => "n".++$nid, name => $title, }; my @kids; for my $pkg_elem (keys %$v) { my $infos = $v->{$pkg_elem}; if (ref $infos eq 'HASH') { # recurse into subpackages push @kids, $node_mapper->($pkg_elem, $infos, $title); next; } # subs within this package our $color_seqn; # all subs in pkg get same color my $color = $treemap_colors[ $color_seqn++ % @treemap_colors ]; for my $info (@$infos) { # don't bother including subs that don't have any data # (unless we've not got any subs yet, to avoid problems elsewhere) next if $area_sub->($info) <= 0; push @kids, { id => ++$nid."-".$info->subname, name => $info->subname_without_package, data => $leaf_data_sub->($info, $area_sub, $color), children => [], }; } } $n->{data}{'$area'} = (@kids) ? sum(map { $_->{data}{'$area'} } @kids) : 0 if not defined $n->{data}{'$area'}; $n->{children} = \@kids; return $n; }; return $node_mapper->('', $package_tree_subinfo_map, ''); } sub output_treemap_code { my (%spec) = @_; my $fh = $spec{fh}; my $tm_id = 'tm'.$spec{id}; my $root_id = 'infovis'.$spec{id}; my $treemap_data = $spec{get_data}->(); $treemap_data->{name} = $spec{title} if $spec{title}; my $tm_js = js_for_new_treemap($tm_id, { rootId => $root_id }, $treemap_data); print $fh qq{\n}; push @on_ready_js, qq{init_$tm_id(); }; return $root_id; } sub output_subs_treemap_page { my ($r, $filename, $title, $area_sub) = @_; my $profile = $reporter->{profile}; open(my $fh, '>', "$opt_out/$filename") or croak "Unable to open file $opt_out/$filename: $!"; $title ||= "Subroutine Time Treemap"; print $fh get_html_header("$title - NYTProf", { add_jit => "Treemap" }); print $fh get_page_header( profile => $profile, title => $title); my @specs; push @specs, { id => 1, title => "Treemap of subroutine exclusive time", get_data => sub { package_subinfo_map_to_tm_data( $profile->package_subinfo_map(0,1), $area_sub || sub { shift->excl_time }, 0); } }; my @root_ids; for my $spec (@specs) { push @root_ids, output_treemap_code( fh => $fh, profile => $profile, %$spec ); } print $fh qq{

Boxes represent time spent in a subroutine. Coloring represents packages. Click to drill-down into package hierarchy, reload page to reset.
\n}; print $fh qq{
\n}; print $fh qq{
\n} for @root_ids; print $fh qq{
\n}; my $footer = get_footer($profile); print $fh "$footer"; close $fh; } # = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = sub output_subs_callgraph_dot_file { my ($r, $filename, $sub_filter, $only_show_packages) = @_; my $profile = $reporter->{profile}; my $subinfos = $profile->subname_subinfo_map; my $dot_file = "$opt_out/$filename"; open my $fh, '>', $dot_file or croak "Unable to open file $dot_file: $!"; my $inc_path_regex = get_abs_paths_alternation_regex([$profile->inc], qr/^|\[/); my $dotnode = sub { my $name = shift; $name =~ s/$inc_path_regex//; $name =~ s/"/\\"/g; return '"'.$name.'"'; }; print $fh "digraph {\n"; # } print $fh "graph [overlap=false]\n"; # target="???", URL="???" # gather link info my %sub2called_by; for my $subname (keys %$subinfos) { my $si = $subinfos->{$subname}; next unless $si->calls; # skip subs never called next if $sub_filter and not $sub_filter->($si, undef); my $called_by_subnames = $si->called_by_subnames; if (!%$called_by_subnames) { warn sprintf "%s has no caller subnames but a call count of %d\n", $subname, $si->calls; next; } if ($sub_filter) { my @delete = grep { !$sub_filter->($si, $_) } keys %$called_by_subnames; if (@delete) { # shallow copy so we can edit it safely $called_by_subnames = { %$called_by_subnames }; delete @{$called_by_subnames}{@delete}; } next if !keys %$called_by_subnames; } $sub2called_by{$subname} = $called_by_subnames; } # list of all subs to be included in graph (has duplicates) my %pkg_subs; for (keys %sub2called_by, map { keys %$_ } values %sub2called_by) { m/^(.*)::(.*)?$/ or warn "Strange sub name '$_'"; $pkg_subs{$1}{$_} = $sub2called_by{$_} || {}; } #stmt : node_stmt | edge_stmt | attr_stmt | ID '=' ID | subgraph #attr_stmt : (graph | node | edge) attr_list #attr_list : '[' [ a_list ] ']' [ attr_list ] #a_list : ID [ '=' ID ] [ ',' ] [ a_list ] #subgraph : [ subgraph [ ID ] ] '{' stmt_list '}' if ($only_show_packages) { my %once; # XXX many shapes cause v.large graphs with nodes v.far apart # when using neato (energy minimized) possibly a neato bug # some shapes, like doublecircle seem to avoid the problem. print $fh "node [shape=doublecircle];\n"; while ( my ($pkg, $subs) = each %pkg_subs ) { my @called_by = map { keys %$_ } values %$subs; for my $called_by (@called_by) { (my $called_by_pkg = $called_by) =~ s/^(.*)::.*?$/$1/; my $link = sprintf qq{%s -> %s;\n}, $dotnode->("$called_by_pkg"), $dotnode->("$pkg"); $once{$link} = 1; } } print $fh $_ for keys %once; } else { # output nodes and gather link info while ( my ($pkg, $pkg_subs) = each %pkg_subs) { (my $pkgmangled = $pkg) =~ s/\W+/_/g; # node_stmt: node_id [ attr_list ] printf $fh "subgraph cluster_%s {\n", $pkgmangled; # } printf $fh "\tlabel=%s;\n", $dotnode->($pkg); for my $subname (keys %$pkg_subs) { # node_stmt: node_id [ attr_list ] #printf $fh qq{\tnode [ %s ]}, ... printf $fh qq{\t%s;\n}, $dotnode->($subname); } # { - just to balance the brace below printf $fh "}\n"; } while ( my ($subname, $called_by_subnames) = each %sub2called_by ) { for my $called_by (keys %$called_by_subnames) { # edge_stmt : (node_id | subgraph) edgeRHS [ attr_list ] # edgeRHS : edgeop (node_id | subgraph) [ edgeRHS ] printf $fh qq{%s -> %s;\n}, $dotnode->($called_by), $dotnode->($subname); } } } print $fh "}\n"; close $fh; #system("open '$dot_file'"); die 1; return; } # = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = sub output_js_files { my ($profile) = @_; # find the js, gif, css etc files installed with Devel::NYTProf (my $lib = $INC{"Devel/NYTProf/Data.pm"}) =~ s/\/Data\.pm$//; _copy_dir("$lib/js", "$opt_out/js"); } sub _copy_dir { my ($srcdir, $dstdir) = @_; mkdir $dstdir or die "Can't create $dstdir directory: $!\n" unless -d $dstdir; for my $src (glob("$srcdir/*")) { (my $name = $src) =~ s{.*/}{}; next if $name =~ m/^\./; # skip . and .. etc my $dstname = "$dstdir/$name"; if (not -f $src) { _copy_dir($src, $dstname) if -d $src; # recurse next; # skip non-ordinary-files } unlink $dstname; copy($src, $dstname) or warn "Unable to copy $src to $dstname: $!"; } } sub open_browser_on { my $index = shift; my $exit_code = eval { require Browser::Open; Browser::Open::open_browser($index, 1); }; return if defined($exit_code) && $exit_code == 0; warn "$@\n" if $@ && $opt_debug; return if eval { require ActiveState::Browser; ActiveState::Browser::open($index); 1 }; warn "$@\n" if $@ && $opt_debug && $^O eq "MSWin32"; my $BROWSER; if ($^O eq "MSWin32") { $BROWSER = "start %s"; } elsif ($^O eq "darwin") { $BROWSER = "/usr/bin/open %s"; } else { my @try; if ($ENV{BROWSER}) { push(@try, split(/:/, $ENV{BROWSER})); } else { push(@try, qw(firefox galeon mozilla opera netscape)); } unshift(@try, "kfmclient") if $ENV{KDE_FULL_SESSION}; unshift(@try, "gnome-open") if $ENV{GNOME_DESKTOP_SESSION_ID}; unshift(@try, "xdg-open"); for (grep { have_prog($_) } @try) { if ($_ eq "kfmclient") { $BROWSER = "$_ openURL %s"; } elsif ($_ eq "gnome-open" || $_ eq "opera") { $BROWSER = "$_ %s"; } else { $BROWSER = "$_ %s &"; } last; } } if ($BROWSER) { (my $cmd = $BROWSER) =~ s/%s/"$index"/; warn "Running $cmd\n" if $opt_debug; system($cmd); } else { warn "Don't know how to invoke your web browser.\nPlease visit $index yourself!\n"; } } sub have_prog { my $prog = shift; for (split($Config{path_sep}, $ENV{PATH})) { return 1 if -x "$_/$prog"; } return 0; } sub output_file_table { my ($fh, $profile, $add_totals) = @_; # generate time-sorted sections for files print $fh qq{ }; print $fh qq{ }; my $inc_path_regex = get_abs_paths_alternation_regex([$profile->inc], qr/^|\[/); my $allTimes = $profile->{attribute}{total_stmts_duration}; my $allCalls = $profile->{attribute}{total_stmts_measured} - $profile->{attribute}{total_stmts_discounted}; # file in which sawampersand was noted during profiling my $sawampersand_fi = $profile->fileinfo_of($profile->{attribute}{sawampersand_fid}, 1); my (@t_stmt_exec, @t_stmt_time); my @fis = $profile->noneval_fileinfos; @fis = sort { $b->meta->{'time'} <=> $a->meta->{'time'} } @fis; my $dev_time = calculate_median_absolute_deviation([map { scalar $_->meta->{'time'} } @fis], 1); foreach my $fi (@fis) { my $meta = $fi->meta; my $fid = $fi->fid; my @extra; my $css_class = 'index'; # The stats in this table include rolled up sums of nested evals. my ($eval_stmts, $eval_time) = (0,0); if (my @has_evals = $fi->has_evals(1)) { my $n_evals = scalar @has_evals; my $msg = sprintf "including %d string eval%s", $n_evals, ($n_evals>1) ? "s" : ""; if (my @nested = grep { $_->eval_fid != $fid } @has_evals) { $msg .= sprintf ": %d direct plus %d nested", $n_evals-@nested, scalar @nested; } push @extra, $msg; $eval_stmts = sum(map { $_->sum_of_stmts_count } @has_evals); $eval_time = sum(map { $_->sum_of_stmts_time } @has_evals); } # is this file one where we sawampersand (or contains an eval that is)? if ($sawampersand_fi && $] < 5.017008 && $fi == ($sawampersand_fi->outer || $sawampersand_fi) ) { my $in_eval = ($fi == $sawampersand_fi) ? 'here' : sprintf q{in eval here}, $reporter->href_for_file($sawampersand_fi, undef, 'line'); push @extra, sprintf qq{variables that impact regex performance for whole application seen $in_eval}, $css_class = "warn $css_class"; } print $fh qq{}; my $stmts = $meta->{'calls'} + $eval_stmts; print $fh determine_severity($stmts, undef, 0, ($allCalls) ? sprintf("%.1f%%", $stmts/$allCalls*100) : '' ); push @t_stmt_exec, $stmts; my $time = $meta->{'time'} + $eval_time; print $fh determine_severity($time, $dev_time, 1, ($allTimes) ? sprintf("%.1f%%", $time/$allTimes*100) : '' ); push @t_stmt_time, $time; my %levels = reverse %{$profile->get_profile_levels}; my $rep_links = join ' • ', map { sprintf(qq{%s}, $reporter->href_for_file($fi, undef, $_), $_) } grep { $levels{$_} } qw(line block sub); print $fh ""; print $fh sprintf q{}, $fi->fid, $fi->abs_filename, $fi->filename_without_inc, (@extra) ? sprintf("(%s)", join "; ", @extra) : ""; print $fh "\n"; } print $fh "\n"; if ($add_totals) { print $fh "\n"; my $stats_fmt = qq{}; my $t_notes = ""; my $stmt_time_diff = $allTimes - sum(@t_stmt_time); if (sum(@t_stmt_exec) != $allCalls or $stmt_time_diff > 0.001) { $stmt_time_diff = ($stmt_time_diff > 0.001) ? sprintf(" and %s", fmt_time($stmt_time_diff)) : ""; $t_notes = sprintf "(%d statements%s are unaccounted for)", $allCalls - sum(@t_stmt_exec), $stmt_time_diff; } print $fh sprintf $stats_fmt, fmt_float(sum(@t_stmt_exec)), fmt_time(sum(@t_stmt_time)), "Total $t_notes" if @t_stmt_exec > 1 or $t_notes; if (@t_stmt_exec > 1) { print $fh sprintf $stats_fmt, int(fmt_float(sum(@t_stmt_exec) / @t_stmt_exec)), fmt_time( sum(@t_stmt_time) / @t_stmt_time), "Average"; print $fh sprintf $stats_fmt, '', fmt_time( $dev_time->[1]), "Median"; print $fh sprintf $stats_fmt, '', fmt_float($dev_time->[0]), "Deviation" if $dev_time->[0]; } print $fh "\n"; } print $fh '
Source Code Files — ordered by exclusive time then name
StmtsExclusive
Time
ReportsSource File
$rep_links%s %s
%s%s%s
'; push @on_ready_js, q{ $("#filestable").tablesorter({ sortList: [[1,1],[3,1]], headers: { 1: { sorter: 'fmt_time' }, 2: { sorter: false } } }); $(".floatHeaders").each( function(){ $(this).floatThead(); } ); show_fragment_target(); $(window).on('hashchange', function(e){ show_fragment_target(); }); }; return ""; } # calculates how good or bad the time is for a file based on the others sub determine_severity { my $val = shift; return "" unless defined $val; my $stats = shift; # @_[3] is like arrayref (deviation, mean) my $is_time = shift; my $title = shift; # normalize the width/precision so that the tables look good. my $fmt_val = ($is_time) ? fmt_time($val) : fmt_float($val, NUMERIC_PRECISION); my $class; if (defined $stats) { my $devs = ($val - $stats->[1]); #stats->[1] is the mean. $devs /= $stats->[0] if $stats->[0]; # no divide by zero when all values equal if ($devs < 0) { # fast $class = 'c3'; } elsif ($devs < SEVERITY_GOOD) { $class = 'c3'; } elsif ($devs < SEVERITY_BAD) { $class = 'c2'; } elsif ($devs < SEVERITY_SEVERE) { $class = 'c1'; } else { $class = 'c0'; } } else { $class = 'n'; } if ($title) { $title = (ref $title) ? $$title : _escape_html($title); $fmt_val = qq{$fmt_val}; } return qq{$fmt_val}; } # return an html string with buttons for switching between profile levels of detail sub get_level_buttons { my $mode_ref = shift; my $file = shift; my $level = shift; my $html = join ' • ', map { my $mode = $mode_ref->{$_}; if ($mode eq $level) { qq{$mode view}; } else { my $mode_file = $file; # replace the mode specifier in the output file name -- file-name-MODE.html $mode_file =~ s/(.*-).*?\.html/$1$mode.html/o; qq{$mode view}; } } keys %$mode_ref; return qq{« $html »}; } sub get_footer { my ($profile) = @_; my $version = $Devel::NYTProf::Core::VERSION; my $js = ''; if (@on_ready_js) { # XXX I've no idea why this workaround is needed (or works). # without it the file table on the index page isn't sortable @on_ready_js = reverse @on_ready_js; $js = sprintf q{ }, join("\n", '', @on_ready_js, ''); @on_ready_js = (); }; # spacing so links to #line near can put right line at top near the bottom of the report my $spacing = "
" x 10; return qq{ $js $spacing }; } # returns the generic header string. Here only to make the code more readable. sub get_html_header { my $title = shift || "Profile Index - NYTProf"; my $opts = shift || {}; $title = _escape_html($title); my $html = < EOD $html = "" if $opts->{not_xhtml}; $html .= < $title EOD $html .= qq{ \n} unless $opts->{skip_style}; if (my $css = $opts->{add_jit}) { $html .= qq{ \n}; $html .= qq{ \n}; } $html .= <<'EOD' unless $opts->{skip_jquery}; EOD $html .= $opts->{head_epilogue} if $opts->{head_epilogue}; $html .= < EOD return $html; } sub get_page_header { my %args = @_; my ($profile, $head1, $head2, $right1, $right2, $skip_link_to_index) = ( $args{profile}, $args{title}, $args{subtitle}, $args{title2}, $args{subtitle2}, $args{skip_link_to_index} ); $head2 ||= qq{
For ${ \($profile->{attribute}{application}) }}; $right1 ||= " "; $right2 ||= "Run on ${ \scalar localtime($profile->{attribute}{basetime}) }
Reported on " . localtime(time); my $back_link = q//; unless ($skip_link_to_index) { $back_link = qq{}; } my @body_attribs; push @body_attribs, qq{onload="$args{body_onload}"} if $args{body_onload}; my $body_attribs = join "; ", @body_attribs; return qq{
$back_link
$head1 $head2
$right1 $right2
\n}; } sub get_css { return <<'EOD'; /* Stylesheet for Devel::NYTProf::Reader HTML reports */ /* You may modify this file to alter the appearance of your coverage * reports. If you do, you should probably flag it read-only to prevent * future runs from overwriting it. */ /* Note: default values use the color-safe web palette. */ a { color: blue; } a:visited { color: #6d00E6; } a:hover { color: red; } body { font-family: sans-serif; margin: 0px; background-color: white; color:#222; } .body_content { margin: 8px; } .header { font-family: sans-serif; padding-left: 0.5em; padding-right: 0.5em; } .headerForeground { color: white; padding: 10px; padding-top: 50px; } .siteTitle { font-size: 2em; } .siteSubTitle { font-size: 1.2em; } .header_back { position: absolute; padding: 10px; } .header_back > a:link, .header_back > a:visited { color: white; text-decoration: none; font-size: 0.75em; } .jump_to_file { margin-top: 20px; } .footer, .footer > a:link, .footer > a:visited { color: #cccccc; } .footer { margin: 30px; } table { border-collapse: collapse; border-spacing: 0px; margin-top: 20px; } tr { text-align : center; vertical-align: top; } th,.h { background-color: #dddddd; border: solid 1px #666666; padding: 0em 0.4em 0em 0.4em; font-size:0.8em; } td { border: solid 1px #cccccc; padding: 0em 0.4em 0em 0.4em; } caption { background-color: #dddddd; text-align: left; white-space: pre; padding: 0.4em; } .table_footer { color: gray; } .table_footer > a:link, .table_footer > a:visited { color: gray; } .table_footer > a:hover { color: red; } .index { text-align: left; } .mode_btn_selected { font-style: italic; } /* subroutine dispatch table */ .sub_name { text-align: left; font-family: monospace; white-space: pre; color: gray; } /* source code */ th.left_indent_header { padding-left: 15px; text-align: left; } pre,.s { text-align: left; font-family: monospace; white-space: pre; } /* plain number */ .n { text-align: right } /* Classes for color-coding profiling information: * c0 : code not hit * c1 : coverage >= 75% * c2 : coverage >= 90% * c3 : path covered or coverage = 100% */ .c0, .c1, .c2, .c3 { text-align: right; } .c0 { background-color: #ffb3b3; } /* red */ .c1 { background-color: #ffd9b4; } /* orange */ .c2 { background-color: #ffffB4; } /* yellow */ .c3 { background-color: #B4ffB4; } /* green */ /* warnings */ .warn { background-color: #FFFFAA; border: 0; width: 96%; text-align: center; padding: 5px 0; } .warn_title { background-color: #FFFFAA; border: 0; color: red; width: 96%; font-size: 2em; text-align: center; padding: 5px 0; } /* summary of calls into and out of a sub */ .calls { display: block; color: gray; padding-top: 5px; padding-bottom: 5px; text-decoration: none; } .calls:hover { background-color: #e8e8e8; color: black; } .calls a { color: gray; text-decoration: none; } .calls:hover a { color: black; text-decoration: underline; } .calls:hover a:hover { color: red; } /* give a little headroom to the summary of calls into a sub */ .calls .calls_in { margin-top: 5px; } .vis_header { text-align:center; font-style: italic; padding-top: 5px; color: gray; } .flamegraph { margin: 20px 0px; } EOD } __END__ =head1 DESCRIPTION Devel::NYTProf is a powerful feature-rich Perl source code profiler. See L for details. C generates a set of html reports from a single data file generated by L. (If your process forks you'll probably have multiple files. See L and L.) The reports include dynamic runtime analysis wherein each line and each file is analyzed based on the performance of the other lines and files. As a result, you can quickly find the slowest module and the slowest line in a module. Slowness is measured in three ways: total calls, total time, and average time per call. Coloring is based on absolute deviations from the median. See L for more details. That might sound complicated, but in reality you can just run the command and enjoy your report! =head1 COMMAND-LINE OPTIONS =over 4 =item -f, --file Specifies the location of the file generated by L. Default: ./nytprof.out =item -o, --out The directory in which to place the generated report files. Default: ./nytprof/ =item -d, --delete Purge any existing contents of the report output directory. =item -l, --lib Add a path to the beginning of @INC to help nytprofhtml find the source files used by the code. Should not be needed in practice. =item --open Make your web browser visit the report after it has been generated. If this doesn't work well for you, try installing the L module. =item -m, --minimal Don't generate graphviz .dot files or block/sub-level reports. =item --no-flame Disable generation of the flamegraph on the index page. Also disables calculation of distinct call stacks that are used to produce the flamegraph. =item -h, --help Print the help message. =back =head1 SAMPLE OUTPUT You can see a complete report for a large application at L The report was generated by profiling L 1.121 checking its own source code using perl v5.18.2. =head1 DIAGNOSTICS =head2 "Unable to open '... (autosplit into ...)'" The profiled application executed code in a module that used L to load the code from a separate .al file. NYTProf automatically recognises this situation and tries to determine the 'parent' module file so it can associate the profile data with it. In order to do that the parent module file must already be 'known' to NYTProf, typically by already having some code profiled. You're only likely to see this warning if you're using the C option to start profiling after compile-time. The effect is that times spent in autoloaded subs won't be associated with the parent module file and you won't get annotated reports for them. You can avoid this by using the default C option, or by ensuring you execute some non-autoloaded code in the parent module, while the profiler is running, before an autoloaded sub is called. =head2 Background Subroutine-level profilers: Devel::DProf | 1995-10-31 | ILYAZ Devel::AutoProfiler | 2002-04-07 | GSLONDON Devel::Profiler | 2002-05-20 | SAMTREGAR Devel::Profile | 2003-04-13 | JAW Devel::DProfLB | 2006-05-11 | JAW Devel::WxProf | 2008-04-14 | MKUTTER Statement-level profilers: Devel::SmallProf | 1997-07-30 | ASHTED Devel::FastProf | 2005-09-20 | SALVA Devel::NYTProf | 2008-03-04 | AKAPLAN Devel::Profit | 2008-05-19 | LBROCARD Devel::NYTProf is a (now distant) fork of Devel::FastProf, which was itself an evolution of Devel::SmallProf. Adam Kaplan took Devel::FastProf and added html report generation (based on Devel::Cover) and a test suite - a tricky thing to do for a profiler. Meanwhile Tim Bunce had been extending Devel::FastProf to add novel per-sub and per-block timing, plus subroutine caller tracking. When Devel::NYTProf was released Tim switched to working on Devel::NYTProf because the html report would be a good way to show the extra profile data, and the test suite made development much easier and safer. Then he went a little crazy and added a slew of new features, in addition to per-sub and per-block timing and subroutine caller tracking. These included the 'opcode interception' method of profiling, ultra-fast and robust inclusive subroutine timing, doubling performance, plus major changes to html reporting to display all the extra profile call and timing data in richly annotated and cross-linked reports. Steve Peters came on board along the way with patches for portability and to keep NYTProf working with the latest development Perl versions. Adam's work is sponsored by The New York Times Co. L. Tim's work was partly sponsored by Shopzilla. L. =head1 SEE ALSO Mailing list and discussion at L Public Github Repository and hacking instructions at L L, L, L =head1 AUTHOR B, C<< >>. B, L. B, C<< >>. =head1 COPYRIGHT AND LICENSE This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself, either Perl version 5.8.8 or, at your option, any later version of Perl 5 you may have available. =cut # vim:ts=8:sw=4:expandtab