memnodes.pl

   1 #!/bin/env perl
   2
   3 use strict;
   4 use warnings;
   5
   6 use DBI;
   7 use DBD::SQLite;
   8 use JSON::XS;
   9
  10 use Getopt::Long;
  11
  12 GetOptions(
  13     'json!' => \my $opt_json,
  14     'db=s'  => \my $opt_db,
  15 ) or exit 1;
  16
  17 my $j = JSON::XS->new->ascii->pretty(0);
  18
  19 my $dbh = DBI->connect("dbi:SQLite:dbname=$opt_db","","", {
  20     RaiseError => 1, PrintError => 0, AutoCommit => 0
  21 });
  22 $dbh->do("PRAGMA synchronous = OFF");
  23 $dbh->do("DROP TABLE IF EXISTS node");
  24 $dbh->do(q{
  25     CREATE TABLE node (
  26         id integer primary key,
  27         name text,
  28         depth integer,
  29         parent_id integer,
  30
  31         self_size integer,
  32         kids_size integer,
  33         kids_node_count integer,
  34         child_ids text,
  35         attr_json text
  36     )
  37 });
  38 my $node_ins_sth = $dbh->prepare(q{
  39     INSERT INTO node VALUES (?,?,?,?,  ?,?,?,?,?)
  40 });
  41
  42 my @stack;
  43 my %seqn2node;
  44
  45 sub enter_node {
  46     my $x = shift;
  47     if ($opt_json) {
  48         print "    " x $x->{depth};
  49         print qq({ "id": "$x->{id}", "name": "$x->{name}", "depth":$x->{depth}, "children":[ \n);
  50     }
  51     return;
  52 }
  53
  54 sub leave_node {
  55     my $x = shift;
  56     delete $seqn2node{$x->{id}};
  57     my $self_size = 0; $self_size += $_  for values %{$x->{leaves}};
  58     $x->{self_size} = $self_size;
  59     if (my $parent = $stack[-1]) {
  60         # link to parent
  61         $x->{parent_id} = $parent->{id};
  62         # accumulate into parent
  63         $parent->{kids_node_count} += 1 + ($x->{kids_node_count}||0);
  64         $parent->{kids_size} += $self_size + $x->{kids_size};
  65         push @{$parent->{child_id}}, $x->{id};
  66     }
  67     # output
  68     # ...
  69     if ($opt_json) {
  70         print "    " x $x->{depth};
  71         my $size = $self_size + $x->{kids_size};
  72         print qq(], "data":{ "\$area": $size } },\n);
  73     }
  74     if ($dbh) {
  75         my $attr_json = $j->encode($x->{attr});
  76         $node_ins_sth->execute(
  77             $x->{id}, $x->{name}, $x->{depth}, $x->{parent_id},
  78             $x->{self_size}, $x->{kids_size}, $x->{kids_node_count},
  79             $x->{child_id} ? join(",", @{$x->{child_id}}) : undef,
  80             $attr_json,
  81         );
  82         # XXX attribs
  83     }
  84     return;
  85 }
  86
  87 print "memnodes = [" if $opt_json;
  88
  89 while (<>) {
  90     chomp;
  91     my ($type, $id, $val, $name, $extra) = split / /, $_, 5;
  92     if ($type eq "N") {     # Node ($val is depth)
  93         while ($val < @stack) {
  94             leave_node(my $x = pop @stack);
  95             warn "N $id d$val ends $x->{id} d$x->{depth}: size $x->{self_size}+$x->{kids_size}\n";
  96         }
  97         die 1 if $stack[$val];
  98         my $node = $stack[$val] = { id => $id, name => $name, extra => $extra, attr => [], leaves => {}, depth => $val, self_size=>0, kids_size=>0 };
  99         enter_node($node);
 100         $seqn2node{$id} = $node;
 101     }
 102     elsif ($type eq "L") {  # Leaf name and memory size
 103         my $node = $seqn2node{$id} || die;
 104         $node->{leaves}{$name} += $val;
 105     }
 106     elsif ($type eq "A") {  # Attribute name and value
 107         my $node = $seqn2node{$id} || die;
 108         push @{ $node->{attr} }, $name, $val; # pairs
 109     }
 110     else {
 111         warn "Invalid type '$type' on line $. ($_)";
 112     }
 113     $dbh->commit if $dbh and $id % 10_000 == 0;
 114 }
 115
 116 my $x;
 117 while (@stack > 1) {
 118     leave_node($x = pop @stack) while @stack;
 119     warn "EOF ends $x->{id} d$x->{depth}: size $x->{self_size}+$x->{kids_size}\n";
 120 }
 121 print " ];\n" if $opt_json;
 122
 123 $dbh->commit if $dbh;
 124
 125 use Data::Dumper;
 126 warn Dumper(\$x);
 127 warn Dumper(\%seqn2node);
 128
 129 =for
 130 SV(PVAV) fill=1/1       [#1 @0]
 131 :   +64 sv =64
 132 :   +16 av_max =80
 133 :   AVelem->        [#2 @1]
 134 :   :   SV(RV)      [#3 @2]
 135 :   :   :   +24 sv =104
 136 :   :   :   RV->        [#4 @3]
 137 :   :   :   :   SV(PVAV) fill=-1/-1     [#5 @4]
 138 :   :   :   :   :   +64 sv =168
 139 :   AVelem->        [#6 @1]
 140 :   :   SV(IV)      [#7 @2]
 141 :   :   :   +24 sv =192
 142 192 at -e line 1.
 143 =cut
 144 __DATA__
 145 N 1 0 SV(PVAV) fill=1/1
 146 L 1 64 sv
 147 L 1 16 av_max
 148 N 2 1 AVelem->
 149 N 3 2 SV(RV)
 150 L 3 24 sv
 151 N 4 3 RV->
 152 N 5 4 SV(PVAV) fill=-1/-1
 153 L 5 64 sv
 154 N 6 1 AVelem->
 155 N 7 2 SV(IV)
 156 L 7 24 sv