Commit | Line | Data |
b2fc39a5 |
1 | #!/usr/bin/env perl |
2 | |
591aba53 |
3 | =head1 NAME |
b2fc39a5 |
4 | |
591aba53 |
5 | sizeme_graph.pl - web server providing an interactive treemap of Devel::SizeMe data |
e8f4c506 |
6 | |
591aba53 |
7 | =head1 SYNOPSIS |
8 | |
9 | sizeme_graph.pl --db sizeme.db daemon |
10 | |
11 | sizeme_graph.pl daemon # same as above |
12 | |
13 | Then open a web browser on http://127.0.0.1:3000 |
14 | |
15 | =head1 DESCRIPTION |
16 | |
17 | Reads a database created by sizeme_store.pl and provides a web interface with |
18 | an interactive treemap of the data. |
72eb1fbb |
19 | |
591aba53 |
20 | =head2 TODO |
d3b8a135 |
21 | |
591aba53 |
22 | Current implementation is all very alpha and rather hackish. |
d3b8a135 |
23 | |
591aba53 |
24 | Split out the db and tree code into a separate module. |
d3b8a135 |
25 | |
591aba53 |
26 | Use a history management library so the back button works and we can have |
27 | links to specific nodes. |
7aa9284e |
28 | |
591aba53 |
29 | Better tool-tip and/or add a scrollable information area below the treemap |
30 | that could contain details and links. |
d3b8a135 |
31 | |
591aba53 |
32 | Make the treemap resize to fit the browser window (as NYTProf does). |
d3b8a135 |
33 | |
591aba53 |
34 | Protect against nodes with thousands of children |
35 | perhaps replace all with single merged child that has no children itself |
36 | but just a warning as a title. |
37 | |
38 | Implement other visualizations, such as a space-tree |
39 | http://thejit.org/static/v20/Jit/Examples/Spacetree/example2.html |
7aa9284e |
40 | |
41 | =cut |
42 | |
591aba53 |
43 | use strict; |
44 | use warnings; |
45 | |
46 | use Mojolicious::Lite; |
47 | use JSON::XS; |
48 | use Getopt::Long; |
49 | use Storable qw(dclone); |
50 | use Devel::Dwarn; |
51 | use Devel::SizeMe::Graph; |
52 | |
53 | require ORLite; |
54 | |
72eb1fbb |
55 | my $j = JSON::XS->new; |
56 | |
e8f4c506 |
57 | GetOptions( |
72eb1fbb |
58 | 'db=s' => \(my $opt_db = 'sizeme.db'), |
0a00007b |
59 | 'showid!' => \my $opt_showid, |
945e07d7 |
60 | 'debug!' => \my $opt_debug, |
e8f4c506 |
61 | ) or exit 1; |
b2fc39a5 |
62 | |
72eb1fbb |
63 | die "Can't open $opt_db: $!\n" unless -r $opt_db; |
64 | warn "Reading $opt_db\n"; |
945e07d7 |
65 | |
d3b8a135 |
66 | # XXX currently uses ORLite but doesn't actually make use of it in any useful way |
72eb1fbb |
67 | ORLite->import({ |
68 | file => $opt_db, |
0a00007b |
69 | package => "SizeMe", |
b2fc39a5 |
70 | readonly => 1, |
72eb1fbb |
71 | #user_version => 1, # XXX |
72 | #unicode => 1, # XXX |
73 | }); |
b2fc39a5 |
74 | |
e610a166 |
75 | my $static_dir = $INC{'Devel/SizeMe/Graph.pm'} or die 'panic'; |
76 | $static_dir =~ s:\.pm$:/static:; |
77 | die "panic $static_dir" unless -d $static_dir; |
78 | push @{ app->static->paths}, $static_dir; |
79 | |
f60f09e5 |
80 | |
b2fc39a5 |
81 | # Documentation browser under "/perldoc" |
82 | plugin 'PODRenderer'; |
83 | |
84 | get '/' => sub { |
85 | my $self = shift; |
86 | $self->render('index'); |
87 | }; |
88 | |
d3b8a135 |
89 | |
90 | # /jit_tree are AJAX requests from the treemap visualization |
b2fc39a5 |
91 | get '/jit_tree/:id/:depth' => sub { |
92 | my $self = shift; |
e8f4c506 |
93 | |
b2fc39a5 |
94 | my $id = $self->stash('id'); |
95 | my $depth = $self->stash('depth'); |
ee6e37bf |
96 | |
d3b8a135 |
97 | # hack, would be best done on the client side |
ee6e37bf |
98 | my $logarea = (defined $self->param('logarea')) |
99 | ? $self->param('logarea') |
100 | : Mojo::URL->new($self->req->headers->referrer)->query->param('logarea'); |
101 | |
875c1073 |
102 | my $node_tree = _fetch_node_tree($id, $depth); |
103 | my $jit_tree = _transform_node_tree($node_tree, sub { |
104 | my ($node) = @_; |
105 | my $children = delete $node->{children}; # XXX edits the src tree |
e8f4c506 |
106 | my $area = $node->{self_size}+$node->{kids_size}; |
945e07d7 |
107 | $node->{'$area'} = ($logarea) ? log($area) : $area; # XXX move to jit js |
bb66f8a1 |
108 | my $jit_node = { |
109 | id => $node->{id}, |
0a00007b |
110 | name => ($node->{title} || $node->{name}).($opt_showid ? " #$node->{id}" : ""), |
bb66f8a1 |
111 | data => $node, |
112 | }; |
113 | $jit_node->{children} = $children if $children; |
114 | return $jit_node; |
b2fc39a5 |
115 | }); |
ee6e37bf |
116 | |
d3b8a135 |
117 | if(1){ # debug |
ee6e37bf |
118 | use Devel::Dwarn; |
119 | use Data::Dump qw(pp); |
120 | local $jit_tree->{children}; |
121 | pp(dclone($jit_tree)); # dclone to avoid stringification |
122 | } |
123 | |
b2fc39a5 |
124 | $self->render_json($jit_tree); |
125 | }; |
126 | |
d3b8a135 |
127 | |
875c1073 |
128 | sub _fetch_node_tree { |
129 | my ($id, $depth) = @_; |
d3b8a135 |
130 | |
0a00007b |
131 | warn "#$id fetching\n" |
132 | if $opt_debug; |
133 | my $node = SizeMe->selectrow_hashref("select * from node where id = ?", undef, $id) |
d3b8a135 |
134 | or die "Node '$id' not found"; # shouldn't die |
945e07d7 |
135 | $node->{$_} += 0 for (qw(child_count kids_node_count kids_size self_size)); |
e78b28ca |
136 | $node->{leaves} = $j->decode(delete $node->{leaves_json}); |
e8f4c506 |
137 | $node->{attr} = $j->decode(delete $node->{attr_json}); |
47a0d085 |
138 | $node->{name} .= "->" if $node->{type} == 2 && $node->{name}; |
e78b28ca |
139 | |
5a78486c |
140 | if ($node->{child_ids}) { |
141 | my @child_ids = split /,/, $node->{child_ids}; |
875c1073 |
142 | my $children; |
d3b8a135 |
143 | |
144 | # if this node has only one child then we merge that child into this node |
145 | # this makes the treemap more usable |
ee6e37bf |
146 | if (@child_ids == 1 |
0a00007b |
147 | # && $node->{type} == 2 # only collapse links XXX |
ee6e37bf |
148 | ) { |
0a00007b |
149 | warn "#$id fetch only child $child_ids[0]\n" |
150 | if $opt_debug; |
5a78486c |
151 | my $child = _fetch_node_tree($child_ids[0], $depth); # same depth |
f9d8678b |
152 | # merge node into child |
5a78486c |
153 | # XXX id, depth, parent_id |
0a00007b |
154 | warn "Merged $node->{name} (#$node->{id} d$node->{depth}) with only child $child->{name} #$child->{id}\n" |
945e07d7 |
155 | if $opt_debug; |
e74c1998 |
156 | $child->{name} = "$node->{name} $child->{name}"; |
f9d8678b |
157 | $child->{$_} += $node->{$_} for (qw(self_size)); |
5a78486c |
158 | $child->{$_} = $node->{$_} for (qw(parent_id)); |
e8f4c506 |
159 | |
e74c1998 |
160 | $child->{title} = join " ", grep { defined && length } $child->{title}, $node->{title}; |
945e07d7 |
161 | #warn "Titled $child->{title}" if $child->{title}; |
e8f4c506 |
162 | |
d3b8a135 |
163 | # somewhat hackish attribute merging |
e8f4c506 |
164 | for my $attr_type (keys %{ $node->{attr} }) { |
165 | my $src = $node->{attr}{$attr_type}; |
166 | if (ref $src eq 'HASH') { # eg NPattr_NAME: {attr}{1}{$name} = $value |
167 | my $dst = $child->{attr}{$attr_type} ||= {}; |
168 | for my $k (keys %$src) { |
169 | warn "Node $child->{id} attr $attr_type:$k=$dst->{$k} overwritten by $src->{$k}\n" |
170 | if defined $dst->{$k}; |
171 | $dst->{$k} = $src->{$k}; |
172 | } |
173 | } |
47a0d085 |
174 | elsif (ref $src eq 'ARRAY') { # eg NPattr_PADNAME: {attr}{2}[$val] = $name |
e8f4c506 |
175 | my $dst = $child->{attr}{$attr_type} ||= []; |
176 | my $idx = @$src; |
177 | while (--$idx >= 0) { |
178 | warn "Node $child->{id} attr $attr_type:$idx=$dst->[$idx] overwritten by $src->[$idx]\n" |
179 | if defined $dst->[$idx]; |
180 | $dst->[$idx] = $src->[$idx]; |
181 | } |
182 | } |
47a0d085 |
183 | else { # assume scalar |
184 | warn "Node $child->{id} attr $attr_type=$child->{attr}{$attr_type} overwritten by $src\n" |
185 | if exists $child->{attr}{$attr_type}; |
186 | $child->{attr}{$attr_type} = $src; |
187 | } |
e8f4c506 |
188 | } |
189 | |
e78b28ca |
190 | $child->{leaves}{$_} += $node->{leaves}{$_} |
191 | for keys %{ $node->{leaves} }; |
5a78486c |
192 | |
193 | $child->{_ids_merged} .= ",$node->{id}"; |
194 | my @child_ids = split /,/, $node->{child_ids}; |
195 | $child->{child_count} = @child_ids; |
196 | |
d3b8a135 |
197 | $node = $child; # use the merged child as this node |
875c1073 |
198 | } |
0a00007b |
199 | if ($depth) { # recurse to required depth |
5a78486c |
200 | $children = [ map { _fetch_node_tree($_, $depth-1) } @child_ids ]; |
f9d8678b |
201 | $node->{children} = $children; |
202 | $node->{child_count} = @$children; |
875c1073 |
203 | } |
b2fc39a5 |
204 | } |
b2fc39a5 |
205 | return $node; |
206 | } |
207 | |
d3b8a135 |
208 | |
f9d8678b |
209 | sub _transform_node_tree { # recurse depth first |
875c1073 |
210 | my ($node, $transform) = @_; |
211 | if (my $children = $node->{children}) { |
212 | $_ = _transform_node_tree($_, $transform) for @$children; |
213 | } |
214 | return $transform->($node); |
215 | } |
216 | |
b2fc39a5 |
217 | |
218 | app->start; |
d3b8a135 |
219 | |
b2fc39a5 |
220 | __DATA__ |
221 | @@ index.html.ep |
222 | % layout 'default'; |
223 | % title 'Welcome'; |
224 | Welcome to the Mojolicious real-time web framework! |
225 | |
226 | @@ layouts/default.html.ep |
227 | <!DOCTYPE html> |
228 | <head> |
229 | <meta http-equiv="Content-Type" content="text/html; charset=UTF-8" /> |
bb66f8a1 |
230 | <title>Perl Memory Treemap</title> |
b2fc39a5 |
231 | |
232 | <!-- CSS Files --> |
233 | <link type="text/css" href="css/base.css" rel="stylesheet" /> |
234 | <link type="text/css" href="css/Treemap.css" rel="stylesheet" /> |
235 | |
236 | <!--[if IE]><script language="javascript" type="text/javascript" src="excanvas.js"></script><![endif]--> |
237 | |
238 | <!-- JIT Library File --> |
21058011 |
239 | <script language="javascript" type="text/javascript" src="jit-yc.js"></script> |
2a627489 |
240 | <script language="javascript" type="text/javascript" src="jquery-1.8.1-min.js"></script> |
bb66f8a1 |
241 | <script language="javascript" type="text/javascript" src="sprintf.js"></script> |
21058011 |
242 | <script language="javascript" type="text/javascript" src="treemap.js"></script> |
b2fc39a5 |
243 | </head> |
244 | |
245 | <body onload="init();"> |
72eb1fbb |
246 | |
b2fc39a5 |
247 | <div id="container"> |
248 | |
249 | <div id="left-container"> |
250 | |
b2fc39a5 |
251 | <div class="text"> |
72eb1fbb |
252 | <h4> Perl Memory TreeMap </h4> |
47a0d085 |
253 | Click on a node to zoom in.<br /><br /> |
b2fc39a5 |
254 | </div> |
255 | |
256 | <a id="back" href="#" class="theme button white">Go to Parent</a> |
e8f4c506 |
257 | <br /> |
258 | <form name=params> |
259 | <label for="logarea"> Logarithmic scale |
260 | <input type=checkbox id="logarea" name="logarea"> |
261 | </form> |
262 | |
b2fc39a5 |
263 | </div> |
264 | |
265 | <div id="center-container"> |
72eb1fbb |
266 | <div id="infovis"></div> |
b2fc39a5 |
267 | </div> |
268 | |
269 | <div id="right-container"> |
72eb1fbb |
270 | <div id="inner-details"></div> |
b2fc39a5 |
271 | </div> |
272 | |
273 | <div id="log"></div> |
274 | </div> |
275 | </body> |
276 | </html> |