eg/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