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         leaves_json text
  37     )
  38 });
  39 my $node_ins_sth = $dbh->prepare(q{
  40     INSERT INTO node VALUES (?,?,?,?,  ?,?,?,?,?,?)
  41 });
  42
  43 my @stack;
  44 my %seqn2node;
  45
  46 sub enter_node {
  47     my $x = shift;
  48     if ($opt_json) {
  49         print "    " x $x->{depth};
  50         print qq({ "id": "$x->{id}", "name": "$x->{name}", "depth":$x->{depth}, "children":[ \n);
  51     }
  52     return;
  53 }
  54
  55 sub leave_node {
  56     my $x = shift;
  57     delete $seqn2node{$x->{id}};
  58     my $self_size = 0; $self_size += $_  for values %{$x->{leaves}};
  59     $x->{self_size} = $self_size;
  60     if (my $parent = $stack[-1]) {
  61         # link to parent
  62         $x->{parent_id} = $parent->{id};
  63         # accumulate into parent
  64         $parent->{kids_node_count} += 1 + ($x->{kids_node_count}||0);
  65         $parent->{kids_size} += $self_size + $x->{kids_size};
  66         push @{$parent->{child_id}}, $x->{id};
  67     }
  68     # output
  69     # ...
  70     if ($opt_json) {
  71         print "    " x $x->{depth};
  72         my $size = $self_size + $x->{kids_size};
  73         print qq(], "data":{ "\$area": $size } },\n);
  74     }
  75     if ($dbh) {
  76         my $attr_json = $j->encode($x->{attr});
  77         my $leaves_json = $j->encode($x->{leaves});
  78         $node_ins_sth->execute(
  79             $x->{id}, $x->{name}, $x->{depth}, $x->{parent_id},
  80             $x->{self_size}, $x->{kids_size}, $x->{kids_node_count},
  81             $x->{child_id} ? join(",", @{$x->{child_id}}) : undef,
  82             $attr_json, $leaves_json,
  83         );
  84         # XXX attribs
  85     }
  86     return;
  87 }
  88
  89 print "memnodes = [" if $opt_json;
  90
  91 while (<>) {
  92     chomp;
  93     my ($type, $id, $val, $name, $extra) = split / /, $_, 5;
  94     if ($type eq "N") {     # Node ($val is depth)
  95         while ($val < @stack) {
  96             leave_node(my $x = pop @stack);
  97             warn "N $id d$val ends $x->{id} d$x->{depth}: size $x->{self_size}+$x->{kids_size}\n";
  98         }
  99         die 1 if $stack[$val];
 100         my $node = $stack[$val] = { id => $id, name => $name, extra => $extra, attr => [], leaves => {}, depth => $val, self_size=>0, kids_size=>0 };
 101         enter_node($node);
 102         $seqn2node{$id} = $node;
 103     }
 104     elsif ($type eq "L") {  # Leaf name and memory size
 105         my $node = $seqn2node{$id} || die;
 106         $node->{leaves}{$name} += $val;
 107     }
 108     elsif ($type eq "A") {  # Attribute name and value
 109         my $node = $seqn2node{$id} || die;
 110         push @{ $node->{attr} }, $name, $val; # pairs
 111     }
 112     else {
 113         warn "Invalid type '$type' on line $. ($_)";
 114     }
 115     $dbh->commit if $dbh and $id % 10_000 == 0;
 116 }
 117
 118 my $x;
 119 while (@stack > 1) {
 120     leave_node($x = pop @stack) while @stack;
 121     warn "EOF ends $x->{id} d$x->{depth}: size $x->{self_size}+$x->{kids_size}\n";
 122 }
 123 print " ];\n" if $opt_json;
 124
 125 $dbh->commit if $dbh;
 126
 127 use Data::Dumper;
 128 warn Dumper(\$x);
 129 warn Dumper(\%seqn2node);
 130
 131 =for
 132 SV(PVAV) fill=1/1       [#1 @0]
 133 :   +64 sv =64
 134 :   +16 av_max =80
 135 :   AVelem->        [#2 @1]
 136 :   :   SV(RV)      [#3 @2]
 137 :   :   :   +24 sv =104
 138 :   :   :   RV->        [#4 @3]
 139 :   :   :   :   SV(PVAV) fill=-1/-1     [#5 @4]
 140 :   :   :   :   :   +64 sv =168
 141 :   AVelem->        [#6 @1]
 142 :   :   SV(IV)      [#7 @2]
 143 :   :   :   +24 sv =192
 144 192 at -e line 1.
 145 =cut
 146 __DATA__
 147 N 1 0 SV(PVAV) fill=1/1
 148 L 1 64 sv
 149 L 1 16 av_max
 150 N 2 1 AVelem->
 151 N 3 2 SV(RV)
 152 L 3 24 sv
 153 N 4 3 RV->
 154 N 5 4 SV(PVAV) fill=-1/-1
 155 L 5 64 sv
 156 N 6 1 AVelem->
 157 N 7 2 SV(IV)
 158 L 7 24 sv