From: Stevan Little Date: Tue, 12 Sep 2006 14:17:33 +0000 (+0000) Subject: Class-MOP-Browser need to be a bulky Catalyst App, a single file script will suffice X-Git-Tag: 0_35~8 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=085f1c7114835b4b82014e581a61c41a8477bd66;p=gitmo%2FClass-MOP.git Class-MOP-Browser need to be a bulky Catalyst App, a single file script will suffice --- diff --git a/scripts/class_browser.pl b/scripts/class_browser.pl new file mode 100644 index 0000000..b79d9b0 --- /dev/null +++ b/scripts/class_browser.pl @@ -0,0 +1,310 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +use Class::MOP; +use Data::Dumper; +use B::Deparse; +use Template; +use Getopt::Long; + +my $DATA = join "" => ; + +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 %] + + +Class::MOP Browser + + + +

Class::MOP Browser

+ + + + + + + + + + + +[% IF q.param('class') && area %] + +[% meta = get_metaclass_by_name(q.param('class')) %] + + +[% END %] + + +

+ [% FOREACH metaclass IN get_all_metaclasses() %] + + [% IF q.param('class') == metaclass.name %] + + [% END %] + + [% END %] +

[% metaclass.name %] + [% ELSE %] +

[% metaclass.name %]

+ + [% FOREACH area_name IN [ 'attributes', 'methods', 'superclasses' ] %] + [% IF q.param('class') %] + [% IF area == area_name %] + + [% ELSE %] + + [% END %] + [% ELSE %] + + [% END %] + [% END %] + +

[% area_name %]

[% area_name %]

+ + + + + + [% 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() %] + + + + + [% 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' ]%] + + + + + [% END %] + + + + + + [% END %] +


[% aspect %]	[% IF item == undef %]—[% ELSE %] [% deparse_item(item) %] [% END %]
[% aspect %]	[% method.$aspect() %]
body	[% deparse_method(method) %]

+ + [% IF area == 'methods' %] + [% FOREACH method IN meta.get_method_list.sort %] + + [% IF q.param('method') == method %] + + [% ELSE %] + + [% END %] + + [% END %] + [% END %] + [% IF area == 'attributes' %] + [% FOREACH attr IN meta.get_attribute_list.sort %] + + [% IF q.param('attr') == attr %] + + [% ELSE %] + + [% END %] + + [% END %] + [% END %] + [% IF area == 'superclasses' %] + [% FOREACH super IN meta.superclasses.sort %] + + + + [% END %] + [% END %] +

[% method %]	[% method %]
[% attr %]	[% attr %]
[% super %]

+ + +