--- trunk/lib/Frey/Introspect.pm 2008/12/01 23:28:27 662 +++ trunk/lib/Frey/Introspect.pm 2008/12/24 12:43:41 884 @@ -11,9 +11,8 @@ use PPI; use PPI::HTML; -use Frey::Pod; - use lib 'lib'; +use Frey::Pod; extends 'Frey::PPI'; with 'Frey::Web'; @@ -109,10 +108,11 @@ my ( $meta, $is_role ) = $self->class_meta; my $class = $self->class; + $self->title( $class ); my $introspect_path = "var/introspect/$class.yaml"; $self->mkbasepath( $introspect_path ); - my $introspect = $self->load( $introspect_path ); + my $introspect; # FIXME update with = $self->load( $introspect_path ); my ( $superclasses, $roles ) = ( 'Role', '' ); if ( ! $is_role ) { @@ -121,7 +121,7 @@ join(', ', map { my $name = $_->meta->name; - $introspect->{superclass}->{$name}++; + $introspect->{superclass}->{$name} = {}; $self->dropdown( $name, $_->meta ) } #grep { $_ ne 'Moose::Object' } @@ -130,8 +130,8 @@ } } - my $role_method; - my $role_attribute; + my $method_from_role; + my $attribute_from_role; if ( $meta->can('roles') ) { my $role_nr = 1; @@ -139,41 +139,47 @@ grep { ! m/\Q$class\E/ } # skip me map { my $name = $_->name; - $introspect->{role}->{$name}++; - $role_method->{ $_ }->{$name} = $role_nr foreach $_->get_method_list; - $role_attribute->{ $_ }->{$name} = $role_nr foreach $_->get_attribute_list; + $introspect->{roles}->{$name} = {}; + $method_from_role->{ $_ }->{$name} = $role_nr foreach $_->get_method_list; + $attribute_from_role->{ $_ }->{$name} = $role_nr foreach $_->get_attribute_list; $self->dropdown( $name, $name->meta ) . qq|| . $role_nr++ . qq||; } $meta->calculate_all_roles ); $roles = qq| with roles: $roles| if $roles; } - warn "# role_method ",dump( $role_method ); + warn "# method_from_role ",dump( $method_from_role ); my @methods; @methods = map { my $name = $_; - $introspect->{method}->{$name}++; - if ( $role_method->{$name} ) { - my ( $role_name, $nr ) = each %{ $role_method->{$name} }; + if ( $method_from_role->{$name} ) { + my ( $role_name, $nr ) = each %{ $method_from_role->{$name} }; + $introspect->{methods}->{$name}->{role} = $role_name; $name .= qq|$nr|; + } else { + $introspect->{methods}->{$name} = {}; } qq|$name| + } sort { + lc($a) cmp lc($b) } $self->class_methods( $class ); my @attributes; if ( $meta->get_attribute_list ) { @attributes = map { my $name = $_; - $introspect->{attribute}->{$name}++; + $introspect->{attribute}->{$name} = {}; my $html_name = $name; my $attr = $meta->get_attribute($name); confess "$class attribute $name isn't blessed ",dump( $attr ) unless blessed $attr; warn "## attr $name ref ",ref( $attr ) if $self->debug; my ( $title, $properties ) = ( '', '' ); - ( $html_name, $title ) = ( "$name", ' title="required"' ) - if $attr->can('is_required') && $attr->is_required; + if ( $attr->can('is_required') && $attr->is_required ) { + ( $html_name, $title ) = ( "$name", ' title="required"' ); + $introspect->{attribute}->{$name}->{required} = 1; + } foreach my $check ( qw/has_type_constraint has_handles is_weak_ref is_required is_lazy should_coerce should_auto_deref has_default has_trigger has_applied_traits/ ) { my $getter; @@ -193,15 +199,29 @@ } my $type = $attr->can('has_type_constraint') && $attr->has_type_constraint ? $attr->type_constraint->name : ''; - if ( $role_attribute->{$name} ) { - my ( $role_name, $nr ) = each %{ $role_attribute->{$name} }; + if ( $attribute_from_role->{$name} ) { + my ( $role_name, $nr ) = each %{ $attribute_from_role->{$name} }; $name .= qq|$nr|; } - eval { $properties = $attr->documentation . ' ' . $properties }; + if ( my $doc = eval { $attr->documentation } ) { + $properties = qq| + $properties + $doc + |; + $self->add_css(qq| + span.documentation { + background: #eee; + padding: 0.25em; + float: left; + clear: left; + } + |); + $introspect->{action}->{$name}->{documentation} = $doc; + } qq|$html_name$type$properties| - } $meta->get_attribute_list + } sort $meta->get_attribute_list } my $table = qq||; @@ -213,10 +233,11 @@ } $table .= qq|
MethodsAttributesTypeProperties
|; + my $path = $self->class_path( $class ); + my $pod = Frey::Pod->new( class => $class, request_url => $self->request_url )->as_markup; - $pod = $pod->{body} if ref($pod); + return $pod if $path =~ m{\.pod}; - my $path = $self->class_path( $class ); my $Document = PPI::Document->new( $path ); # Create a reusable syntax highlighter @@ -240,18 +261,16 @@ my $runnable = join("\n", map { - $introspect->{runnable}->{$_}++; + $introspect->{runnable}->{$_} = {}; my $short = $_; $short =~ s{_as_(?:markup|data|sponge)$}{}; qq|$short| } $self->class_runnable( $class ) ); - $runnable = " runnable: $runnable" if $runnable; + $runnable = "
run: $runnable" if $runnable; $self->store( $introspect_path, $introspect ); - $self->title( $class ); - my $has_tests = ''; my @tests = grep { defined $_ } $self->has_tests; if ( @tests ) { @@ -265,9 +284,9 @@ return join("\n", qq|

$class

|, qq|
$superclasses\n$roles\n$runnable\n|, + $has_tests, $pod ? qq|pod| : '', $source ? qq|source| : '', - $has_tests, qq|$table\n$pod\n
\n|, qq|

Source

$source
|, );