--- trunk/lib/Frey/Introspect.pm 2008/07/13 18:01:40 116 +++ trunk/lib/Frey/Introspect.pm 2008/11/05 19:57:49 310 @@ -10,10 +10,10 @@ use lib 'lib'; -extends 'Frey'; +extends 'Frey::ClassLoader'; with 'Frey::Web'; -has 'package' => ( +has 'class' => ( is => 'rw', isa => 'Str', required => 1, @@ -25,14 +25,14 @@ =head2 joose - my $js = $o->joose( 'Some::Package' ); + my $js = $o->joose; =cut sub joose { my ($self) = @_; - my ( $class, $meta, $is_role ) = $self->load_package; + my ( $meta, $is_role ) = $self->class_meta; if ( ! $is_role ) { my @superclasses = map{ $_->meta->name } @@ -42,15 +42,17 @@ my $out; - my ( $m, $c ) = split(/::/, $class->name, 2); + my ( $m, $c ) = split(/::/, $self->class, 2); my $filename = $m . '.' . ( $c ? "$c." : '' ) . 'js'; + $c ||= ''; + $out .= "Module(\"$m\", function (m) {\n\tClass(\"$c\", {\n\t\thas: {\n"; - foreach ( $class->get_attribute_list ) { + foreach ( $meta->get_attribute_list ) { $out .= "\t\t\t$_: {\n"; - my $attr = $class->get_attribute($_); + my $attr = $meta->get_attribute($_); my $is = $attr->_is_metadata; $out .= "\t\t\t\tis: \"$is\",\n" if defined $is; $out .= "\t\t\t\tlazy: true,\n" if $attr->is_lazy; @@ -75,7 +77,7 @@ $out .= "\t\t},\n\t\tmeta: Frey.HTML, classMethods: { renderHTML: function () { - return new Joose.SimpleRequest().getText(\"/~/" . $self->package . "\") + return new Joose.SimpleRequest().getText(\"/" . $self->class . "\") },\n"; $out .= "\t\t},\n"; @@ -85,9 +87,9 @@ $out =~ s/,\n$/\n/; $out .= "});\n"; - $out .= "\nconsole.log( 'loaded " . $class->name . " from $filename' );\n"; + $out .= "\nconsole.log( 'loaded " . $self->class . " from $filename' );\n"; - warn "method_list = ",dump( $class->get_method_list ) if $self->debug; + warn "method_list = ",dump( $meta->get_method_list ) if $self->debug; # print $out; my $path = "static/blib/$filename"; @@ -107,105 +109,130 @@ sub methods { my $self = shift; - my ( $class, $meta, $is_role ) = $self->load_package; + my ( $meta, $is_role ) = $self->class_meta; my $attr; - $attr->{$_}++ foreach $class->get_attribute_list; - my @methods = grep { ! defined($attr->{$_}) } $class->get_method_list; + $attr->{$_}++ foreach $meta->get_attribute_list; + my @methods = grep { ! defined($attr->{$_}) } $meta->get_method_list; 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 +=head2 markup - $o->html( $request ); + $o->markup; =cut -sub html { - my ( $self, $request ) = @_; +sub markup { + my ( $self ) = @_; - while (1) { + $self->add_head( 'static/introspect.css' ); - my $js = $self->head_javascript; - $js .= << '__END_OF_JS__'; - -__END_OF_JS__ - - my ( $class, $meta, $is_role ) = $self->load_package; - - my $methods; - if ( $class->can('meta') ) { - $methods = dom2html( - ul => [ - map { ( - li => [ a => { href => '/~/' . $self->package . '/' . $_ } => [ $_ ] ] - ) } $self->methods - ] - ); - $methods = "
| . $_->meta->dump(2) . qq|
|;
+ }
+ #grep { $_ ne 'Moose::Object' }
+ $meta->superclasses
+ );
}
+ }
+ my $role_method;
- my $html = dom2html(
- html => [
- head => [
- link => { rel=>"stylesheet", href=>"/static/app.css", type=>"text/css", media=>"screen" },
- $js,
- title => [ 'Introspect ', $self->package ],
- ],
- body => [
- h1 => [ $self->package ],
- $methods,
- $attributes,
- ],
- ]
+ if ( $meta->can('roles') ) {
+ my $role_nr = 1;
+ $roles = join(' ',
+ grep { ! m/\Q$class\E/ } # skip me
+ map {
+ my $name = $_->name;
+ $role_method->{ $_ }->{$name} = $role_nr foreach $_->get_method_list;
+ qq|$name| . $name->meta->dump(2) . qq|
| . $role_nr++ . qq||;
+ }
+ $meta->calculate_all_roles
);
+ $roles = qq| with roles: $roles| if $roles;
+ }
+ warn "# role_method ",dump( $role_method );
+
+ my @methods;
+ @methods = map {
+ my $method = $_;
+ if ( $role_method ) {
+ my ( $name, $nr ) = each %{ $role_method->{$_} };
+ $method .= qq|$nr|;
+ }
+ qq|' . dump( $attr->$getter ) . '
' if $getter ne $check;
+ $after .= '';
+ }
+ }
+ $after .= ' ';
+ }
+ my $type = $attr->has_type_constraint ? $attr->type_constraint->name : '';
+ qq|Methods | Attributes | Type | Properties | '; + $a ||= ' | '; + $table .= qq| |
---|---|---|---|