--- trunk/lib/Frey/Introspect.pm 2008/12/06 12:22:36 735 +++ trunk/lib/Frey/Introspect.pm 2009/01/11 12:09:58 993 @@ -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', @@ -54,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; @@ -108,6 +116,7 @@ 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 ); @@ -121,7 +130,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 @@ -141,11 +152,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 ); @@ -160,7 +178,9 @@ $introspect->{methods}->{$name} = {}; } qq|$name| - } sort $self->class_methods( $class ); + } sort { + lc($a) cmp lc($b) + } $self->class_methods( $class ); my @attributes; if ( $meta->get_attribute_list ) { @@ -185,12 +205,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 .= ' '; } @@ -210,12 +231,14 @@ span.documentation { background: #eee; padding: 0.25em; + float: left; + clear: left; } |); $introspect->{action}->{$name}->{documentation} = $doc; } - qq|$html_name$type$properties| + qq|$html_name$type$properties| } sort $meta->get_attribute_list } @@ -262,30 +285,73 @@ qq|$short| } $self->class_runnable( $class ) ); - $runnable = "
run: $runnable" if $runnable; - - $self->store( $introspect_path, $introspect ); - - $self->title( $class ); + $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 ); + + $self->add_css(qq| + .right { + position: fixed; + top: 1em; + right: 1em; + z-index: 10; + background: #fff; + padding: 0.2em; + border: 1px dashed #ee8; + } + |); + return join("\n", - qq|

$class

|, - qq|
$superclasses\n$roles\n$runnable\n|, + qq| +

$class

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

Source

$source
|, + qq| +
+ $table + $pod + + +

Source

+
$source
+ |, ); }