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; |
b48d53b9 |
92 | if ( $Mojolicious::VERSION >= 2.49 ) { |
93 | push @{ app->static->paths }, $static_dir; |
94 | } else { |
95 | app->static->root($static_dir); |
96 | } |
e610a166 |
97 | |
f60f09e5 |
98 | |
b2fc39a5 |
99 | # Documentation browser under "/perldoc" |
100 | plugin 'PODRenderer'; |
101 | |
102 | get '/' => sub { |
103 | my $self = shift; |
104 | $self->render('index'); |
105 | }; |
106 | |
d3b8a135 |
107 | |
108 | # /jit_tree are AJAX requests from the treemap visualization |
b2fc39a5 |
109 | get '/jit_tree/:id/:depth' => sub { |
110 | my $self = shift; |
e8f4c506 |
111 | |
b2fc39a5 |
112 | my $id = $self->stash('id'); |
113 | my $depth = $self->stash('depth'); |
ee6e37bf |
114 | |
d3b8a135 |
115 | # hack, would be best done on the client side |
ee6e37bf |
116 | my $logarea = (defined $self->param('logarea')) |
117 | ? $self->param('logarea') |
118 | : Mojo::URL->new($self->req->headers->referrer)->query->param('logarea'); |
119 | |
875c1073 |
120 | my $node_tree = _fetch_node_tree($id, $depth); |
121 | my $jit_tree = _transform_node_tree($node_tree, sub { |
122 | my ($node) = @_; |
123 | my $children = delete $node->{children}; # XXX edits the src tree |
e8f4c506 |
124 | my $area = $node->{self_size}+$node->{kids_size}; |
945e07d7 |
125 | $node->{'$area'} = ($logarea) ? log($area) : $area; # XXX move to jit js |
bb66f8a1 |
126 | my $jit_node = { |
127 | id => $node->{id}, |
0a00007b |
128 | name => ($node->{title} || $node->{name}).($opt_showid ? " #$node->{id}" : ""), |
bb66f8a1 |
129 | data => $node, |
130 | }; |
131 | $jit_node->{children} = $children if $children; |
132 | return $jit_node; |
b2fc39a5 |
133 | }); |
ee6e37bf |
134 | |
d9d259d1 |
135 | if (1){ # debug |
136 | #use Data::Dump qw(pp); |
ee6e37bf |
137 | local $jit_tree->{children}; |
d9d259d1 |
138 | Dwarn(dclone($jit_tree)); # dclone to avoid stringification |
ee6e37bf |
139 | } |
140 | |
b2fc39a5 |
141 | $self->render_json($jit_tree); |
142 | }; |
143 | |
d3b8a135 |
144 | |
875c1073 |
145 | sub _fetch_node_tree { |
146 | my ($id, $depth) = @_; |
d3b8a135 |
147 | |
0a00007b |
148 | warn "#$id fetching\n" |
149 | if $opt_debug; |
150 | my $node = SizeMe->selectrow_hashref("select * from node where id = ?", undef, $id) |
d3b8a135 |
151 | or die "Node '$id' not found"; # shouldn't die |
945e07d7 |
152 | $node->{$_} += 0 for (qw(child_count kids_node_count kids_size self_size)); |
e78b28ca |
153 | $node->{leaves} = $j->decode(delete $node->{leaves_json}); |
e8f4c506 |
154 | $node->{attr} = $j->decode(delete $node->{attr_json}); |
47a0d085 |
155 | $node->{name} .= "->" if $node->{type} == 2 && $node->{name}; |
e78b28ca |
156 | |
5a78486c |
157 | if ($node->{child_ids}) { |
158 | my @child_ids = split /,/, $node->{child_ids}; |
875c1073 |
159 | my $children; |
d3b8a135 |
160 | |
161 | # if this node has only one child then we merge that child into this node |
162 | # this makes the treemap more usable |
ee6e37bf |
163 | if (@child_ids == 1 |
0a00007b |
164 | # && $node->{type} == 2 # only collapse links XXX |
ee6e37bf |
165 | ) { |
0a00007b |
166 | warn "#$id fetch only child $child_ids[0]\n" |
167 | if $opt_debug; |
5a78486c |
168 | my $child = _fetch_node_tree($child_ids[0], $depth); # same depth |
f9d8678b |
169 | # merge node into child |
5a78486c |
170 | # XXX id, depth, parent_id |
0a00007b |
171 | warn "Merged $node->{name} (#$node->{id} d$node->{depth}) with only child $child->{name} #$child->{id}\n" |
945e07d7 |
172 | if $opt_debug; |
e74c1998 |
173 | $child->{name} = "$node->{name} $child->{name}"; |
f9d8678b |
174 | $child->{$_} += $node->{$_} for (qw(self_size)); |
5a78486c |
175 | $child->{$_} = $node->{$_} for (qw(parent_id)); |
e8f4c506 |
176 | |
e74c1998 |
177 | $child->{title} = join " ", grep { defined && length } $child->{title}, $node->{title}; |
945e07d7 |
178 | #warn "Titled $child->{title}" if $child->{title}; |
e8f4c506 |
179 | |
d3b8a135 |
180 | # somewhat hackish attribute merging |
e8f4c506 |
181 | for my $attr_type (keys %{ $node->{attr} }) { |
182 | my $src = $node->{attr}{$attr_type}; |
183 | if (ref $src eq 'HASH') { # eg NPattr_NAME: {attr}{1}{$name} = $value |
184 | my $dst = $child->{attr}{$attr_type} ||= {}; |
185 | for my $k (keys %$src) { |
186 | warn "Node $child->{id} attr $attr_type:$k=$dst->{$k} overwritten by $src->{$k}\n" |
187 | if defined $dst->{$k}; |
188 | $dst->{$k} = $src->{$k}; |
189 | } |
190 | } |
47a0d085 |
191 | elsif (ref $src eq 'ARRAY') { # eg NPattr_PADNAME: {attr}{2}[$val] = $name |
e8f4c506 |
192 | my $dst = $child->{attr}{$attr_type} ||= []; |
193 | my $idx = @$src; |
194 | while (--$idx >= 0) { |
195 | warn "Node $child->{id} attr $attr_type:$idx=$dst->[$idx] overwritten by $src->[$idx]\n" |
196 | if defined $dst->[$idx]; |
197 | $dst->[$idx] = $src->[$idx]; |
198 | } |
199 | } |
47a0d085 |
200 | else { # assume scalar |
201 | warn "Node $child->{id} attr $attr_type=$child->{attr}{$attr_type} overwritten by $src\n" |
202 | if exists $child->{attr}{$attr_type}; |
203 | $child->{attr}{$attr_type} = $src; |
204 | } |
e8f4c506 |
205 | } |
206 | |
e78b28ca |
207 | $child->{leaves}{$_} += $node->{leaves}{$_} |
208 | for keys %{ $node->{leaves} }; |
5a78486c |
209 | |
210 | $child->{_ids_merged} .= ",$node->{id}"; |
211 | my @child_ids = split /,/, $node->{child_ids}; |
212 | $child->{child_count} = @child_ids; |
213 | |
d3b8a135 |
214 | $node = $child; # use the merged child as this node |
875c1073 |
215 | } |
0a00007b |
216 | if ($depth) { # recurse to required depth |
5a78486c |
217 | $children = [ map { _fetch_node_tree($_, $depth-1) } @child_ids ]; |
f9d8678b |
218 | $node->{children} = $children; |
219 | $node->{child_count} = @$children; |
875c1073 |
220 | } |
b2fc39a5 |
221 | } |
b2fc39a5 |
222 | return $node; |
223 | } |
224 | |
d3b8a135 |
225 | |
f9d8678b |
226 | sub _transform_node_tree { # recurse depth first |
875c1073 |
227 | my ($node, $transform) = @_; |
228 | if (my $children = $node->{children}) { |
229 | $_ = _transform_node_tree($_, $transform) for @$children; |
230 | } |
231 | return $transform->($node); |
232 | } |
233 | |
b2fc39a5 |
234 | |
235 | app->start; |
d3b8a135 |
236 | |
3d2b08ed |
237 | { # just to reserve the namespace for future use |
238 | package Devel::SizeMe::Graph; |
239 | 1; |
240 | } |
241 | |
b2fc39a5 |
242 | __DATA__ |
243 | @@ index.html.ep |
244 | % layout 'default'; |
245 | % title 'Welcome'; |
246 | Welcome to the Mojolicious real-time web framework! |
247 | |
248 | @@ layouts/default.html.ep |
249 | <!DOCTYPE html> |
250 | <head> |
251 | <meta http-equiv="Content-Type" content="text/html; charset=UTF-8" /> |
bb66f8a1 |
252 | <title>Perl Memory Treemap</title> |
b2fc39a5 |
253 | |
254 | <!-- CSS Files --> |
255 | <link type="text/css" href="css/base.css" rel="stylesheet" /> |
256 | <link type="text/css" href="css/Treemap.css" rel="stylesheet" /> |
257 | |
258 | <!--[if IE]><script language="javascript" type="text/javascript" src="excanvas.js"></script><![endif]--> |
259 | |
260 | <!-- JIT Library File --> |
21058011 |
261 | <script language="javascript" type="text/javascript" src="jit-yc.js"></script> |
2a627489 |
262 | <script language="javascript" type="text/javascript" src="jquery-1.8.1-min.js"></script> |
bb66f8a1 |
263 | <script language="javascript" type="text/javascript" src="sprintf.js"></script> |
21058011 |
264 | <script language="javascript" type="text/javascript" src="treemap.js"></script> |
b2fc39a5 |
265 | </head> |
266 | |
267 | <body onload="init();"> |
72eb1fbb |
268 | |
b2fc39a5 |
269 | <div id="container"> |
270 | |
271 | <div id="left-container"> |
272 | |
b2fc39a5 |
273 | <div class="text"> |
72eb1fbb |
274 | <h4> Perl Memory TreeMap </h4> |
47a0d085 |
275 | Click on a node to zoom in.<br /><br /> |
b2fc39a5 |
276 | </div> |
277 | |
278 | <a id="back" href="#" class="theme button white">Go to Parent</a> |
e8f4c506 |
279 | <br /> |
280 | <form name=params> |
281 | <label for="logarea"> Logarithmic scale |
282 | <input type=checkbox id="logarea" name="logarea"> |
283 | </form> |
284 | |
b2fc39a5 |
285 | </div> |
286 | |
287 | <div id="center-container"> |
72eb1fbb |
288 | <div id="infovis"></div> |
b2fc39a5 |
289 | </div> |
290 | |
291 | <div id="right-container"> |
72eb1fbb |
292 | <div id="inner-details"></div> |
b2fc39a5 |
293 | </div> |
294 | |
295 | <div id="log"></div> |
296 | </div> |
297 | </body> |
298 | </html> |