12 'json!' => \my $opt_json,
13 'db=s' => \my $opt_db,
16 my $dbh = DBI->connect("dbi:SQLite:dbname=$opt_db","","", {
17 RaiseError => 1, PrintError => 0, AutoCommit => 0
19 $dbh->do("PRAGMA synchronous = OFF");
20 $dbh->do("DROP TABLE IF EXISTS node");
23 id integer primary key,
30 kids_node_count integer,
34 my $node_ins_sth = $dbh->prepare(q{
35 INSERT INTO node VALUES (?,?,?,?, ?,?,?,?)
44 print " " x $x->{depth};
45 print qq({ "id": "$x->{id}", "name": "$x->{name}", "depth":$x->{depth}, "children":[ \n);
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]) {
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};
66 print " " x $x->{depth};
67 my $size = $self_size + $x->{kids_size};
68 print qq(], "data":{ "\$area": $size } },\n);
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
81 print "memnodes = [" if $opt_json;
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";
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 };
94 $seqn2node{$id} = $node;
96 elsif ($type eq "L") { # Leaf name and memory size
97 my $node = $seqn2node{$id} || die;
98 $node->{leaves}{$name} += $val;
100 elsif ($type eq "A") { # Attribute name and value
101 my $node = $seqn2node{$id} || die;
102 push @{ $node->{attr} }, $name, $val; # pairs
105 warn "Invalid type '$type' on line $. ($_)";
107 $dbh->commit if $dbh and $id % 10_000 == 0;
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";
115 print " ];\n" if $opt_json;
117 $dbh->commit if $dbh;
121 warn Dumper(\%seqn2node);
124 SV(PVAV) fill=1/1 [#1 @0]
131 : : : : SV(PVAV) fill=-1/-1 [#5 @4]
132 : : : : : +64 sv =168
139 N 1 0 SV(PVAV) fill=1/1
146 N 5 4 SV(PVAV) fill=-1/-1