/[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 312 by dpavlin, Wed Nov 5 20:05:35 2008 UTC revision 314 by dpavlin, Wed Nov 5 20:18:33 2008 UTC
# Line 152  sub markup { Line 152  sub markup {
152          }          }
153    
154          my $role_method;          my $role_method;
155            my $role_attribute;
156    
157          if ( $meta->can('roles') ) {          if ( $meta->can('roles') ) {
158                  my $role_nr = 1;                  my $role_nr = 1;
# Line 159  sub markup { Line 160  sub markup {
160                          grep { ! m/\Q$class\E/ }        # skip me                          grep { ! m/\Q$class\E/ }        # skip me
161                          map {                          map {
162                                  my $name = $_->name;                                  my $name = $_->name;
163                                  $role_method->{ $_ }->{$name} = $role_nr foreach $_->get_method_list;                                  $role_method->{    $_ }->{$name} = $role_nr foreach $_->get_method_list;
164                                    $role_attribute->{ $_ }->{$name} = $role_nr foreach $_->get_attribute_list;
165                                  qq|<a class="frey-popdown" href="/$name">$name<code>| . $name->meta->dump(2) . qq|</code></a><sup>| . $role_nr++ . qq|</sup>|;                                  qq|<a class="frey-popdown" href="/$name">$name<code>| . $name->meta->dump(2) . qq|</code></a><sup>| . $role_nr++ . qq|</sup>|;
166                          }                          }
167                          $meta->calculate_all_roles                          $meta->calculate_all_roles
# Line 170  sub markup { Line 172  sub markup {
172    
173          my @methods;          my @methods;
174          @methods = map {          @methods = map {
175                  my $method = $_;                  my $name = $_;
176                  if ( $role_method ) {                  if ( $role_method->{$name} ) {
177                          my ( $name, $nr ) = each %{ $role_method->{$_} };                          my ( $role_name, $nr ) = each %{ $role_method->{$name} };
178                          $method .= qq|<sup title="$name">$nr</sup>|;                          $name .= qq|<sup title="$role_name">$nr</sup>|;
179                  }                  }
180                  qq|<td class="m">$method</td>|                  qq|<td class="m">$name</td>|
181          } $self->methods;          } $self->methods;
182    
183          my @attributes;          my @attributes;
184          if ( $meta->get_attribute_list ) {          if ( $meta->get_attribute_list ) {
185          @attributes = map {          @attributes = map {
186                          my $attr = $meta->get_attribute($_);                          my $name = $_;
187                            my $attr = $meta->get_attribute($name);
188                          my ( $before, $title, $after ) = ( '', '', '' );                          my ( $before, $title, $after ) = ( '', '', '' );
189                          ( $before, $title, $after ) = ( '<b>', ' title="required"', '</b>' ) if $attr->is_required;                          ( $before, $title, $after ) = ( '<b>', ' title="required"', '</b>' ) if $attr->is_required;
190  warn $attr->dump(3);  warn $attr->dump(3);
# Line 204  warn $attr->dump(3); Line 207  warn $attr->dump(3);
207                                  $after .= ' ';                                  $after .= ' ';
208                          }                          }
209                          my $type = $attr->has_type_constraint ? $attr->type_constraint->name : '';                          my $type = $attr->has_type_constraint ? $attr->type_constraint->name : '';
210                          qq|<td class="a">$before $_</td><td class="t">$type</td><td>$after</td>|  
211                            if ( $role_attribute->{$name} ) {
212                                    my ( $role_name, $nr ) = each %{ $role_attribute->{$name} };
213                                    $name .= qq|<sup title="$role_name">$nr</sup>|;
214                            }
215    
216                            qq|<td class="a">$before $name</td><td class="t">$type</td><td>$after</td>|
217                  } sort $meta->get_attribute_list                  } sort $meta->get_attribute_list
218          }          }
219    
# Line 220  warn $attr->dump(3); Line 229  warn $attr->dump(3);
229          my $pod = Frey::Pod->new( class => $class )->markup;          my $pod = Frey::Pod->new( class => $class )->markup;
230    
231          use Frey::Run;          use Frey::Run;
232          my $execute = join("\n", map { qq|<a href="/$class/$_">$_</a>| } grep { $class->can($_) } Frey::Run->execute );          my $runnable = join("\n", map { qq|<a href="/$class/$_">$_</a>| } grep { $class->can($_) } Frey::Run->runnable );
233          $execute = " execute: $execute" if $execute;          $runnable = " runnable: $runnable" if $runnable;
234    
235          my $html = $self->page(          my $html = $self->page(
236                  title => "Introspect $class",                  title => "Introspect $class",
237                  body => qq|<h1>$class</h1>|                  body => qq|<h1>$class</h1>|
238                          . qq|<div class="frey-introspect">$superclasses\n$roles\n$execute\n|                          . qq|<div class="frey-introspect">$superclasses\n$roles\n$runnable\n|
239                          . ( $pod ? qq|<a href="#___top" title="Skip to POD" style="font-size: 80%; color: #aaa;">&darr;pod&darr</a>| : '' )                          . ( $pod ? qq|<a href="#___top" title="Skip to POD" style="font-size: 80%; color: #aaa;">&darr;pod&darr</a>| : '' )
240                          . qq|$table\n$pod</div>|                          . qq|$table\n$pod</div>|
241    
Legend:
Removed from v.312  
changed lines
  Added in v.314
  ViewVC Help
Powered by ViewVC 1.1.26