--- /dev/null
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Class::MOP;
+use Data::Dumper;
+use B::Deparse;
+use Template;
+use Getopt::Long;
+
+my $DATA = join "" => <DATA>;
+
+my $stand_alone = 0;
+
+GetOptions(
+ "s" => \$stand_alone,
+);
+
+if ($stand_alone) {
+ {
+ package Class::MOP::Browser::Server;
+ use strict;
+ use warnings;
+ use base qw(HTTP::Server::Simple::CGI);
+
+ sub handle_request {
+ my ($self, $cgi) = @_;
+ Template->new->process(
+ \$DATA,
+ {
+ 'get_all_metaclasses' => \&::get_all_metaclasses,
+ 'get_metaclass_by_name' => \&::get_metaclass_by_name,
+ 'deparse_method' => \&::deparse_method,
+ 'deparse_item' => \&::deparse_item,
+ }
+ ) or warn Template->error;
+ }
+ }
+
+ my $server = Class::MOP::Browser::Server->new();
+ $server->run();
+}
+else {
+
+ print CGI::header();
+
+ Template->new->process(
+ \$DATA,
+ {
+ 'get_all_metaclasses' => \&::get_all_metaclasses,
+ 'get_metaclass_by_name' => \&::get_metaclass_by_name,
+ 'deparse_method' => \&::deparse_method,
+ 'deparse_item' => \&::deparse_item,
+ }
+ ) or warn Template->error;
+}
+
+
+
+sub get_all_metaclasses {
+ sort { $a->name cmp $b->name } Class::MOP::get_all_metaclass_instances()
+}
+
+sub get_metaclass_by_name {
+ Class::MOP::get_metaclass_by_name(@_);
+}
+
+sub deparse_method {
+ my ($method) = @_;
+
+ my $deparse = B::Deparse->new("-d");
+ my $body = $deparse->coderef2text($method->body());
+
+ my @body = split /\n/ => $body;
+ my @cleaned;
+
+ foreach (@body) {
+ next if /^\s+use/;
+ next if /^\s+BEGIN/;
+ next if /^\s+package/;
+ push @cleaned => $_;
+ }
+
+ return "sub " . $method->name . ' ' . (join "\n" => @cleaned);
+}
+
+sub deparse_item {
+ my ($item) = @_;
+ return $item unless ref $item;
+ local $Data::Dumper::Deparse = 1;
+ local $Data::Dumper::Indent = 1;
+ my $dumped = Dumper $item;
+ $dumped =~ s/^\$VAR1\s=\s//;
+ $dumped =~ s/\;$//;
+
+ my @body = split /\n/ => $dumped;
+ my @cleaned;
+
+ foreach (@body) {
+ next if /^\s+use/;
+ next if /^\s+BEGIN/;
+ next if /^\s+package/;
+ push @cleaned => $_;
+ }
+
+ return (join "\n" => @cleaned);
+}
+
+1;
+
+## This is the template file to be used
+
+__DATA__
+[% USE q = CGI %]
+[% area = 'attributes' %]
+[% IF q.param('area') %]
+ [% area = q.param('area') %]
+[% END %]
+<html>
+<head>
+<title>Class::MOP Browser</title>
+<style type='text/css'>
+
+body {
+ font-family: arial;
+}
+
+td { font-size: 12px; }
+b { font-size: 12px; }
+
+pre {
+ font-family: courier;
+ font-size: 12px;
+ width: 330px;
+ padding: 10px;
+ overflow: auto;
+ border: 1px dotted green;
+}
+
+A {
+ font-family: arial;
+ font-size: 12px;
+ color: black;
+ text-decoration: none;
+}
+
+A:hover {
+ text-decoration: underline;
+}
+
+td.lightblue {
+ background-color: #99BBFF;
+ border-right: 1px solid #336699;
+ border-bottom: 1px solid #336699;
+ border-top: 1px solid #BBDDFF;
+ border-left: 1px solid #BBDDFF;
+}
+
+td.grey {
+ background-color: #CCCCCC;
+ border-right: 1px solid #888888;
+ border-bottom: 1px solid #888888;
+ border-top: 1px solid #DDDDDD;
+ border-left: 1px solid #DDDDDD;
+}
+
+td.manila {
+ background-color: #FFDD99;
+ border-right: 2px solid #CC9933;
+ border-bottom: 2px solid #CC9933;
+ border-top: 2px solid #FFFFBB;
+ border-left: 2px solid #FFFFBB;
+}
+
+td.darkgreen {
+ background-color: #33CC33;
+ border-right: 1px solid #009900;
+ border-bottom: 1px solid #009900;
+ color: #CCFFCC;
+}
+
+td.lightgreen {
+ background-color: #AAFFAA;
+ border-right: 1px solid #33FF33;
+ border-bottom: 1px solid #33FF33;
+}
+
+</style>
+</head>
+<body>
+<h1>Class::MOP Browser</h1>
+<table bgcolor='#CCCCCC' cellpadding='0' cellspacing='0' border='0' align='center' height='400'>
+<tr valign='top'>
+
+<td rowspan='2' width='200'><table cellspacing='0' cellpadding='5' border='0' width='100%'>
+ [% FOREACH metaclass IN get_all_metaclasses() %]
+ <tr>
+ [% IF q.param('class') == metaclass.name %]
+ <td class='lightblue'><b>[% metaclass.name %]</b</td>
+ [% ELSE %]
+ <td class='grey'><a href='?class=[% metaclass.name %]'>[% metaclass.name %]</a></td>
+ [% END %]
+ </tr>
+ [% END %]
+ </table></td>
+<td height='10' width='250'><table cellspacing='0' cellpadding='5' border='0' width='100%'>
+ <tr align='center'>
+ [% FOREACH area_name IN [ 'attributes', 'methods', 'superclasses' ] %]
+ [% IF q.param('class') %]
+ [% IF area == area_name %]
+ <td class='manila'><b>[% area_name %]</b></td>
+ [% ELSE %]
+ <td class='lightblue'><a href='?class=[% q.param('class') %]&area=[% area_name %]'>[% area_name %]</a></td>
+ [% END %]
+ [% ELSE %]
+ <td class='lightblue' style="color: #336699;">[% area_name %]</td>
+ [% END %]
+ [% END %]
+ </tr>
+ </table></td>
+
+<td valign='top' rowspan='2' class='lightgreen' width='450'>
+ <table cellspacing='0' cellpadding='3' border='0'>
+ <tr>
+ <td class='darkgreen' width='100'></td>
+ <td class='darkgreen' width='350'></td>
+ </tr>
+ [% IF q.param('class') && area == 'attributes' && q.param('attr') %]
+
+ [%
+ meta = get_metaclass_by_name(q.param('class'))
+ attr = meta.get_attribute(q.param('attr'))
+ %]
+
+ [% FOREACH aspect IN [ 'name', 'init_arg', 'reader', 'writer', 'accessor', 'predicate', 'default' ]%]
+ [% item = attr.$aspect() %]
+ <tr>
+ <td class='darkgreen' align='right' valign='top'>[% aspect %]</td>
+ <td class='lightgreen'>[% IF item == undef %]—[% ELSE %]<pre>[% deparse_item(item) %]</pre>[% END %]</td>
+ </tr>
+ [% END %]
+
+ [% ELSIF q.param('class') && area == 'methods' && q.param('method') %]
+
+ [%
+ meta = get_metaclass_by_name(q.param('class'))
+ method = meta.get_method(q.param('method'))
+ %]
+
+ [% FOREACH aspect IN [ 'name', 'package_name', 'fully_qualified_name' ]%]
+ <tr>
+ <td class='darkgreen' align='right' valign='top'>[% aspect %]</td>
+ <td class='lightgreen'>[% method.$aspect() %]</td>
+ </tr>
+ [% END %]
+ <tr>
+ <td class='darkgreen' align='right' valign='top'>body</td>
+ <td class='lightgreen'><pre>[% deparse_method(method) %]</pre></td>
+ </tr>
+
+ [% END %]
+ </table></td>
+
+</tr>
+<tr>
+
+[% IF q.param('class') && area %]
+
+[% meta = get_metaclass_by_name(q.param('class')) %]
+
+<td class='lightblue' valign='top'><div style='height: 100%; overflow: auto;'><table cellspacing='0' cellpadding='5' border='0' width='100%'>
+
+ [% IF area == 'methods' %]
+ [% FOREACH method IN meta.get_method_list.sort %]
+ <tr>
+ [% IF q.param('method') == method %]
+ <td class='darkgreen'><b>[% method %]</b></td>
+ [% ELSE %]
+ <td class='manila'><a href='?class=[% q.param('class') %]&area=[% q.param('area') %]&method=[% method %]'>[% method %]</a></td>
+ [% END %]
+ </tr>
+ [% END %]
+ [% END %]
+ [% IF area == 'attributes' %]
+ [% FOREACH attr IN meta.get_attribute_list.sort %]
+ <tr>
+ [% IF q.param('attr') == attr %]
+ <td class='darkgreen'><b>[% attr %]</b></td>
+ [% ELSE %]
+ <td class='manila'><a href='?class=[% q.param('class') %]&area=[% q.param('area') %]&attr=[% attr %]'>[% attr %]</a></td>
+ [% END %]
+ </tr>
+ [% END %]
+ [% END %]
+ [% IF area == 'superclasses' %]
+ [% FOREACH super IN meta.superclasses.sort %]
+ <tr>
+ <td class='manila'><a href='?class=[% super %]'>[% super %]</a></td>
+ </tr>
+ [% END %]
+ [% END %]
+ </table></div></td>
+[% END %]
+
+</tr>
+</table>
+</body>
+</html>
+
projects / gitmo/Class-MOP.git / commitdiff