/[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 982 by dpavlin, Sat Jan 10 01:27:28 2009 UTC revision 1137 by dpavlin, Tue Jun 30 19:47:10 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 69  has show_disconnected => ( Line 67  has show_disconnected => (
67  );  );
68    
69    
70    has layout => (
71            documentation => 'layout algorithm',
72            is => 'rw',
73            isa => 'Str',
74            required => 1,
75    );
76    
77    sub layout_available { q/
78    dot             directed graph
79    neato   spring model
80    twopi   radial
81    circo   circular
82    fdp             force directed spring model
83    / }
84    
85  has portrait => (  has portrait => (
86          documentation => 'vertical layout',          documentation => 'vertical layout',
87          is => 'rw',          is => 'rw',
88          isa => 'Bool',          isa => 'Bool',
89  );  );
90    
91    has no_overlap => (
92            documentation => 'avoid overlaping nodes',
93            is => 'rw',
94            isa => 'Bool',
95    );
96    
97  has produce_dot => (  has produce_dot => (
98          documentation => 'dump .dot text format',          documentation => 'dump .dot text format',
99          is => 'rw',          is => 'rw',
# Line 90  sub as_markup { Line 109  sub as_markup {
109    
110          my $g = GraphViz->new(          my $g = GraphViz->new(
111                  rankdir => $rankdir,                  rankdir => $rankdir,
112                    layout => $self->layout,
113  #               layout => 'neato', # grabs too much memory  #               layout => 'neato', # grabs too much memory
114  #               layout => 'twopi', # grabs too much memory  #               layout => 'twopi', # grabs too much memory
115  #               overlap => 'compress',  #               overlap => 'compress',
116  #               no_overlap => 1,                  no_overlap => $self->no_overlap,
117    
118                  node => {                  node => {
119                          shape => 'box',                          shape => 'box',
# Line 127  sub as_markup { Line 147  sub as_markup {
147                  next if $filter && $self->filter_class && $class !~ m{$filter};                  next if $filter && $self->filter_class && $class !~ m{$filter};
148    
149                  if ( $self->show_includes && defined $data->{includes} ) {                  if ( $self->show_includes && defined $data->{includes} ) {
150    
151                            my $edge;
152    
153                          foreach my $type ( keys %{ $data->{includes} } ) {                          foreach my $type ( keys %{ $data->{includes} } ) {
154                                  foreach my $package ( @{ $data->{includes}->{$type} } ) {                                  foreach my $package ( @{ $data->{includes}->{$type} } ) {
155                                          next if $filter && $self->filter_includes && $package !~ m{$filter};                                          next if $filter && $self->filter_includes && $package !~ m{$filter};
156                                          warn "# $class\t$type\t$package\n";                                          warn "# $class\t$type\t$package\n";
157                                          $g->add_edge( $class => $package, label => $type, color => 'blue' );                                          my $e = "$class $package";
158                                            if ( $edge->{$e} ) {
159                                                    $edge->{$e}->{style} = 'dashed';
160                                                    $edge->{$e}->{label} .= "\n$type";
161                                            } else {
162                                                    $edge->{$e} = {
163                                                            color => 'blue',
164                                                            label => $type,
165                                                    };
166                                            }
167                                          $count->{$class}++;                                          $count->{$class}++;
168                                          $count->{$package}++;                                          $count->{$package}++;
169                                  }                                  }
170                          }                          }
171    
172                            foreach my $e ( keys %$edge ) {
173                                    my ($c,$p) = split(/\s/, $e);
174                                    $g->add_edge( $c => $p, %{ $edge->{$e} } )
175                            }
176    
177                  }                  }
178    
179                  if ( $self->show_roles && defined $data->{roles} ) {                  if ( $self->show_roles && defined $data->{roles} ) {
180                          foreach my $role ( keys %{ $data->{roles} } ) {                          foreach my $role ( keys %{ $data->{roles} } ) {
181                                  next if $filter && $self->filter_roles && $role !~ m{$filter};                                  next if $filter && $self->filter_roles && $role !~ m{$filter};
182                                  warn "# $class\trole\t$role\n";                                  warn "# $class\trole\t$role\n";
183                                  $g->add_edge( $role => $class, label => 'role', color => 'yellow' );                                  $g->add_edge( $role => $class, label => 'with', color => 'yellow' );
184  #                               $g->add_node( $role, rank => 'role' );                                  $g->add_node( $role, shape => 'diamond' );
185                                  $count->{$class}++;                                  $count->{$class}++;
186                                  $count->{$role}++;                                  $count->{$role}++;
187                          }                          }
# Line 195  sub as_markup { Line 233  sub as_markup {
233    
234  }  }
235    
236    __PACKAGE__->meta->make_immutable;
237    no Moose;
238    
239  1;  1;
Legend:
Removed from v.982  
changed lines
  Added in v.1137
  ViewVC Help
Powered by ViewVC 1.1.26