static/MemView.pl

   1 #!/usr/bin/env perl
   2
   3 use strict;
   4 use warnings;
   5
   6 use JSON::XS;
   7 use Mojolicious::Lite;
   8 use Getopt::Long;
   9
  10 GetOptions(
  11     'db=s' => \(my $opt_db = '../x.db'),
  12 ) or exit 1;
  13
  14 use ORLite {
  15     file => '../x.db',
  16     package => "MemView",
  17     #user_version => 1,
  18     readonly => 1,
  19     #unicode => 1,
  20 };
  21
  22 my $j = JSON::XS->new;
  23
  24 # Documentation browser under "/perldoc"
  25 plugin 'PODRenderer';
  26
  27 get '/' => sub {
  28     my $self = shift;
  29     $self->render('index');
  30 };
  31
  32 get '/jit_tree/:id/:depth' => sub {
  33     my $self = shift;
  34     my $logarea = $self->param('logarea');
  35
  36     my $id = $self->stash('id');
  37     my $depth = $self->stash('depth');
  38     warn "jit_tree $id $depth";
  39     my $node_tree = _fetch_node_tree($id, $depth);
  40     my $jit_tree = _transform_node_tree($node_tree, sub {
  41         my ($node) = @_;
  42         my $children = delete $node->{children}; # XXX edits the src tree
  43         my $area = $node->{self_size}+$node->{kids_size};
  44         $node->{'$area'} = ($logarea) ? log($area) : $area;
  45         my $jit_node = {
  46             id   => $node->{id},
  47             name => $node->{title} || $node->{name},
  48             data => $node,
  49         };
  50         $jit_node->{children} = $children if $children;
  51         return $jit_node;
  52     });
  53 if(1){
  54     use Devel::Dwarn;
  55     use Data::Dump qw(pp);
  56     local $jit_tree->{children};
  57     pp($jit_tree);
  58 }
  59     $self->render_json($jit_tree);
  60 };
  61
  62 sub _fetch_node_tree {
  63     my ($id, $depth) = @_;
  64     my $node = MemView->selectrow_hashref("select * from node where id = ?", undef, $id)
  65         or die "Node '$id' not found";
  66     $node->{leaves} = $j->decode(delete $node->{leaves_json});
  67     $node->{attr}   = $j->decode(delete $node->{attr_json});
  68
  69     if ($node->{child_ids}) {
  70         my @child_ids = split /,/, $node->{child_ids};
  71         my $children;
  72         if (@child_ids == 1) {
  73             my $child = _fetch_node_tree($child_ids[0], $depth); # same depth
  74             # merge node into child
  75             # XXX id, depth, parent_id
  76             warn "Merged $node->{name} #$node->{id} with only child $child->{name} #$child->{id}\n";
  77             $child->{name} = "$node->{name} + $child->{name}";
  78             $child->{$_} += $node->{$_} for (qw(self_size));
  79             $child->{$_}  = $node->{$_} for (qw(parent_id));
  80
  81             $child->{title} = join " + ", grep { defined && length } $child->{title}, $node->{title};
  82             warn "Titled $child->{title}" if $child->{title};
  83
  84             for my $attr_type (keys %{ $node->{attr} }) {
  85                 my $src = $node->{attr}{$attr_type};
  86                 if (ref $src eq 'HASH') { # eg NPattr_NAME: {attr}{1}{$name} = $value
  87                     my $dst = $child->{attr}{$attr_type} ||= {};
  88                     for my $k (keys %$src) {
  89                         warn "Node $child->{id} attr $attr_type:$k=$dst->{$k} overwritten by $src->{$k}\n"
  90                             if defined $dst->{$k};
  91                         $dst->{$k} = $src->{$k};
  92                     }
  93                 }
  94                 else { # ARRAY eg NPattr_PADNAME: {attr}{2}[$val] = $name
  95                     my $dst = $child->{attr}{$attr_type} ||= [];
  96                     my $idx = @$src;
  97                     while (--$idx >= 0) {
  98                         warn "Node $child->{id} attr $attr_type:$idx=$dst->[$idx] overwritten by $src->[$idx]\n"
  99                             if defined $dst->[$idx];
 100                         $dst->[$idx] = $src->[$idx];
 101                     }
 102                 }
 103             }
 104
 105             $child->{leaves}{$_} += $node->{leaves}{$_}
 106                 for keys %{ $node->{leaves} };
 107
 108             $child->{_ids_merged} .= ",$node->{id}";
 109             my @child_ids = split /,/, $node->{child_ids};
 110             $child->{child_count} = @child_ids;
 111
 112             $node = $child;
 113         }
 114         elsif ($depth) {
 115             $children = [ map { _fetch_node_tree($_, $depth-1) } @child_ids ];
 116             $node->{children} = $children;
 117             $node->{child_count} = @$children;
 118         }
 119     }
 120     return $node;
 121 }
 122
 123 sub _transform_node_tree {  # recurse depth first
 124     my ($node, $transform) = @_;
 125     if (my $children = $node->{children}) {
 126         $_ = _transform_node_tree($_, $transform) for @$children;
 127     }
 128     return $transform->($node);
 129 }
 130
 131
 132 app->start;
 133 __DATA__
 134 @@ index.html.ep
 135 % layout 'default';
 136 % title 'Welcome';
 137 Welcome to the Mojolicious real-time web framework!
 138
 139 @@ layouts/default.html.ep
 140 <!DOCTYPE html>
 141 <head>
 142 <meta http-equiv="Content-Type" content="text/html; charset=UTF-8" />
 143 <title>Perl Memory Treemap</title>
 144
 145 <!-- CSS Files -->
 146 <link type="text/css" href="css/base.css" rel="stylesheet" />
 147 <link type="text/css" href="css/Treemap.css" rel="stylesheet" />
 148
 149 <!--[if IE]><script language="javascript" type="text/javascript" src="excanvas.js"></script><![endif]-->
 150
 151 <!-- JIT Library File -->
 152 <script language="javascript" type="text/javascript" src="jit.js"></script>
 153 <script language="javascript" type="text/javascript" src="//ajax.googleapis.com/ajax/libs/jquery/1.8.1/jquery.min.js"></script>
 154
 155 <!-- Example File -->
 156 <script language="javascript" type="text/javascript" src="sprintf.js"></script>
 157 <script language="javascript" type="text/javascript" src="tm.js"></script>
 158 </head>
 159
 160 <body onload="init();">
 161 <div id="container">
 162
 163 <div id="left-container">
 164
 165 <div class="text">
 166 <h4>
 167 Perl Memory TreeMap
 168 </h4>
 169     Clicking on a node will show a new TreeMap with the contents of that node.<br /><br />
 170 </div>
 171
 172 <a id="back" href="#" class="theme button white">Go to Parent</a>
 173
 174 <br />
 175 <form name=params>
 176 <label for="logarea">&nbsp;Logarithmic scale
 177 <input type=checkbox id="logarea" name="logarea">
 178 </form>
 179
 180 </div>
 181
 182 <div id="center-container">
 183     <div id="infovis"></div>
 184 </div>
 185
 186 <div id="right-container">
 187
 188 <div id="inner-details"></div>
 189
 190 </div>
 191
 192 <div id="log"></div>
 193 </div>
 194 </body>
 195 </html>