Author: tim.bunce
Date: Fri Nov 28 13:05:09 2008
New Revision: 630
Modified:
trunk/lib/Devel/NYTProf/Data.pm
Log:
Added $profile->package_subinfo_map method to return info on all the subs
in a
package (optionally merged).
Added $profile->packages_at_depth_subinfo method that calls
package_subinfo_map
and restructures the data into a summary per rolled-up package name at
various depths.
Modified: trunk/lib/Devel/NYTProf/Data.pm
==============================================================================
--- trunk/lib/Devel/NYTProf/Data.pm (original)
+++ trunk/lib/Devel/NYTProf/Data.pm Fri Nov 28 13:05:09 2008
@@ -166,6 +166,79 @@
return { %{ shift->{sub_subinfo} } }; # shallow copy
}
+# default:
+# { pkgname => [ subinfo1, subinfo2, ... ], ... }
+# merged:
+# { pkgname => [ single_merged_subinfo ], ... }
+sub package_subinfo_map {
+ my $self = shift;
+ my ($merged) = @_;
+
+ my $all_subs = $self->subname_subinfo_map;
+ my %pkg;
+ while ( my ($name, $subinfo) = each %$all_subs ) {
+ $name =~ s/^(.*::).*/$1/; # XXX $subinfo->package
+ push @{ $pkg{$name} }, $subinfo;
+ }
+ if ($merged) {
+ while ( my ($pkg_name, $subinfos) = each %pkg ) {
+ my $subinfo = shift(@$subinfos)->clone;
+ $subinfo->merge_in($_) for @$subinfos;
+ # replace the many with the one
+ @$subinfos = ($subinfo);
+ }
+ }
+ return \%pkg;
+}
+
+# [
+# undef, # depth 0
+# { # depth 1
+# "main::" => [ [ subinfo1, subinfo2 ] ], # 2 subs in 1 pkg
+# "Foo::" => [ [ subinfo3 ], [ subinfo4 ] ] # 2 subs in 2 pkg
+# }
+# { # depth 2
+# "Foo::Bar::" => [ [ subinfo3 ] ] # 1 sub in 1 pkg
+# "Foo::Baz::" => [ [ subinfo4 ] ] # 1 sub in 1 pkg
+# }
+# ]
+sub packages_at_depth_subinfo {
+ my $self = shift;
+ my ($opts) = @_;
+
+ my $merged = $opts->{merge_subinfos};
+ my $all_pkgs = $self->package_subinfo_map($merged) || {};
+
+ my @packages_at_depth = ({});
+ while ( my ($fullpkgname, $subinfos) = each %$all_pkgs ) {
+
+ $subinfos = [ grep { $_->calls } @$subinfos ]
+ if not $opts->{include_unused_subs};
+
+ next unless @$subinfos;
+
+ my @parts = split /::/, $fullpkgname; # drops empty trailing part
+
+ # accumulate @$subinfos for the full package name
+ # and also for each succesive truncation of the package name
+ for (my $depth; $depth = @parts; pop @parts) {
+ my $pkgname = join('::', @parts, '');
+
+ my $store = ($merged) ? $subinfos->[0] : $subinfos;
+
+ # { "Foo::" => [ [sub1,sub2], [sub3,sub4] ] } # subs from 2
packages
+ my $pkgdepthinfo = $packages_at_depth[$depth] ||= {};
+ push @{ $pkgdepthinfo->{$pkgname} }, $store;
+
+ last if not $opts->{rollup_packages};
+ }
+ }
+ # fill in any undef holes at depths with no subs
+ $_ ||= {} for @packages_at_depth;
+
+ return [EMAIL PROTECTED];
+}
+
sub all_fileinfos {
my @all = @{shift->{fid_fileinfo}};
shift @all; # drop fid 0
--~--~---------~--~----~------------~-------~--~----~
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]
-~----------~----~----~----~------~----~------~--~---
