--- trunk/lib/Frey/Introspect.pm 2008/12/02 19:10:36 688 +++ trunk/lib/Frey/Introspect.pm 2009/01/11 12:09:58 993 @@ -11,14 +11,19 @@ use PPI; use PPI::HTML; -use Frey::Pod; - use lib 'lib'; +use Frey::Pod; extends 'Frey::PPI'; with 'Frey::Web'; with 'Frey::Storage'; +=head1 DESCRIPTION + +Provide introspection on any perl class installed on system + +=cut + has 'class' => ( is => 'rw', isa => 'Str', @@ -55,7 +60,9 @@ $out .= "\t\t\t$_: {\n"; my $attr = $meta->get_attribute($_); - my $is = $attr->_is_metadata; + my $is = eval { $attr->_is_metadata; }; + return if $@; + $out .= "\t\t\t\tis: \"$is\",\n" if defined $is; $out .= "\t\t\t\tlazy: true,\n" if $attr->is_lazy; $out .= "\t\t\t\trequired: true,\n" if $attr->is_required; @@ -109,10 +116,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,8 +129,10 @@ join(', ', map { my $name = $_->meta->name; - $introspect->{superclass}->{$name}++; - $self->dropdown( $name, $_->meta ) + $introspect->{superclass}->{$name} = {}; + + qq|$name| . + $self->dropdown( qq|?|, $_->meta ) } #grep { $_ ne 'Moose::Object' } $meta->superclasses @@ -130,8 +140,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 +149,54 @@ 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; - $self->dropdown( $name, $name->meta ) . qq|| . $role_nr++ . qq||; + $introspect->{roles}->{$name} = {}; + $method_from_role->{ $_ }->{$name} = $role_nr foreach $_->get_method_list; + $attribute_from_role->{ $_ }->{$name} = $role_nr foreach $_->get_attribute_list; + + qq|$name| +# . qq|| . $self->dropdown( $role_nr++, $name->meta ) . qq|| + . $self->dropdown( + qq|| . $role_nr++ . qq||, + $name->meta + ) + ; } $meta->calculate_all_roles ); - $roles = qq| with roles: $roles| if $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|
$v
|
+ ;
}
$properties .= ' ';
}
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|Methods | Attributes | Type | Properties |
---|