Revision: 853 Author: tim.bunce Date: Thu Aug 6 17:22:16 2009 Log: Finally got GraphViz file generation working in a reasonable way. (Lots of scope for polish, but at least it's usable and useful now.) Added entry for fake main::RUNTIME sub.
http://code.google.com/p/perl-devel-nytprof/source/detail?r=853 Modified: /trunk/Changes /trunk/NYTProf.xs /trunk/bin/nytprofhtml ======================================= --- /trunk/Changes Wed Aug 5 15:35:34 2009 +++ /trunk/Changes Thu Aug 6 17:22:16 2009 @@ -10,7 +10,6 @@ XXX subroutine profiler docs need update XXX doc findcaller option XXX note here and doc goto behaviour -XXX set prereq version of Test::More Note: The file format has changed. Old files can't be read. @@ -45,6 +44,12 @@ Added interactive treemap view of package and subroutine times. Left-click to zoom in (drill-down) one level, right-click to zoom out. + Added generation of GraphViz dot language files to visualize + the call graph. A top-level link on the index page provides an + inter-package graph, and per-source-file links provide a graph + of sub calls in to, out of, and between the subs in the file. + See http://en.wikipedia.org/wiki/Graphviz + Added columns to the main source code reports to show a count of sub calls and time spent in those calls. ======================================= --- /trunk/NYTProf.xs Thu Aug 6 16:33:35 2009 +++ /trunk/NYTProf.xs Thu Aug 6 17:22:16 2009 @@ -3148,6 +3148,15 @@ logwarn("Associating package of %s with %.*s (fid %d)\n", sub_name, (int)filename_len, filename, fid ); } + + if (1) { /* Create a fake entry for main::RUNTIME subroutine */ + char *runtime = "main::RUNTIME"; + SV *sv; + /* get name of file that contained first profiled sub in 'main::' */ + SV *pkg_filename_sv = sub_pkg_filename_sv(aTHX_ runtime); + sv = *hv_fetch(hv, runtime, strlen(runtime), 1); + sv_setpvf(sv, "%s:%d-%d", SvPV_nolen(pkg_filename_sv), 1, 1); + } /* Iterate over PL_DBsub writing out fid and source line range of subs. * If filename is missing (i.e., because it's an xsub so has no source file) ======================================= --- /trunk/bin/nytprofhtml Wed Aug 5 15:35:34 2009 +++ /trunk/bin/nytprofhtml Thu Aug 6 17:22:16 2009 @@ -96,7 +96,7 @@ print "Generating report...\n"; my $reporter = new Devel::NYTProf::Reader($opt{file}); -# place to store this crap +# place to store this $reporter->output_dir($opt{out}); # set formatting for html @@ -284,9 +284,26 @@ my ($profile, $filestr) = @_; my $sub_table = subroutine_table($profile, $filestr, undef, undef); + + my $dot_file = html_safe_filename($filestr) . ".dot"; + 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 + my $sub_filter = sub { + my ($si, $calledby) = @_; + return 1 if not defined $calledby; + my $include = ($subs_in_file->{$si->subname} + || $subs_in_file->{$calledby}); + return $include; + }; + output_subs_callgraph_dot_file($reporter, $dot_file, $sub_filter, 0); + } return qq{ $sub_table + Call graph for these subroutines as a <a href="http://en.wikipedia.org/wiki/Graphviz";>Graphviz</a> <a href="$dot_file">dot language file</a>. <table border="1" cellpadding="0"> <thead> <tr><th>Line</th> @@ -874,17 +891,16 @@ # gather link info my %sub2called_by; - my %pkg_subs; for my $subname (keys %$subinfos) { my $si = $subinfos->{$subname}; - - next if $sub_filter and $sub_filter->($si, undef); + 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 - if $si->calls; + $subname, $si->calls; next; } @@ -899,9 +915,14 @@ } $sub2called_by{$subname} = $called_by_subnames; - $pkg_subs{$si->package}{$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 --~--~---------~--~----~------------~-------~--~----~ 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] -~----------~----~----~----~------~----~------~--~---
