--- trunk/lib/Frey/Introspect.pm 2008/11/05 08:20:59 288 +++ trunk/lib/Frey/Introspect.pm 2008/11/05 20:12:50 313 @@ -10,7 +10,7 @@ use lib 'lib'; -extends 'Frey'; +extends 'Frey::ClassLoader'; with 'Frey::Web'; has 'class' => ( @@ -32,7 +32,7 @@ sub joose { my ($self) = @_; - my ( $meta, $is_role ) = $self->load_class; + my ( $meta, $is_role ) = $self->class_meta; if ( ! $is_role ) { my @superclasses = map{ $_->meta->name } @@ -77,7 +77,7 @@ $out .= "\t\t},\n\t\tmeta: Frey.HTML, classMethods: { renderHTML: function () { - return new Joose.SimpleRequest().getText(\"/Frey-Introspect?class=" . $self->class . "\") + return new Joose.SimpleRequest().getText(\"/" . $self->class . "\") },\n"; $out .= "\t\t},\n"; @@ -109,7 +109,7 @@ sub methods { my $self = shift; - my ( $meta, $is_role ) = $self->load_class; + my ( $meta, $is_role ) = $self->class_meta; my $attr; $attr->{$_}++ foreach $meta->get_attribute_list; @@ -119,14 +119,6 @@ return sort @methods; } -use Frey::ClassLoader; - -sub load_class { - my $self = shift; - return Frey::ClassLoader->load_package( $self->class ); -} - - =head1 OUTPUT GENERATION =head2 markup @@ -140,17 +132,59 @@ $self->add_head( 'static/introspect.css' ); - my ( $meta, $is_role ) = $self->load_class; + my ( $meta, $is_role ) = $self->class_meta; my $class = $self->class; + my ( $superclasses, $roles ) = ( 'Role', '' ); + if ( ! $is_role ) { + if ( $meta->superclasses ) { + $superclasses = 'Superclasses: ' . + join(', ', + map { + my $name = $_->meta->name; + qq|$name| . $_->meta->dump(2) . qq||; + } + #grep { $_ ne 'Moose::Object' } + $meta->superclasses + ); + } + } + + my $role_method; + my $role_attribute; + + 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; + $role_attribute->{ $_ }->{$name} = $role_nr foreach $_->get_attribute_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 { qq|$_| } $self->methods; + @methods = map { + my $name = $_; + if ( $role_method->{$name} ) { + my ( $role_name, $nr ) = each %{ $role_method->{$name} }; + $name .= qq|$nr|; + } + qq|$name| + } $self->methods; my @attributes; if ( $meta->get_attribute_list ) { @attributes = map { - my $attr = $meta->get_attribute($_); + my $name = $_; + my $attr = $meta->get_attribute($name); my ( $before, $title, $after ) = ( '', '', '' ); ( $before, $title, $after ) = ( '', ' title="required"', '' ) if $attr->is_required; warn $attr->dump(3); @@ -172,11 +206,18 @@ } $after .= ' '; } - qq|$before $_$after| + my $type = $attr->has_type_constraint ? $attr->type_constraint->name : ''; + + if ( $role_attribute->{$name} ) { + my ( $role_name, $nr ) = each %{ $role_attribute->{$name} }; + $name .= qq|$nr|; + } + + qq|$before $name$type$after| } sort $meta->get_attribute_list } - my $table = qq||; + my $table = qq|
MethodsAttributesProperties
|; while ( @methods || @attributes ) { my ($m,$a) = ( shift @methods, shift @attributes ); $m ||= ''; @@ -185,33 +226,6 @@ } $table .= qq|
MethodsAttributesTypeProperties
|; - my ( $superclasses, $roles ) = ( 'Role', '' ); - if ( ! $is_role ) { - if ( $meta->superclasses ) { - $superclasses = 'Superclasses: ' . - join(', ', - map { - my $name = $_->meta->name; - qq|$name| . $_->meta->dump(2) . qq||; - } - #grep { $_ ne 'Moose::Object' } - $meta->superclasses - ); - } - } - - if ( $meta->can('roles') ) { - $roles = join(', ', - grep { ! m/\Q$class\E/ } # skip me - map { - my $name = $_->name; - qq|$name| . $name->meta->dump(2) . qq||; - } - $meta->calculate_all_roles - ); - $roles = " with roles: $roles" if $roles; - } - my $pod = Frey::Pod->new( class => $class )->markup; use Frey::Run; @@ -221,9 +235,9 @@ my $html = $self->page( title => "Introspect $class", body => qq|

$class

| - . qq|$superclasses\n$roles\n$execute\n| + . qq|
$superclasses\n$roles\n$execute\n| . ( $pod ? qq|↓pod&darr| : '' ) - . qq|$table\n$pod| + . qq|$table\n$pod
| );