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

#!/usr/bin/env perl

use strict;
use warnings;

use Mojolicious::Lite;

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

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