--- trunk/lib/Frey/Introspect.pm 2009/01/06 13:53:44 942 +++ trunk/lib/Frey/Introspect.pm 2009/01/06 14:50:30 943 @@ -18,6 +18,12 @@ with 'Frey::Web'; with 'Frey::Storage'; +=head1 DESCRIPTION + +Provide introspection on any perl class installed on system + +=cut + has 'class' => ( is => 'rw', isa => 'Str', @@ -122,7 +128,9 @@ map { my $name = $_->meta->name; $introspect->{superclass}->{$name} = {}; - $self->dropdown( $name, $_->meta ) + + qq|$name| . + $self->dropdown( qq|?|, $_->meta ) } #grep { $_ ne 'Moose::Object' } $meta->superclasses @@ -142,11 +150,18 @@ $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||; + + 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 "# method_from_role ",dump( $method_from_role ); @@ -188,12 +203,13 @@ $getter =~ s/^has_//; if ( $attr->can($check) && $attr->$check ) { - if ( $getter eq $check ) { - $properties .= "$check"; - } else { - # we need our dump here instead of $attr->$getter->dump because default can return scalar - $properties .= $self->dropdown( $check, $attr->$getter ); - } + $properties .= $check; + # we need our dump here instead of $attr->$getter->dump because default can return scalar + my $v = $attr->$getter; + $properties .= ref($v) + ? $self->dropdown( qq|?|, $attr->$getter ) + : qq| $v| + ; } $properties .= ' '; } @@ -220,7 +236,7 @@ $introspect->{action}->{$name}->{documentation} = $doc; } - qq|$html_name$type$properties| + qq|$html_name$type$properties| } sort $meta->get_attribute_list } @@ -267,23 +283,48 @@ qq|$short| } $self->class_runnable( $class ) ); - $runnable = "
run: $runnable" if $runnable; - - $self->store( $introspect_path, $introspect ); + $runnable = "Runnable: $runnable" if $runnable; my $has_tests = ''; my @tests = grep { defined $_ } $self->has_tests; if ( @tests ) { $has_tests = - '
test' . ( $#tests > 0 ? 's' : '' ) . ': ' . + 'Test' . ( $#tests > 0 ? 's' : '' ) . ': ' . join("\n", map { qq|$_| } @tests ); + $introspect->{tests} = [ @tests ], + } + + my $includes = ''; + if ( my $inc = $self->includes ) { + $introspect->{includes} = $inc; + foreach my $type ( keys %$inc ) { + $includes + .= ucfirst($type) + . qq|: | + . join("\n", + map { + qq|$_| + } @{ + $inc->{$type} + } + ) + ; + } } + $self->store( $introspect_path, $introspect ); + return join("\n", qq|

$class

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