#!/usr/bin/env perl
-# Read the raw memory data from Devel::Memory and process the tree
-# (as a stack, propagating data such as totals, up the tree).
-# Output completed nodes in the request formats.
+=head1 NAME
+
+sizeme_store.pl - process and store the raw data stream from Devel::SizeMe
+
+=head1 SYNOPSIS
+
+ sizeme_store.pl [--text] [--dot=sizeme.dot] [--db=sizeme.db]
+
+Typically used with Devel::SizeMe via the C<SIZEME> env var:
+
+ export SIZEME='|./sizeme_store.pl --text'
+ export SIZEME='|./sizeme_store.pl --dot=sizeme.dot'
+ export SIZEME='|./sizeme_store.pl --db=sizeme.db'
+
+=head1 DESCRIPTION
+
+Reads the raw memory data from Devel::SizeMe and processes the tree
+via a stack, propagating data such as totals, up the tree nodes
+as the data streams through. Output completed nodes in the request formats.
+
+The --text output is similar to the textual representation output by the module
+when the SIZEME env var is set to an empty string.
+
+The --dot output is suitable for feeding to Graphviz. (On OSX the Graphviz
+application will be started automatically.)
+
+The --db output is a SQLite database. The db schema is very subject to change.
+This output is destined to be the primary one. The other output types will
+probably become separate programs that read the db.
+
+=head1 TODO
+
+Current implementation is all very alpha and rather hackish.
+
+Refactor to separate the core code into a module.
+
+Move the output formats into separate modules, which should probably read from
+the db so the db becomes the canonical source of data.
+
+Import constants from XS.
+
+=cut
+
# Needs to be generalized to support pluggable output formats.
+# Actually it needs to be split so sizeme_store.pl only does the store
+# and another program drives the output with plugins.
# Making nodes into (lightweight fast) objects would be smart.
# Tests would be even smarter!
#
if ($x->{name} eq 'AVelem' and $parent->{name} eq 'SV(PVAV)') {
my $index = $x->{attr}{+NPattr_NOTE}{i};
- Dwarn $x->{attr};
- Dwarn $index;
+ #Dwarn $x->{attr};
+ #Dwarn $index;
# If node is an AVelem of a CvPADLIST propagate pad name to AVelem
if (@stack >= 4 and (my $cvpl = $stack[-4])->{name} eq 'CvPADLIST') {
my $padnames = $cvpl->{_cached}{padnames} ||= do {
$parent->{kids_size} += $self_size + $x->{kids_size};
push @{$parent->{child_id}}, $x->{id};
}
+ else {
+ $x->{kids_node_count} ||= 0;
+ }
# output
# ...
printf $dot_fh qq{n%d [ %s ];\n}, $x->{id}, join(",", @node_attr);
}
else { # NPtype_LINK
- my @kids = @{$x->{child_id}};
+ my @kids = @{$x->{child_id}||[]};
die "panic: NPtype_LINK has more than one child: @kids"
if @kids > 1;
for my $child_id (@kids) { # wouldn't work right, eg id= attr
#die Dwarn $x;
my @link_attr = ("id=$x->{id}");
(my $link_name = $x->{name}) =~ s/->$//;
+ $link_name .= " #$x->{id}" if $opt_showid;
push @link_attr, (sprintf "label=%s", $dotnode->($link_name));
printf $dot_fh qq{n%d -> n%d [%s];\n},
$x->{parent_id}, $child_id, join(",", @link_attr);
}
my $indent = ": ";
-my $pending_pre_attr = {};
while (<>) {
- warn "== $_" if $opt_debug;
+ warn "\t\t\t\t== $_" if $opt_debug;
chomp;
my ($type, $id, $val, $name, $extra) = split / /, $_, 5;
die "Depth out of sync\n" if $val != @stack;
my $node = enter_node({
id => $id, type => $type, name => $name, extra => $extra,
- attr => { %$pending_pre_attr },
- leaves => {}, depth => $val, self_size=>0, kids_size=>0
+ attr => { }, leaves => {}, depth => $val, self_size=>0, kids_size=>0
});
- %$pending_pre_attr = ();
$stack[$val] = $node;
$seqn2node{$id} = $node;
}
my $node = $seqn2node{$id} || die;
my $attr = $node->{attr} || die;
- # attributes to queue up and apply to the next node
- if (NPattr_PRE_ATTR == $type) {
- $pending_pre_attr->{$name} = $val;
- }
# attributes where the string is a key (or always empty and the type is the key)
- elsif ($type == NPattr_NAME or $type == NPattr_NOTE) {
+ if ($type == NPattr_NAME or $type == NPattr_NOTE) {
printf "%s~%s(%s) %d [t%d]\n", $indent x ($node->{depth}+1), $attr_type_name[$type], $name, $val, $type
if $opt_text;
warn "Node $id already has attribute $type:$name (value $attr->{$type}{$name})\n"
if exists $attr->{$type}{$name};
$attr->{$type}{$name} = $val;
- Dwarn $attr;
+ #Dwarn $attr;
$node->{title} = $name if $type == NPattr_NAME and !$val; # XXX hack
}
# attributes where the number is a key (or always zero)
my $top = $stack[0]; # grab top node before we pop all the nodes
leave_node(pop @stack) while @stack;
+ # if nothing output (ie size(undef))
+ $top ||= { self_size=>0, kids_size=>0, kids_node_count=>0 };
+
my $top_size = $top->{self_size}+$top->{kids_size};
- printf "Stored %d nodes (${.}n) sizing %s (%d) in %.2fs\n",
- $top->{kids_node_count}, fmt_size($top_size), $top_size,
- $val;
+ printf "Stored %d nodes totalling %s [lines=%d size=%d write=%.2fs]\n",
+ 1+$top->{kids_node_count}, fmt_size($top_size),
+ $., $top_size, $val;
# the duration here ($val) is from Devel::SizeMe perspective
# ie doesn't include time to read file/pipe and commit to database.
}
die "panic: seqn2node should be empty ". Dumper(\%seqn2node)
if %seqn2node;
- %$pending_pre_attr = ();
if ($dot_fh) {
print $dot_fh "}\n";
projects / p5sagit/Devel-Size.git / blobdiff