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