[p5sagit/Devel-Size.git] / static / MemView.pl

#!/usr/bin/env perl

use strict;
use warnings;

use JSON::XS;
use Mojolicious::Lite;

use ORLite {
    file => '../x.db',
    package => "MemView",
    #user_version => 1,
    readonly => 1,
    #unicode => 1,
};

my $j = JSON::XS->new;

# Documentation browser under "/perldoc"
plugin 'PODRenderer';

get '/' => sub {
    my $self = shift;
    $self->render('index');
};

get '/jit_tree/:id/:depth' => sub {
    my $self = shift;
    my $id = $self->stash('id');
    my $depth = $self->stash('depth');
    warn "jit_tree $id $depth";
    my $node_tree = _fetch_node_tree($id, $depth);
    my $jit_tree = _transform_node_tree($node_tree, sub {
        my ($node) = @_;
        my $children = delete $node->{children}; # XXX edits the src tree
        $node->{'$area'} = $node->{self_size}+$node->{kids_size};
        my $jit_node = {
            id   => $node->{id},
            name => $node->{name},
            data => $node,
        };
        $jit_node->{children} = $children if $children;
        return $jit_node;
    });
if(1){
    use Devel::Dwarn;
    use Data::Dump qw(pp);
    local $jit_tree->{children};
    pp($jit_tree);
}
    $self->render_json($jit_tree);
};

sub _fetch_node_tree {
    my ($id, $depth) = @_;
    my $node = MemView->selectrow_hashref("select * from node where id = ?", undef, $id)
        or die "Node '$id' not found";
    $node->{attr}{self} = $j->decode(delete $node->{attr_json});
    $node->{leaves} = $j->decode(delete $node->{leaves_json});

    if ($node->{child_ids}) {
        my @child_ids = split /,/, $node->{child_ids};
        my $children;
        if (@child_ids == 1) {
            my $child = _fetch_node_tree($child_ids[0], $depth); # same depth
            # merge node into child
            # XXX id, depth, parent_id
            warn "Merged $node->{name} #$node->{id} with only child $child->{name} #$child->{id}\n";
            $child->{name} = "$node->{name} + $child->{name}";
            $child->{$_} += $node->{$_} for (qw(self_size));
            $child->{$_}  = $node->{$_} for (qw(parent_id));
            $child->{attr}{$node->{id}} = $node->{attr};
            $child->{leaves}{$_} += $node->{leaves}{$_}
                for keys %{ $node->{leaves} };

            $child->{_ids_merged} .= ",$node->{id}";
            my @child_ids = split /,/, $node->{child_ids};
            $child->{child_count} = @child_ids;

            $node = $child;
        }
        elsif ($depth) {
            $children = [ map { _fetch_node_tree($_, $depth-1) } @child_ids ];
            $node->{children} = $children;
            $node->{child_count} = @$children;
        }
    }
    return $node;
}

sub _transform_node_tree {  # recurse depth first
    my ($node, $transform) = @_;
    if (my $children = $node->{children}) {
        $_ = _transform_node_tree($_, $transform) for @$children;
    }
    return $transform->($node);
}


app->start;
__DATA__
@@ index.html.ep
% layout 'default';
% title 'Welcome';
Welcome to the Mojolicious real-time web framework!

@@ layouts/default.html.ep
<!DOCTYPE html>
<head>
<meta http-equiv="Content-Type" content="text/html; charset=UTF-8" />
<title>Perl Memory Treemap</title>

<!-- CSS Files -->
<link type="text/css" href="css/base.css" rel="stylesheet" />
<link type="text/css" href="css/Treemap.css" rel="stylesheet" />

<!--[if IE]><script language="javascript" type="text/javascript" src="excanvas.js"></script><![endif]-->

<!-- JIT Library File -->
<script language="javascript" type="text/javascript" src="jit.js"></script>
<script language="javascript" type="text/javascript" src="//ajax.googleapis.com/ajax/libs/jquery/1.8.1/jquery.min.js"></script>

<!-- Example File -->
<script language="javascript" type="text/javascript" src="sprintf.js"></script>
<script language="javascript" type="text/javascript" src="tm.js"></script>
</head>

<body onload="init();">
<div id="container">

<div id="left-container">

<div class="text">
<h4>
Perl Memory TreeMap
</h4> 
    Clicking on a node will show a new TreeMap with the contents of that node.<br /><br />            
</div>

<a id="back" href="#" class="theme button white">Go to Parent</a>
</div>

<div id="center-container">
    <div id="infovis"></div>    
</div>

<div id="right-container">

<div id="inner-details"></div>

</div>

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