From: Stevan Little Date: Wed, 13 Sep 2006 03:40:21 +0000 (+0000) Subject: more browser hackin X-Git-Tag: 0_35~7 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=dbc791f9a24445a95a24c758464ab00ea6f8c571;p=gitmo%2FClass-MOP.git more browser hackin --- diff --git a/scripts/class_browser.pl b/scripts/class_browser.pl index b79d9b0..095234d 100644 --- a/scripts/class_browser.pl +++ b/scripts/class_browser.pl @@ -3,60 +3,47 @@ use strict; use warnings; -use Class::MOP; use Data::Dumper; use B::Deparse; use Template; use Getopt::Long; +use CGI; -my $DATA = join "" => ; +use Class::MOP; my $stand_alone = 0; - -GetOptions( - "s" => \$stand_alone, -); +GetOptions("s" => \$stand_alone); if ($stand_alone) { + require HTTP::Server::Simple::CGI; { - 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; - } + package # hide me from PAUSE + Class::MOP::Browser::Server; + our @ISA = qw(HTTP::Server::Simple::CGI); + sub handle_request { ::process_template() } } - - my $server = Class::MOP::Browser::Server->new(); - $server->run(); + Class::MOP::Browser::Server->new()->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; + process_template(); } - +{ + my $DATA; + sub process_template { + $DATA ||= join "" => ; + 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() @@ -68,21 +55,9 @@ sub 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); + return "sub " . $method->name . ' ' . _clean_deparse_code($body); } sub deparse_item { @@ -93,18 +68,19 @@ sub deparse_item { my $dumped = Dumper $item; $dumped =~ s/^\$VAR1\s=\s//; $dumped =~ s/\;$//; + return _clean_deparse_code($dumped); +} - my @body = split /\n/ => $dumped; +sub _clean_deparse_code { + my @body = split /\n/ => $_[0]; my @cleaned; - foreach (@body) { next if /^\s+use/; next if /^\s+BEGIN/; next if /^\s+package/; push @cleaned => $_; - } - - return (join "\n" => @cleaned); + } + return (join "\n" => @cleaned); } 1; @@ -113,10 +89,12 @@ sub deparse_item { __DATA__ [% USE q = CGI %] + [% area = 'attributes' %] [% IF q.param('area') %] [% area = q.param('area') %] [% END %] + Class::MOP Browser @@ -197,7 +175,7 @@ td.lightgreen { [% FOREACH metaclass IN get_all_metaclasses() %] [% IF q.param('class') == metaclass.name %] - [% metaclass.name %] + [% metaclass.name %] [% ELSE %] [% metaclass.name %] [% END %]