--- trunk/lib/Frey/Introspect.pm 2008/07/02 22:30:19 50 +++ trunk/lib/Frey/Introspect.pm 2008/07/08 12:19:04 59 @@ -8,6 +8,10 @@ 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'; @@ -17,8 +21,18 @@ required => 1, ); -sub examine { - my ($self) = @_; +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; @@ -32,12 +46,13 @@ 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 $@; - #get on with analyzing the package + #eval { Class::MOP::load_class($package); }; + #confess "Failed to load package ${package} $@" if $@; + Class::MOP::load_class($package); + my $meta = $package->meta; - my $spec = {}; + my ($class, $is_role); if($package->meta->isa('Moose::Meta::Role')){ $is_role = 1; @@ -47,6 +62,22 @@ } else { #roles don't have superclasses ... $class = $meta; + } + return ( $class, $meta, $is_role ); +} + +=head2 joose + + my $js = $o->joose( 'Some::Package' ); + +=cut + +sub joose { + my ($self) = @_; + + my ( $class, $meta, $is_role ) = $self->load_package; + + if ( ! $is_role ) { my @superclasses = map{ $_->meta->name } grep { $_ ne 'Moose::Object' } $meta->superclasses; warn "superclasses ",dump( @superclasses ); @@ -55,7 +86,7 @@ my $out; my ( $m, $c ) = split(/::/, $class->name, 2); - my $filename = "$m.$c.js"; + my $filename = $m . '.' . ( $c ? "$c." : '' ) . 'js'; $out .= "Module(\"$m\", function (m) {\n\tClass(\"$c\", {\n\t\thas: {\n"; @@ -84,6 +115,12 @@ } + $out .= "\t\t},\n\t\tmeta: Frey.HTML, + classMethods: { + renderHTML: function () { + return new Joose.SimpleRequest().getText(\"/~/${m}::${c}\") + },\n"; + $out .= "\t\t},\n"; $out .= "\t}),\n"; @@ -95,15 +132,129 @@ warn $class->dump(2); - warn "get_attribute_list = ",dump( $class->get_attribute_list ); -# warn dump( map{ $class->get_attribute($_) } sort $class->get_attribute_list ); + warn "method_list = ",dump( $class->get_method_list ); + warn dump( map{ $class->get_method($_)->name } sort $class->get_method_list ); - warn dump( $class->get_method_list ); - - print $out; +# print $out; my $path = "static/blib/$filename"; write_file( $path, $out ); warn "# created $path\n"; + $self->path( $path ); + + return $out; +} + +=head2 methods + + my @methods = $o->methods; + +=cut + +sub methods { + my $self = shift; + + my ( $class, $meta, $is_role ) = $self->load_package; + + my $attr; + $attr->{$_}++ foreach $class->get_attribute_list; + my @methods = grep { ! defined($attr->{$_}) } $class->get_method_list; + warn "# methods = ",dump( @methods ); + + return @methods; +} + +=head1 OUTPUT GENERATION + +=head2 html + + $o->html( $request ); + +=cut + +our @javascript = ( qw' +../lib/Joose.js +'); + +sub html { + my ( $self, $request ) = @_; + + while (1) { + + my $js = Continuity::Widget::DomNode->create( + map { + ( script => { type => 'text/javascript', src => $_ } ) + } @javascript + )->to_string; + + $js .= << '__END_OF_JS__'; + +__END_OF_JS__ + + warn "# >>> js\n$js\n"; + + my $methods; + + my ( $class, $meta, $is_role ); + eval { ( $class, $meta, $is_role ) = $self->load_package(); }; + if ( $@ ) { + warn "ERROR: $@"; + $request->conn->send_status_line( 500, $@ ); + $request->print( $@ ); + $request->next; + return; + } + + if ( $class->can('meta') ) { + $methods = Continuity::Widget::DomNode->create( + ul => [ + map { ( + li => [ a => { href => '/~/' . $self->package . '/' . $_ } => [ $_ ] ] + ) } $self->methods + ] + )->to_string; + } else { + $methods = 'not introspectable'; + } + + my $attributes = Continuity::Widget::DomNode->create( + ul => [ + map { + my $attr = $class->get_attribute($_); + warn "## $_ ", $attr->is_required ? 'required' : 'optional'; + ( li => [ a => { href => '/~/' . $self->package . '/' . $_ } => [ $_ ], ( $attr->is_required ? ' required' : '' ) ] ) + } $class->get_attribute_list + ], + )->to_string; + + my $doc = Continuity::Widget::DomNode->create( + html => [ + head => [ + link => { rel=>"stylesheet", href=>"/static/app.css", type=>"text/css", media=>"screen" }, + $js, + title => [ 'Introspect ', $self->package ], + ], + body => [ + h1 => [ $self->package ], + h2 => [ 'Methods' ], + $methods, + h2 => [ 'Atrributes' ], + $attributes, + ], + ] + ); + + $request->print($doc->to_string); + warn "# >>> html\n", $doc->to_string, "\n"; + $request->next; + } + warn "# exit html"; } =head1 SEE ALSO