/[Frey]/trunk/lib/Frey/Class/Graph.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/Class/Graph.pm

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

revision 1080 by dpavlin, Thu Jun 4 20:45:28 2009 UTC revision 1156 by dpavlin, Thu Jul 2 14:00:02 2009 UTC
# Line 2  package Frey::Class::Graph; Line 2  package Frey::Class::Graph;
2  use Moose;  use Moose;
3    
4  extends 'Frey';  extends 'Frey';
5  with 'Frey::Web';  with 'Frey::Web', 'Frey::File', 'Frey::Storage';
 with 'Frey::File';  
 with 'Frey::Storage';  
6    
7  use GraphViz;  use GraphViz;
8    
# Line 102  has produce_dot => ( Line 100  has produce_dot => (
100          isa => 'Bool',          isa => 'Bool',
101  );  );
102    
103    has clusters => (
104            documentation => 'cluster by classes',
105            is => 'rw',
106            isa => 'Bool',
107    );
108    
109  sub introspect_path { 'var/introspect/' };  sub introspect_path { 'var/introspect/' };
110    
111  sub as_markup {  sub as_markup {
# Line 149  sub as_markup { Line 153  sub as_markup {
153                  next if $filter && $self->filter_class && $class !~ m{$filter};                  next if $filter && $self->filter_class && $class !~ m{$filter};
154    
155                  if ( $self->show_includes && defined $data->{includes} ) {                  if ( $self->show_includes && defined $data->{includes} ) {
156    
157                            my $edge;
158    
159                          foreach my $type ( keys %{ $data->{includes} } ) {                          foreach my $type ( keys %{ $data->{includes} } ) {
160                                  foreach my $package ( @{ $data->{includes}->{$type} } ) {                                  foreach my $package ( @{ $data->{includes}->{$type} } ) {
161                                          next if $filter && $self->filter_includes && $package !~ m{$filter};                                          next if $filter && $self->filter_includes && $package !~ m{$filter};
162                                          warn "# $class\t$type\t$package\n";                                          warn "# $class\t$type\t$package\n";
163                                          $g->add_edge( $class => $package, label => $type, color => 'blue' );                                          my $e = "$class $package";
164                                            if ( $edge->{$e} ) {
165                                                    $edge->{$e}->{style} = 'dashed';
166                                                    $edge->{$e}->{label} .= "\n$type";
167                                            } else {
168                                                    $edge->{$e} = {
169                                                            color => 'blue',
170                                                            label => $type,
171                                                    };
172                                            }
173                                          $count->{$class}++;                                          $count->{$class}++;
174                                          $count->{$package}++;                                          $count->{$package}++;
175                                  }                                  }
176                          }                          }
177    
178                            foreach my $e ( keys %$edge ) {
179                                    my ($c,$p) = split(/\s/, $e);
180                                    $g->add_edge( $c => $p, %{ $edge->{$e} } )
181                            }
182    
183                  }                  }
184    
185                  if ( $self->show_roles && defined $data->{roles} ) {                  if ( $self->show_roles && defined $data->{roles} ) {
186                          foreach my $role ( keys %{ $data->{roles} } ) {                          foreach my $role ( keys %{ $data->{roles} } ) {
187                                  next if $filter && $self->filter_roles && $role !~ m{$filter};                                  next if $filter && $self->filter_roles && $role !~ m{$filter};
188                                  warn "# $class\trole\t$role\n";                                  warn "# $class\trole\t$role\n";
189                                  $g->add_edge( $role => $class, label => 'role', color => 'yellow' );                                  $g->add_edge( $role => $class, label => 'with', color => 'yellow' );
190  #                               $g->add_node( $role, rank => 'role' );                                  $g->add_node( $role, shape => 'diamond' );
191                                  $count->{$class}++;                                  $count->{$class}++;
192                                  $count->{$role}++;                                  $count->{$role}++;
193                          }                          }
# Line 197  sub as_markup { Line 219  sub as_markup {
219                  my $pcnt = $v / $max_count;                  my $pcnt = $v / $max_count;
220                  my $color = join(",", ( $pcnt, $pcnt, 0.75 ) );                  my $color = join(",", ( $pcnt, $pcnt, 0.75 ) );
221    
222                    my @cluster;
223                    if ( $self->clusters ) {
224                            my $name = $1 if $node =~ m{^([^:]+)};
225                            @cluster = ( 'cluster' => {
226                                    name => $name,
227                                    style => 'filled',
228                                    bgcolor => 'lightgrey',
229                                    color => 'lightgrey',
230                            });
231                    }
232    
233                  $g->add_node( $node,                  $g->add_node( $node,
234                          style =>'filled',                          style =>'filled',
235                          color => $color,                          color => $color,
236                          fillcolor => $color,                          fillcolor => $color,
237  #                       label => "$node\n$v",  #                       label => "$node\n$v",
238                            @cluster,
239                  );                  );
240    
241          }          }
# Line 217  sub as_markup { Line 251  sub as_markup {
251    
252  }  }
253    
254    __PACKAGE__->meta->make_immutable;
255    no Moose;
256    
257  1;  1;
Legend:
Removed from v.1080  
changed lines
  Added in v.1156
  ViewVC Help
Powered by ViewVC 1.1.26