--- trunk/lib/Frey/Introspect.pm 2008/11/05 19:13:01 308 +++ trunk/lib/Frey/Introspect.pm 2008/11/16 16:36:53 358 @@ -136,13 +136,56 @@ 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); + warn "## ref attr: ",ref( $attr ); my ( $before, $title, $after ) = ( '', '', '' ); ( $before, $title, $after ) = ( '', ' title="required"', '' ) if $attr->is_required; warn $attr->dump(3); @@ -165,11 +208,17 @@ $after .= ' '; } my $type = $attr->has_type_constraint ? $attr->type_constraint->name : ''; - qq|$before $_$type$after| + + 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|
MethodsAttributesTypeProperties
|; while ( @methods || @attributes ) { my ($m,$a) = ( shift @methods, shift @attributes ); $m ||= ''; @@ -178,47 +227,20 @@ } $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; - my $execute = join("\n", map { qq|$_| } grep { $class->can($_) } Frey::Run->execute ); - $execute = " execute: $execute" if $execute; + my $runnable = join("\n", map { qq|$_| } grep { $class->can($_) } Frey::Run->runnable ); + $runnable = " runnable: $runnable" if $runnable; - my $html = $self->page( + my $html = { title => "Introspect $class", body => qq|

$class

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