[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_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->{_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
	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";
5a78486c	55	if ($node->{child_ids}) {
5a78486c	56	my @child_ids = split /,/, $node->{child_ids};
875c1073	57	my $children;
5a78486c	58	if (@child_ids == 1) {
5a78486c	59	my $child = _fetch_node_tree($child_ids[0], $depth); # same depth
f9d8678b	60	# merge node into child
5a78486c	61	# XXX id, depth, parent_id
f9d8678b	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));
5a78486c	65	$child->{$_} = $node->{$_} for (qw(parent_id));
	66
	67	$child->{_ids_merged} .= ",$node->{id}";
	68	my @child_ids = split /,/, $node->{child_ids};
	69	$child->{child_count} = @child_ids;
	70
f9d8678b	71	$node = $child;
875c1073	72	}
f9d8678b	73	elsif ($depth) {
5a78486c	74	$children = [ map { _fetch_node_tree($_, $depth-1) } @child_ids ];
f9d8678b	75	$node->{children} = $children;
f9d8678b	76	$node->{child_count} = @$children;
875c1073	77	}
b2fc39a5	78	}
b2fc39a5	79	return $node;
	80	}
	81
f9d8678b	82	sub _transform_node_tree { # recurse depth first
875c1073	83	my ($node, $transform) = @_;
	84	if (my $children = $node->{children}) {
	85	$_ = _transform_node_tree($_, $transform) for @$children;
	86	}
	87	return $transform->($node);
	88	}
	89
b2fc39a5	90
	91	app->start;
	92	__DATA__
	93	@@ index.html.ep
	94	% layout 'default';
	95	% title 'Welcome';
	96	Welcome to the Mojolicious real-time web framework!
	97
	98	@@ layouts/default.html.ep
	99	<!DOCTYPE html>
	100	<head>
	101	<meta http-equiv="Content-Type" content="text/html; charset=UTF-8" />
bb66f8a1	102	<title>Perl Memory Treemap</title>
b2fc39a5	103
	104	<!-- CSS Files -->
	105	<link type="text/css" href="css/base.css" rel="stylesheet" />
	106	<link type="text/css" href="css/Treemap.css" rel="stylesheet" />
	107
	108	<!--[if IE]><script language="javascript" type="text/javascript" src="excanvas.js"></script><![endif]-->
	109
	110	<!-- JIT Library File -->
	111	<script language="javascript" type="text/javascript" src="jit.js"></script>
	112	<script language="javascript" type="text/javascript" src="//ajax.googleapis.com/ajax/libs/jquery/1.8.1/jquery.min.js"></script>
	113
	114	<!-- Example File -->
bb66f8a1	115	<script language="javascript" type="text/javascript" src="sprintf.js"></script>
b2fc39a5	116	<script language="javascript" type="text/javascript" src="tm.js"></script>
	117	</head>
	118
	119	<body onload="init();">
	120	<div id="container">
	121
	122	<div id="left-container">
	123
b2fc39a5	124	<div class="text">
b2fc39a5	125	<h4>
bb66f8a1	126	Perl Memory TreeMap
b2fc39a5	127	</h4>
bb66f8a1	128	Clicking on a node will show a new TreeMap with the contents of that node.<br /><br />
b2fc39a5	129	</div>
	130
	131	<a id="back" href="#" class="theme button white">Go to Parent</a>
b2fc39a5	132	</div>
	133
	134	<div id="center-container">
	135	<div id="infovis"></div>
	136	</div>
	137
	138	<div id="right-container">
	139
	140	<div id="inner-details"></div>
	141
	142	</div>
	143
	144	<div id="log"></div>
	145	</div>
	146	</body>
	147	</html>