Test that stub functions are handled like every other function.
[gitmo/Class-MOP.git] / scripts / class_browser.pl
1 #!/usr/bin/perl
2
3 use strict;
4 use warnings;
5
6 use Data::Dumper;
7 use B::Deparse;
8 use Template;
9 use Getopt::Long;
10 use CGI;
11
12 use Class::MOP;
13
14 my $stand_alone = 0;
15 GetOptions("s" => \$stand_alone);
16
17 if ($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() }
24     }    
25     Class::MOP::Browser::Server->new()->run();    
26 }
27 else {
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             }
44         ) or warn Template->error;        
45     }
46 }
47
48 sub get_all_metaclasses { 
49     sort { $a->name cmp $b->name } Class::MOP::get_all_metaclass_instances() 
50 }
51     
52 sub get_metaclass_by_name { 
53     Class::MOP::get_metaclass_by_name(@_); 
54 }
55
56 sub 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
63 sub 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/\;$//;    
71     return _clean_deparse_code($dumped);
72 }
73
74 sub _clean_deparse_code {
75     my @body = split /\n/ => $_[0];
76     my @cleaned;
77     foreach (@body) {
78         next if /^\s+use/;
79         next if /^\s+BEGIN/;        
80         next if /^\s+package/;        
81         push @cleaned => $_;
82     }  
83     return (join "\n" => @cleaned);  
84 }
85
86 1;
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
103 body {
104     font-family: arial;
105 }
106
107 td { font-size: 12px; }
108 b  { font-size: 12px; }
109
110 pre {
111     font-family: courier;
112     font-size:   12px;
113     width:       330px;
114     padding:     10px;
115     overflow:    auto;
116     border:      1px dotted green;
117 }
118
119 A { 
120     font-family: arial;
121     font-size:   12px;    
122     color: black;
123     text-decoration: none;
124 }
125
126 A:hover {
127     text-decoration: underline;    
128 }
129                                 
130 td.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
138 td.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
146 td.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
154 td.darkgreen  { 
155     background-color: #33CC33; 
156     border-right:  1px solid #009900; 
157     border-bottom: 1px solid #009900; 
158     color: #CCFFCC;    
159 }
160
161 td.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 %]
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%'>
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