--- trunk/lib/Frey/Introspect.pm 2008/12/06 12:22:36 735 +++ trunk/lib/Frey/Introspect.pm 2009/06/29 17:01:28 1111 @@ -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; @@ -103,11 +111,10 @@ sub as_markup { my ( $self ) = @_; - $self->add_head( 'static/introspect.css' ); - 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 +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 @@ -141,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 ); @@ -160,7 +176,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 +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 .= ' '; } @@ -210,12 +229,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 } @@ -230,8 +251,10 @@ my $path = $self->class_path( $class ); - my $pod = Frey::Pod->new( class => $class, request_url => $self->request_url )->as_markup; - return $pod if $path =~ m{\.pod}; + my ( $pod_toc, $pod ) = Frey::Pod->new( class => $class, request_url => $self->request_url )->as_markup; + return $pod_toc . $pod if $path =~ m{\.pod}; + + warn "# ", $pod_toc ? 'toc' : '', ' ', $pod ? 'pod' : ''; my $Document = PPI::Document->new( $path ); @@ -254,7 +277,7 @@ # $source =~ s{^.*]+>}{}s; # $source =~ s{
", map { $introspect->{runnable}->{$_} = {}; my $short = $_; @@ -262,31 +285,104 @@ 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; + my @tests = sort { lc($a) cmp lc($b) } grep { defined $_ } $self->has_tests; if ( @tests ) { - $has_tests = - '
test' . ( $#tests > 0 ? 's' : '' ) . ': ' . - join("\n", map { - qq|$_| - } @tests ); + $has_tests + = qq|
test| + . ( $#tests > 0 ? 's' : '' ) + . qq|
| + . join("
", map { + qq|$_| + } @tests ) + . qq|
| + ; + $introspect->{tests} = [ @tests ], } - return join("\n", - qq|

$class

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

Source

$source
|, - ); + 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| + .frey-introspect-right { + position: fixed; + top: 1em; + right: 1em; + z-index: 10; + background: #ffc; + padding: 0.5em; + width: 20%; + font-size: 80%; + } + .frey-introspect-right dl dd { + margin-left: 1em; + } + + /* fix pod */ + .frey-introspect-right dd ul { + padding-left: 0; + } + .frey-introspect-right dl ul > li { + list-style: none; + } + |); + + my $has_pod = qq| +
pod
+
$pod_toc
+ | if $pod_toc; + + my $has_source = qq| +
source
+ | if $source; + + my $right = qq| +
+ $runnable + $has_tests + $has_pod + $has_source +
+ |; + + + return + qq| +

$class

+
+ $superclasses $roles +
$includes +
+
+ $right +
+ $table + $pod + + +

Source

+
$source
+ | + ; } =head1 SEE ALSO