/[Frey]/branches/mojo/lib/Frey/Introspect.pm

This is repository of my old source code which isn't updated any more. Go to git.rot13.org for current projects!

Diff of /branches/mojo/lib/Frey/Introspect.pm

Parent Directory | Revision Log | View Patch Patch

-revision 53 by dpavlin,
Sat Jul  5 15:19:55 2008 UTC
+revision 120 by dpavlin,
Sun Jul 13 19:46:10 2008 UTC
 Line 2 
 package Frey::Introspect;
  use Moose;
  use Carp;
- use Class::MOP;
+ #use Moose::Meta::Role;
- use Moose::Meta::Role;
+ #use Moose::Meta::Class;
- use Moose::Meta::Class;
- use Scalar::Util qw/blessed/;
  use Data::Dump qw/dump/;
  use File::Slurp;
  use List::Util;
- use Continuity::Widget::DomNode;
+ use lib 'lib';
  extends 'Frey';
+ with 'Frey::Web';
  has 'package' => (
          is => 'rw',
-Line 24 
 has 'path' => (
+Line 23 
 has 'path' => (
          is => 'rw',
  );
- =head2 load_package
-   my ( $class, $meta, $is_role ) = $o->load_package( 'Some::Package' );
- =cut
- sub load_package {
-         my ( $self ) = @_;
-         my $package = $self->package;
-         #intercept role application so we can accurately generate
-         #method and attribute information for the parent class.
-         #this is fragile, but there is not better way that i am aware of
-         my $rmeta = Moose::Meta::Role->meta;
-         $rmeta->make_mutable if $rmeta->is_immutable;
-         my $original_apply = $rmeta->get_method("apply")->body;
-         $rmeta->remove_method("apply");
-         my @roles_to_apply;
-         $rmeta->add_method("apply", sub{push(@roles_to_apply, [@_])});
-         #load the package with the hacked Moose::Meta::Role
-         eval { Class::MOP::load_class($package); };
-         confess "Failed to load package ${package} $@" if $@;
-         my $meta = $package->meta;
-         my ($class, $is_role);
-         if($package->meta->isa('Moose::Meta::Role')){
-                 $is_role = 1;
-                 # we need to apply the role to a class to be able to properly introspect it
-                 $class = Moose::Meta::Class->create_anon_class;
-                 $original_apply->($meta, $class);
-         } else {
-                 #roles don't have superclasses ...
-                 $class = $meta;
-         }
-         return ( $class, $meta, $is_role );
- }
  =head2 joose
    my $js = $o->joose( 'Some::Package' );
-Line 77 
 sub joose {
+Line 37 
 sub joose {
          if ( ! $is_role ) {
                  my @superclasses = map{ $_->meta->name }
                          grep { $_ ne 'Moose::Object' } $meta->superclasses;
-                 warn "superclasses ",dump( @superclasses );
+                 warn "superclasses ",dump( @superclasses ) if $self->debug;
          }
          my $out;
-Line 115 
 sub joose {
+Line 75 
 sub joose {
          $out .= "\t\t},\n\t\tmeta: Frey.HTML,
                  classMethods: {
                          renderHTML: function () {
-                                 return new Joose.SimpleRequest().getText(\"inspect?module=$m;class=$c\")
+                                 return new Joose.SimpleRequest().getText(\"/~/" . $self->package . "\")
                          },\n";
          $out .= "\t\t},\n";
-Line 127 
 sub joose {
+Line 87 
 sub joose {
          $out .= "\nconsole.log( 'loaded " . $class->name . " from $filename' );\n";
-         warn $class->dump(2);
+         warn "method_list = ",dump( $class->get_method_list ) if $self->debug;
-         warn "method_list = ",dump( $class->get_method_list );
-         warn dump( map{ $class->get_method($_)->name } sort $class->get_method_list );
  #       print $out;
          my $path = "static/blib/$filename";
-Line 155 
 sub methods {
+Line 112 
 sub methods {
          my $attr;
          $attr->{$_}++ foreach $class->get_attribute_list;
          my @methods = grep { ! defined($attr->{$_}) } $class->get_method_list;
-         warn "# methods = ",dump( @methods );
+         warn "# methods = ",dump( @methods ) if $self->debug;
-         return @methods;
+         return sort @methods;
  }
+ use Frey::ClassLoader;
+ sub load_package {
+         my $self = shift;
+         return Frey::ClassLoader->load_package( $self->package );
+ }
  =head1 OUTPUT GENERATION
  =head2 html
-Line 168 
 sub methods {
+Line 133 
 sub methods {
  =cut
- our @javascript = ( qw'
- ../lib/Joose.js
- ');
  sub html {
          my ( $self, $request ) = @_;
          while (1) {
-                 my $js = [ map {
+                 my $js = $self->head_javascript;
-                         ( script => { type => 'text/javascript', src => $_ } )
+                 $js .= << '__END_OF_JS__';
-                 } @javascript ];
+ <script type="text/javascript">
-                 warn "# js = ",dump( $js );
+ joose.loadComponents("../lib")
-                 my $o;
+ function $(id) {
+         return document.getElementById(id)
-                 my ( $class, $meta, $is_role ) = $self->load_package();
+ }
-                 if ( $class->can('meta') ) {
-                         $o = Continuity::Widget::DomNode->create(
+ </script>
-                                 ul => [
+ __END_OF_JS__
-                                         map { (
-                                                 li => [ a => { href => $_ } => [ $_ ] ]
+                 my ( $class, $meta, $is_role ) = $self->load_package;
-                                         ) } $self->methods
-                                 ]
+                 my $package = $self->package;
-                         )->to_string;
-                 } else {
+                 my @methods;
-                         $o = '<b>not introspectable</b>';
+                 @methods = map { qq|<td><a href="/~/$package/$_">$_</a></td>| } $self->methods if $class->can('meta');
+                 my @attributes;
+                 if ( $class->get_attribute_list ) {
+                 @attributes = map {
+                                 my $attr = $class->get_attribute($_);
+ #                               warn "## $_ ", $attr->is_required ? 'required' : 'optional';
+                                 qq|<td><a href="/~/$package/$_?">$_</a></td><td>| .
+                                 ( $attr->is_required ? ' <b>required</b>' : '' ) .
+                                 qq|</td>|;
+                         } sort $class->get_attribute_list
                  }
-                 warn "# o = ",dump( $o );
+                 my $table = qq|<table><tr><th>Methods</th><th>Attributes</th></tr>|;
+                 while ( @methods || @attributes ) {
-                 my $doc = Continuity::Widget::DomNode->create(
+                         my ($m,$a) = ( shift @methods, shift @attributes );
+                         $m ||= '<td></td>';
+                         $a ||= '<td></td>';
+                         $table .= qq|<tr>$m$a</tr>|;
+                 }
+                 $table .= qq|</table>|;
+                 my $classes =
+                         qq|<div class="classes">| .
+                         Frey::ClassBrowser->new->html_markup .
+                         qq|</div>|;
+                 my $html = dom2html(
                          html => [
                                  head => [
                                          link => { rel=>"stylesheet", href=>"/static/app.css", type=>"text/css", media=>"screen" },
- #                                       $js,
+                                         $js,
+                                         title => [ 'Introspect ', $self->package ],
                                  ],
                                  body => [
-                                         h1 => [ 'Introspect ', $self->package ],
+                                         h1 => [ $self->package ],
-                                         $o,
+                                         $table,
+                                         $classes,
                                  ],
                          ]
                  );
-                 $request->print($doc->to_string);
+                 $request->print($html);
-                 warn "# html = ", $doc->to_string;
+                 warn "# >>> html ",length($html)," bytes\n";
                  $request->next;
          }
          warn "# exit html";

 Legend:



Removed from v.53
 


changed lines


 
Added in v.120
 Legend:



Removed from v.53
 


changed lines


 
Added in v.120
-Removed from v.53
+Added in v.120

	ViewVC Help
Powered by ViewVC 1.1.26