Revision: 844 Author: tim.bunce Date: Fri Jul 24 23:53:40 2009 Log: Add clusters (to groups subs by packages) to the graphviz dot file.
http://code.google.com/p/perl-devel-nytprof/source/detail?r=844 Modified: /trunk/bin/nytprofhtml ======================================= --- /trunk/bin/nytprofhtml Fri Jul 24 15:36:26 2009 +++ /trunk/bin/nytprofhtml Fri Jul 24 23:53:40 2009 @@ -14,7 +14,7 @@ use Carp; use Getopt::Long; -use List::Util qw(sum max shuffle); +use List::Util qw(sum max); use File::Copy; use JSON::Any; @@ -558,7 +558,7 @@ } print OUT q{<br/>You can view subroutines in a treemap of <a href="subs-treemap-excl.html">exclusive time</a>, grouped by package.<br/>}; - print OUT q{<br/>The subroutine call graph available as a Graphviz <a href="subs-callgraph.dot">dot file</a>.<br/>}; + print OUT q{<br/>The subroutine call graph is available as a <a href="http://en.wikipedia.org/wiki/Graphviz";>Graphviz</a> <a href="subs-callgraph.dot">dot file</a>.<br/>}; print OUT file_table($profile, $stats, 1); @@ -866,6 +866,7 @@ # output nodes and gather link info my %sub2called_by; + my %pkg_subs; for my $subname (keys %$subinfos) { my $si = $subinfos->{$subname}; @@ -876,12 +877,26 @@ if $si->calls; next; } + + $sub2called_by{$subname} = $called_by_subnames; + $pkg_subs{$si->package}{$subname} = $called_by_subnames; + } + + while ( my ($pkg, $pkg_subs) = each %pkg_subs) { + (my $pkgmangled = $pkg) =~ s/\W+/_/g; # node_stmt: node_id [ attr_list ] - printf OUT qq{%s;\n}, $dotnode->($subname); - - $sub2called_by{$subname} = $called_by_subnames; - } + printf OUT "subgraph cluster_%s {\n", $pkgmangled; # } + printf OUT "\tlabel=%s\n", $dotnode->($pkg); + + for my $subname (keys %$pkg_subs) { + # node_stmt: node_id [ attr_list ] + printf OUT qq{\tnode %s;\n}, $dotnode->($subname); + } + # { - just to balance the brace below + printf OUT "}\n"; + } + #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] -~----------~----~----~----~------~----~------~--~---
