[Moose-commits] r7395 - in Class-OWL/trunk: . examples lib/Class
leifj at code2.0beta.co.uk
leifj at code2.0beta.co.uk
Tue Jan 27 13:33:22 GMT 2009
Author: leifj
Date: 2009-01-27 05:33:22 -0800 (Tue, 27 Jan 2009)
New Revision: 7395
Added:
Class-OWL/trunk/examples/class_browser.pl
Modified:
Class-OWL/trunk/Build.PL
Class-OWL/trunk/lib/Class/OWL.pm
Log:
samples
Modified: Class-OWL/trunk/Build.PL
===================================================================
--- Class-OWL/trunk/Build.PL 2009-01-27 12:59:03 UTC (rev 7394)
+++ Class-OWL/trunk/Build.PL 2009-01-27 13:33:22 UTC (rev 7395)
@@ -12,6 +12,10 @@
'version' => 0,
'Class::MOP' => 0,
'XML::CommonNS' => 0,
+ 'RDF::Helper' => 0,
+ 'Data::Dumper' => 0,
+ 'LWP::Simple' => 0
+
},
add_to_cleanup => [ 'Class-OWL-*' ],
);
Added: Class-OWL/trunk/examples/class_browser.pl
===================================================================
--- Class-OWL/trunk/examples/class_browser.pl (rev 0)
+++ Class-OWL/trunk/examples/class_browser.pl 2009-01-27 13:33:22 UTC (rev 7395)
@@ -0,0 +1,288 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Data::Dumper;
+use B::Deparse;
+use Template;
+use Getopt::Long;
+use CGI;
+
+use Class::MOP;
+
+my $stand_alone = 0;
+GetOptions("s" => \$stand_alone);
+
+if ($stand_alone) {
+ require HTTP::Server::Simple::CGI;
+ {
+ package # hide me from PAUSE
+ Class::MOP::Browser::Server;
+ our @ISA = qw(HTTP::Server::Simple::CGI);
+ sub handle_request { ::process_template() }
+ }
+ Class::MOP::Browser::Server->new()->run();
+}
+else {
+ print CGI::header();
+ process_template();
+}
+
+{
+ my $DATA;
+ sub process_template {
+ $DATA ||= join "" => <DATA>;
+ 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 { warn $a->name,";",$b->name,"\n" unless $a->name && $b->name ; $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());
+ return "sub " . $method->name . ' ' . _clean_deparse_code($body);
+}
+
+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/\;$//;
+ return _clean_deparse_code($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);
+}
+
+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>
+
Modified: Class-OWL/trunk/lib/Class/OWL.pm
===================================================================
--- Class-OWL/trunk/lib/Class/OWL.pm 2009-01-27 12:59:03 UTC (rev 7394)
+++ Class-OWL/trunk/lib/Class/OWL.pm 2009-01-27 13:33:22 UTC (rev 7395)
@@ -140,7 +140,7 @@
package Class::OWL;
-use version; $VERSION = qv('0.0.5');
+use version; $VERSION = qv('0.0.6');
use warnings;
use strict;
More information about the Moose-commits
mailing list