From: Tim Bunce <Tim.Bunce@pobox.com>
Date: Sat, 22 Sep 2012 17:35:59 +0000 (+0100)
Subject: Polish up dot output, incl adding sizes
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=0741448c0ba68ec97c784d847f7e880f82be2c98;p=p5sagit%2FDevel-Size.git

Polish up dot output, incl adding sizes
---

diff --git a/memnodes.pl b/memnodes.pl
index 4af0c34..3f9a956 100644
--- a/memnodes.pl
+++ b/memnodes.pl
@@ -54,7 +54,6 @@ use HTML::Entities qw(encode_entities);;
 my $dotnode = sub {
     my $name = encode_entities(shift);
     $name =~ s/"/\\"/g;
-    #$name =~ s/</&lt;/g;
     return '"'.$name.'"';
 };
 
@@ -65,6 +64,14 @@ if ($opt_dot) {
     print "graph [overlap=false]\n"; # target="???", URL="???"
 }
 
+sub fmt_size {
+    my $size = shift;
+    my $kb = $size / 1024;
+    return $size if $kb < 5;
+    return sprintf "%.1fKb", $kb if $kb < 1000;
+    return sprintf "%.1fMb", $kb/1024;
+}
+
 
 sub enter_node {
     my $x = shift;
@@ -104,13 +111,28 @@ sub leave_node {
     }
     if ($opt_dot) {
         printf "// n%d parent=%s(type=%s)\n", $x->{id},
-            $parent ? $parent->{id} : "",
-            $parent ? $parent->{type} : "";
+                $parent ? $parent->{id} : "",
+                $parent ? $parent->{type} : ""
+            if 0;
         if ($x->{type} != 2) {
-            my @node_attr = (sprintf "label=%s", $dotnode->($x->{name}));
+            my $name = $x->{title} ? "\"$x->{title}\" $x->{name}" : $x->{name};
+
+            if ($x->{kids_size}) {
+                $name .= sprintf " %s+%s=%s", fmt_size($x->{self_size}), fmt_size($x->{kids_size}), fmt_size($x->{self_size}+$x->{kids_size});
+            }
+            else {
+                $name .= sprintf " +%s", fmt_size($x->{self_size});
+            }
+
+            my @node_attr = (
+                sprintf("label=%s", $dotnode->($name)),
+                "id=$x->{id}",
+            );
+            my @link_attr;
+            #if ($x->{name} eq 'hek') { push @node_attr, "shape=point"; push @node_attr, "labelfontsize=6"; }
             if ($parent) { # probably a link
-                my @link_attr;
                 my $parent_id = $parent->{id};
+                my @link_attr = ("id=$parent_id");
                 if ($parent->{type} == 2) { # link
                     (my $link_name = $parent->{name}) =~ s/->$//;
                     push @link_attr, (sprintf "label=%s", $dotnode->($link_name));
diff --git a/notes.txt b/notes.txt
new file mode 100644
index 0000000..aec0de4
--- /dev/null
+++ b/notes.txt
@@ -0,0 +1,13 @@
+
+make && rm -f /cores/* && M=1 perl -Mblib -Mstrict -MDevel::Size=:all -MCarp -e 'warn perl_size()' >x.memnodes
+585475
+905979 - with recursion change
+
+perl memnodes.pl --dot x.memnodes > x.dot && open -a Graphviz x.dot && cat x.dot
+
+./memnodes.pl --db x.db x.memnodes
+
+./MemView.pl daemon
+
+open http://127.0.0.1:3000
+