memnodes.pl

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