Test that stub functions are handled like every other function.
[gitmo/Class-MOP.git] / scripts / class_browser.pl
CommitLineData
085f1c71 1#!/usr/bin/perl
2
3use strict;
4use warnings;
5
085f1c71 6use Data::Dumper;
7use B::Deparse;
8use Template;
9use Getopt::Long;
dbc791f9 10use CGI;
085f1c71 11
dbc791f9 12use Class::MOP;
085f1c71 13
14my $stand_alone = 0;
dbc791f9 15GetOptions("s" => \$stand_alone);
085f1c71 16
17if ($stand_alone) {
dbc791f9 18 require HTTP::Server::Simple::CGI;
085f1c71 19 {
dbc791f9 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() }
085f1c71 24 }
dbc791f9 25 Class::MOP::Browser::Server->new()->run();
085f1c71 26}
27else {
085f1c71 28 print CGI::header();
dbc791f9 29 process_template();
085f1c71 30}
31
dbc791f9 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 }
44 ) or warn Template->error;
45 }
46}
085f1c71 47
48sub get_all_metaclasses {
49 sort { $a->name cmp $b->name } Class::MOP::get_all_metaclass_instances()
50}
51
52sub get_metaclass_by_name {
53 Class::MOP::get_metaclass_by_name(@_);
54}
55
56sub deparse_method {
57 my ($method) = @_;
085f1c71 58 my $deparse = B::Deparse->new("-d");
59 my $body = $deparse->coderef2text($method->body());
dbc791f9 60 return "sub " . $method->name . ' ' . _clean_deparse_code($body);
085f1c71 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;
68 my $dumped = Dumper $item;
69 $dumped =~ s/^\$VAR1\s=\s//;
70 $dumped =~ s/\;$//;
dbc791f9 71 return _clean_deparse_code($dumped);
72}
085f1c71 73
dbc791f9 74sub _clean_deparse_code {
75 my @body = split /\n/ => $_[0];
085f1c71 76 my @cleaned;
085f1c71 77 foreach (@body) {
78 next if /^\s+use/;
79 next if /^\s+BEGIN/;
80 next if /^\s+package/;
81 push @cleaned => $_;
dbc791f9 82 }
83 return (join "\n" => @cleaned);
085f1c71 84}
85
861;
87
88## This is the template file to be used
89
90__DATA__
91[% USE q = CGI %]
dbc791f9 92
085f1c71 93[% area = 'attributes' %]
94[% IF q.param('area') %]
95 [% area = q.param('area') %]
96[% END %]
dbc791f9 97
085f1c71 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
119A {
120 font-family: arial;
121 font-size: 12px;
122 color: black;
123 text-decoration: none;
124}
125
126A:hover {
127 text-decoration: underline;
128}
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;
136}
137
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;
144}
145
146td.manila {
147 background-color: #FFDD99;
148 border-right: 2px solid #CC9933;
149 border-bottom: 2px solid #CC9933;
150 border-top: 2px solid #FFFFBB;
151 border-left: 2px solid #FFFFBB;
152}
153
154td.darkgreen {
155 background-color: #33CC33;
156 border-right: 1px solid #009900;
157 border-bottom: 1px solid #009900;
158 color: #CCFFCC;
159}
160
161td.lightgreen {
162 background-color: #AAFFAA;
163 border-right: 1px solid #33FF33;
164 border-bottom: 1px solid #33FF33;
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'>
173
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 %]
dbc791f9 178 <td class='lightblue'><b>[% metaclass.name %]</b></td>
085f1c71 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%'>
186 <tr align='center'>
187 [% FOREACH area_name IN [ 'attributes', 'methods', 'superclasses' ] %]
188 [% IF q.param('class') %]
189 [% IF area == area_name %]
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'>
203 <tr>
204 <td class='darkgreen' width='100'></td>
205 <td class='darkgreen' width='350'></td>
206 </tr>
207 [% IF q.param('class') && area == 'attributes' && q.param('attr') %]
208
209 [%
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
224 [%
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>
238 </tr>
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 %]
256 <td class='darkgreen'><b>[% method %]</b></td>
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>
261 [% END %]
262 [% END %]
263 [% IF area == 'attributes' %]
264 [% FOREACH attr IN meta.get_attribute_list.sort %]
265 <tr>
266 [% IF q.param('attr') == attr %]
267 <td class='darkgreen'><b>[% attr %]</b></td>
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>
272 [% END %]
273 [% END %]
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>
279 [% END %]
280 [% END %]
281 </table></div></td>
282[% END %]
283
284</tr>
285</table>
286</body>
287</html>
288