12 my $DATA = join "" => <DATA>;
22 package Class::MOP::Browser::Server;
25 use base qw(HTTP::Server::Simple::CGI);
28 my ($self, $cgi) = @_;
29 Template->new->process(
32 'get_all_metaclasses' => \&::get_all_metaclasses,
33 'get_metaclass_by_name' => \&::get_metaclass_by_name,
34 'deparse_method' => \&::deparse_method,
35 'deparse_item' => \&::deparse_item,
37 ) or warn Template->error;
41 my $server = Class::MOP::Browser::Server->new();
48 Template->new->process(
51 'get_all_metaclasses' => \&::get_all_metaclasses,
52 'get_metaclass_by_name' => \&::get_metaclass_by_name,
53 'deparse_method' => \&::deparse_method,
54 'deparse_item' => \&::deparse_item,
56 ) or warn Template->error;
61 sub get_all_metaclasses {
62 sort { $a->name cmp $b->name } Class::MOP::get_all_metaclass_instances()
65 sub get_metaclass_by_name {
66 Class::MOP::get_metaclass_by_name(@_);
72 my $deparse = B::Deparse->new("-d");
73 my $body = $deparse->coderef2text($method->body());
75 my @body = split /\n/ => $body;
81 next if /^\s+package/;
85 return "sub " . $method->name . ' ' . (join "\n" => @cleaned);
90 return $item unless ref $item;
91 local $Data::Dumper::Deparse = 1;
92 local $Data::Dumper::Indent = 1;
93 my $dumped = Dumper $item;
94 $dumped =~ s/^\$VAR1\s=\s//;
97 my @body = split /\n/ => $dumped;
103 next if /^\s+package/;
107 return (join "\n" => @cleaned);
112 ## This is the template file to be used
116 [% area = 'attributes' %]
117 [% IF q.param('area') %]
118 [% area = q.param('area') %]
122 <title>Class::MOP Browser</title>
123 <style type='text/css'>
129 td { font-size: 12px; }
130 b { font-size: 12px; }
133 font-family: courier;
138 border: 1px dotted green;
145 text-decoration: none;
149 text-decoration: underline;
153 background-color: #99BBFF;
154 border-right: 1px solid #336699;
155 border-bottom: 1px solid #336699;
156 border-top: 1px solid #BBDDFF;
157 border-left: 1px solid #BBDDFF;
161 background-color: #CCCCCC;
162 border-right: 1px solid #888888;
163 border-bottom: 1px solid #888888;
164 border-top: 1px solid #DDDDDD;
165 border-left: 1px solid #DDDDDD;
169 background-color: #FFDD99;
170 border-right: 2px solid #CC9933;
171 border-bottom: 2px solid #CC9933;
172 border-top: 2px solid #FFFFBB;
173 border-left: 2px solid #FFFFBB;
177 background-color: #33CC33;
178 border-right: 1px solid #009900;
179 border-bottom: 1px solid #009900;
184 background-color: #AAFFAA;
185 border-right: 1px solid #33FF33;
186 border-bottom: 1px solid #33FF33;
192 <h1>Class::MOP Browser</h1>
193 <table bgcolor='#CCCCCC' cellpadding='0' cellspacing='0' border='0' align='center' height='400'>
196 <td rowspan='2' width='200'><table cellspacing='0' cellpadding='5' border='0' width='100%'>
197 [% FOREACH metaclass IN get_all_metaclasses() %]
199 [% IF q.param('class') == metaclass.name %]
200 <td class='lightblue'><b>[% metaclass.name %]</b</td>
202 <td class='grey'><a href='?class=[% metaclass.name %]'>[% metaclass.name %]</a></td>
207 <td height='10' width='250'><table cellspacing='0' cellpadding='5' border='0' width='100%'>
209 [% FOREACH area_name IN [ 'attributes', 'methods', 'superclasses' ] %]
210 [% IF q.param('class') %]
211 [% IF area == area_name %]
212 <td class='manila'><b>[% area_name %]</b></td>
214 <td class='lightblue'><a href='?class=[% q.param('class') %]&area=[% area_name %]'>[% area_name %]</a></td>
217 <td class='lightblue' style="color: #336699;">[% area_name %]</td>
223 <td valign='top' rowspan='2' class='lightgreen' width='450'>
224 <table cellspacing='0' cellpadding='3' border='0'>
226 <td class='darkgreen' width='100'></td>
227 <td class='darkgreen' width='350'></td>
229 [% IF q.param('class') && area == 'attributes' && q.param('attr') %]
232 meta = get_metaclass_by_name(q.param('class'))
233 attr = meta.get_attribute(q.param('attr'))
236 [% FOREACH aspect IN [ 'name', 'init_arg', 'reader', 'writer', 'accessor', 'predicate', 'default' ]%]
237 [% item = attr.$aspect() %]
239 <td class='darkgreen' align='right' valign='top'>[% aspect %]</td>
240 <td class='lightgreen'>[% IF item == undef %]—[% ELSE %]<pre>[% deparse_item(item) %]</pre>[% END %]</td>
244 [% ELSIF q.param('class') && area == 'methods' && q.param('method') %]
247 meta = get_metaclass_by_name(q.param('class'))
248 method = meta.get_method(q.param('method'))
251 [% FOREACH aspect IN [ 'name', 'package_name', 'fully_qualified_name' ]%]
253 <td class='darkgreen' align='right' valign='top'>[% aspect %]</td>
254 <td class='lightgreen'>[% method.$aspect() %]</td>
258 <td class='darkgreen' align='right' valign='top'>body</td>
259 <td class='lightgreen'><pre>[% deparse_method(method) %]</pre></td>
268 [% IF q.param('class') && area %]
270 [% meta = get_metaclass_by_name(q.param('class')) %]
272 <td class='lightblue' valign='top'><div style='height: 100%; overflow: auto;'><table cellspacing='0' cellpadding='5' border='0' width='100%'>
274 [% IF area == 'methods' %]
275 [% FOREACH method IN meta.get_method_list.sort %]
277 [% IF q.param('method') == method %]
278 <td class='darkgreen'><b>[% method %]</b></td>
280 <td class='manila'><a href='?class=[% q.param('class') %]&area=[% q.param('area') %]&method=[% method %]'>[% method %]</a></td>
285 [% IF area == 'attributes' %]
286 [% FOREACH attr IN meta.get_attribute_list.sort %]
288 [% IF q.param('attr') == attr %]
289 <td class='darkgreen'><b>[% attr %]</b></td>
291 <td class='manila'><a href='?class=[% q.param('class') %]&area=[% q.param('area') %]&attr=[% attr %]'>[% attr %]</a></td>
296 [% IF area == 'superclasses' %]
297 [% FOREACH super IN meta.superclasses.sort %]
299 <td class='manila'><a href='?class=[% super %]'>[% super %]</a></td>