/[Frey]/trunk/lib/Frey/Introspect.pm
This is repository of my old source code which isn't updated any more. Go to git.rot13.org for current projects!
ViewVC logotype

Diff of /trunk/lib/Frey/Introspect.pm

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 100 by dpavlin, Fri Jul 11 19:19:42 2008 UTC revision 134 by dpavlin, Tue Jul 15 14:56:28 2008 UTC
# Line 114  sub methods { Line 114  sub methods {
114          my @methods = grep { ! defined($attr->{$_}) } $class->get_method_list;          my @methods = grep { ! defined($attr->{$_}) } $class->get_method_list;
115          warn "# methods = ",dump( @methods ) if $self->debug;          warn "# methods = ",dump( @methods ) if $self->debug;
116    
117          return @methods;          return sort @methods;
118  }  }
119    
120  use Frey::ClassLoader;  use Frey::ClassLoader;
# Line 138  sub html { Line 138  sub html {
138    
139          while (1) {          while (1) {
140    
141                  my $js = $self->head_javascript;                  my ( $class, $meta, $is_role ) = $self->load_package;
                 $js .= << '__END_OF_JS__';  
 <script type="text/javascript">  
 joose.loadComponents("../lib")  
142    
143  function $(id) {                  my $package = $self->package;
         return document.getElementById(id)  
 }  
144    
145  </script>                  my @methods;
146  __END_OF_JS__                  @methods = map { qq|<td><a href="/~/$package/$_">$_</a></td>| } $self->methods if $class->can('meta');
147    
148                  my ( $class, $meta, $is_role ) = $self->load_package;                  my @attributes;
149                    if ( $class->get_attribute_list ) {
150                    @attributes = map {
151                                    my $attr = $class->get_attribute($_);
152                                    my ( $before, $title, $after ) = ( '', '', '' );
153                                    ( $before, $title, $after ) = ( '<b>', ' title="required"', '</b>' ) if $attr->can('is_required') && $attr->is_required;
154                                    qq|<td>$before<a href="/~/$package/$_?"$title>$_</a>$after</td>|
155                            } sort $class->get_attribute_list
156                    }
157    
158                  my $methods;                  my $table = qq|<table><tr><th>Methods</th><th>Attributes</th></tr>|;
159                  if ( $class->can('meta') ) {                  while ( @methods || @attributes ) {
160                          $methods = dom2html(                          my ($m,$a) = ( shift @methods, shift @attributes );
161                                  h2 => [ 'Methods' ],                          $m ||= '<td></td>';
162                                  ul => [                          $a ||= '<td></td>';
163                                          map { (                          $table .= qq|<tr>$m$a</tr>|;
                                                 li => [ a => { href => '/~/' . $self->package . '/' . $_ } => [ $_ ] ]  
                                         ) } $self->methods  
                                 ]  
                         );  
                 } else {  
                         $methods = '<b>not introspectable</b>';  
164                  }                  }
165                    $table .= qq|</table>|;
166    
167                  my $attributes;                  my $classes =
168                  if ( $class->get_attribute_list ) {                          qq|<div class="classes">| .
169                          $attributes = dom2html(                          Frey::ClassBrowser->new->markup .
170                                  h2 => [ 'Atrributes' ],                          qq|</div>|;
171                                  table => [  
172                                          map {                  $self->add_css( 'static/introspect.css' );
173                                                  my $attr = $class->get_attribute($_);  
174                                                  warn "## $_ ", $attr->is_required ? 'required' : 'optional';                  warn "## css = ",dump( $self->css );
175                                                  ( tr => [  
176                                                          td => [ a => { href => '/~/' . $self->package . '/' . $_ } => [ $_ ] ],                  my ( $superclasses, $roles ) = ( '', 'Role' );
177                                                          td => [ $attr->is_required ? ' <b>required</b>' : '' ],                  if ( ! $is_role ) {
178                                                  ] )                          if ( $meta->superclasses ) {
179                                          } $class->get_attribute_list                                  $superclasses = 'Superclasses: ' .
180                                  ],                                          join(', ',
181                          );                                                  map { my $s = $_->meta->name; qq|<a href="/~/$s">$s</a>| }
182                  } else {                                                  #grep { $_ ne 'Moose::Object' }
183                          $attributes = '<b>no attributes</b>';                                                  $meta->superclasses
184                                            );
185                            }
186    
187                            if ( $meta->can('roles') ) {
188                                    $roles = join(', ', map { my $r = $_->name; qq|<a href="/~/$r">$r</a>| } @{ $meta->roles } );
189                                    $roles = " with roles: $roles" if $roles;
190                            }
191                  }                  }
192    
193                    my $pod = Frey::Pod->new( class => $package )->markup;
194    
195                    my $html = $self->page(
196                            title => "Introspect $package",
197                            body => qq|<h1>$package</h1>|
198                                    . qq|$superclasses\n$roles\n|
199                                    . ( $pod ? qq|<a href="#___top" title="Skip to POD" style="font-size: 80%; color: #aaa;">&darr;pod&darr</a>| : '' )
200                                    . qq|$table\n$pod\n$classes|,
201    
                 my $html = dom2html(  
                         html => [  
                                 head => [  
                                         link => { rel=>"stylesheet", href=>"/static/app.css", type=>"text/css", media=>"screen" },  
                                         $js,  
                                         title => [ 'Introspect ', $self->package ],  
                                 ],  
                                 body => [  
                                         h1 => [ $self->package ],  
                                         $methods,  
                                         $attributes,  
                                 ],  
                         ]  
202                  );                  );
203    
204                  $request->print($html);                  $request->print($html);
Legend:
Removed from v.100  
changed lines
  Added in v.134
  ViewVC Help
Powered by ViewVC 1.1.26