haha, nothing ever did use this, did it
[gitmo/Moose.git] / eg / class_browser.pl
CommitLineData
38bf2a25 1#!/usr/bin/perl
2
3use strict;
4use warnings;
5
6use Data::Dumper;
7use B::Deparse;
8use Template;
9use Getopt::Long;
10use CGI;
11
12use Class::MOP;
13
14my $stand_alone = 0;
15GetOptions("s" => \$stand_alone);
16
17if ($stand_alone) {
18 require HTTP::Server::Simple::CGI;
19 {
20 package # hide me from PAUSE
21 Class::MOP::Browser::Server;
22 our @ISA = qw(HTTP::Server::Simple::CGI);
23 sub handle_request { ::process_template() }
064a13a3 24 }
25 Class::MOP::Browser::Server->new()->run();
38bf2a25 26}
27else {
28 print CGI::header();
29 process_template();
30}
31
32{
33 my $DATA;
34 sub process_template {
35 $DATA ||= join "" => <DATA>;
36 Template->new->process(
37 \$DATA,
38 {
39 'get_all_metaclasses' => \&::get_all_metaclasses,
40 'get_metaclass_by_name' => \&::get_metaclass_by_name,
41 'deparse_method' => \&::deparse_method,
42 'deparse_item' => \&::deparse_item,
43 }
064a13a3 44 ) or warn Template->error;
38bf2a25 45 }
46}
47
064a13a3 48sub get_all_metaclasses {
49 sort { $a->name cmp $b->name } Class::MOP::get_all_metaclass_instances()
38bf2a25 50}
064a13a3 51
52sub get_metaclass_by_name {
53 Class::MOP::get_metaclass_by_name(@_);
38bf2a25 54}
55
56sub deparse_method {
57 my ($method) = @_;
58 my $deparse = B::Deparse->new("-d");
59 my $body = $deparse->coderef2text($method->body());
60 return "sub " . $method->name . ' ' . _clean_deparse_code($body);
61}
62
63sub deparse_item {
64 my ($item) = @_;
65 return $item unless ref $item;
66 local $Data::Dumper::Deparse = 1;
67 local $Data::Dumper::Indent = 1;
064a13a3 68 my $dumped = Dumper $item;
38bf2a25 69 $dumped =~ s/^\$VAR1\s=\s//;
064a13a3 70 $dumped =~ s/\;$//;
38bf2a25 71 return _clean_deparse_code($dumped);
72}
73
74sub _clean_deparse_code {
75 my @body = split /\n/ => $_[0];
76 my @cleaned;
77 foreach (@body) {
78 next if /^\s+use/;
064a13a3 79 next if /^\s+BEGIN/;
80 next if /^\s+package/;
38bf2a25 81 push @cleaned => $_;
064a13a3 82 }
83 return (join "\n" => @cleaned);
38bf2a25 84}
85
861;
87
88## This is the template file to be used
89
90__DATA__
91[% USE q = CGI %]
92
93[% area = 'attributes' %]
94[% IF q.param('area') %]
95 [% area = q.param('area') %]
96[% END %]
97
98<html>
99<head>
100<title>Class::MOP Browser</title>
101<style type='text/css'>
102
103body {
104 font-family: arial;
105}
106
107td { font-size: 12px; }
108b { font-size: 12px; }
109
110pre {
111 font-family: courier;
112 font-size: 12px;
113 width: 330px;
114 padding: 10px;
115 overflow: auto;
116 border: 1px dotted green;
117}
118
064a13a3 119A {
38bf2a25 120 font-family: arial;
064a13a3 121 font-size: 12px;
38bf2a25 122 color: black;
123 text-decoration: none;
124}
125
126A:hover {
064a13a3 127 text-decoration: underline;
38bf2a25 128}
064a13a3 129
130td.lightblue {
131 background-color: #99BBFF;
132 border-right: 1px solid #336699;
133 border-bottom: 1px solid #336699;
134 border-top: 1px solid #BBDDFF;
135 border-left: 1px solid #BBDDFF;
38bf2a25 136}
137
064a13a3 138td.grey {
139 background-color: #CCCCCC;
140 border-right: 1px solid #888888;
141 border-bottom: 1px solid #888888;
142 border-top: 1px solid #DDDDDD;
143 border-left: 1px solid #DDDDDD;
38bf2a25 144}
145
064a13a3 146td.manila {
38bf2a25 147 background-color: #FFDD99;
064a13a3 148 border-right: 2px solid #CC9933;
149 border-bottom: 2px solid #CC9933;
150 border-top: 2px solid #FFFFBB;
151 border-left: 2px solid #FFFFBB;
38bf2a25 152}
153
064a13a3 154td.darkgreen {
155 background-color: #33CC33;
156 border-right: 1px solid #009900;
157 border-bottom: 1px solid #009900;
158 color: #CCFFCC;
38bf2a25 159}
160
064a13a3 161td.lightgreen {
162 background-color: #AAFFAA;
163 border-right: 1px solid #33FF33;
164 border-bottom: 1px solid #33FF33;
38bf2a25 165}
166
167</style>
168</head>
169<body>
170<h1>Class::MOP Browser</h1>
171<table bgcolor='#CCCCCC' cellpadding='0' cellspacing='0' border='0' align='center' height='400'>
172<tr valign='top'>
064a13a3 173
38bf2a25 174<td rowspan='2' width='200'><table cellspacing='0' cellpadding='5' border='0' width='100%'>
175 [% FOREACH metaclass IN get_all_metaclasses() %]
176 <tr>
177 [% IF q.param('class') == metaclass.name %]
178 <td class='lightblue'><b>[% metaclass.name %]</b></td>
179 [% ELSE %]
180 <td class='grey'><a href='?class=[% metaclass.name %]'>[% metaclass.name %]</a></td>
181 [% END %]
182 </tr>
183 [% END %]
184 </table></td>
185<td height='10' width='250'><table cellspacing='0' cellpadding='5' border='0' width='100%'>
064a13a3 186 <tr align='center'>
38bf2a25 187 [% FOREACH area_name IN [ 'attributes', 'methods', 'superclasses' ] %]
188 [% IF q.param('class') %]
064a13a3 189 [% IF area == area_name %]
38bf2a25 190 <td class='manila'><b>[% area_name %]</b></td>
191 [% ELSE %]
192 <td class='lightblue'><a href='?class=[% q.param('class') %]&area=[% area_name %]'>[% area_name %]</a></td>
193 [% END %]
194 [% ELSE %]
195 <td class='lightblue' style="color: #336699;">[% area_name %]</td>
196 [% END %]
197 [% END %]
198 </tr>
199 </table></td>
200
201<td valign='top' rowspan='2' class='lightgreen' width='450'>
202 <table cellspacing='0' cellpadding='3' border='0'>
064a13a3 203 <tr>
204 <td class='darkgreen' width='100'></td>
205 <td class='darkgreen' width='350'></td>
206 </tr>
38bf2a25 207 [% IF q.param('class') && area == 'attributes' && q.param('attr') %]
208
064a13a3 209 [%
38bf2a25 210 meta = get_metaclass_by_name(q.param('class'))
211 attr = meta.get_attribute(q.param('attr'))
212 %]
213
214 [% FOREACH aspect IN [ 'name', 'init_arg', 'reader', 'writer', 'accessor', 'predicate', 'default' ]%]
215 [% item = attr.$aspect() %]
216 <tr>
217 <td class='darkgreen' align='right' valign='top'>[% aspect %]</td>
218 <td class='lightgreen'>[% IF item == undef %]&mdash;[% ELSE %]<pre>[% deparse_item(item) %]</pre>[% END %]</td>
219 </tr>
220 [% END %]
221
222 [% ELSIF q.param('class') && area == 'methods' && q.param('method') %]
223
064a13a3 224 [%
38bf2a25 225 meta = get_metaclass_by_name(q.param('class'))
226 method = meta.get_method(q.param('method'))
227 %]
228
229 [% FOREACH aspect IN [ 'name', 'package_name', 'fully_qualified_name' ]%]
230 <tr>
231 <td class='darkgreen' align='right' valign='top'>[% aspect %]</td>
232 <td class='lightgreen'>[% method.$aspect() %]</td>
233 </tr>
234 [% END %]
235 <tr>
236 <td class='darkgreen' align='right' valign='top'>body</td>
237 <td class='lightgreen'><pre>[% deparse_method(method) %]</pre></td>
064a13a3 238 </tr>
38bf2a25 239
240 [% END %]
241 </table></td>
242
243</tr>
244<tr>
245
246[% IF q.param('class') && area %]
247
248[% meta = get_metaclass_by_name(q.param('class')) %]
249
250<td class='lightblue' valign='top'><div style='height: 100%; overflow: auto;'><table cellspacing='0' cellpadding='5' border='0' width='100%'>
251
252 [% IF area == 'methods' %]
253 [% FOREACH method IN meta.get_method_list.sort %]
254 <tr>
255 [% IF q.param('method') == method %]
064a13a3 256 <td class='darkgreen'><b>[% method %]</b></td>
38bf2a25 257 [% ELSE %]
258 <td class='manila'><a href='?class=[% q.param('class') %]&area=[% q.param('area') %]&method=[% method %]'>[% method %]</a></td>
259 [% END %]
260 </tr>
064a13a3 261 [% END %]
38bf2a25 262 [% END %]
263 [% IF area == 'attributes' %]
264 [% FOREACH attr IN meta.get_attribute_list.sort %]
265 <tr>
266 [% IF q.param('attr') == attr %]
064a13a3 267 <td class='darkgreen'><b>[% attr %]</b></td>
38bf2a25 268 [% ELSE %]
269 <td class='manila'><a href='?class=[% q.param('class') %]&area=[% q.param('area') %]&attr=[% attr %]'>[% attr %]</a></td>
270 [% END %]
271 </tr>
064a13a3 272 [% END %]
273 [% END %]
38bf2a25 274 [% IF area == 'superclasses' %]
275 [% FOREACH super IN meta.superclasses.sort %]
276 <tr>
277 <td class='manila'><a href='?class=[% super %]'>[% super %]</a></td>
278 </tr>
064a13a3 279 [% END %]
280 [% END %]
38bf2a25 281 </table></div></td>
282[% END %]
283
284</tr>
285</table>
286</body>
287</html>
288