/[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 972 by dpavlin, Fri Jan 9 19:33:26 2009 UTC revision 1080 by dpavlin, Thu Jun 4 20:45:28 2009 UTC
# Line 12  has filter => ( Line 12  has filter => (
12          documentation => 'Regex to select classes',          documentation => 'Regex to select classes',
13          is => 'rw',          is => 'rw',
14          isa => 'Str',          isa => 'Str',
15          default => 'Frey',          required => 1,
16            default => sub {
17                    '(' . join('|',  map { s{lib/}{}; $_ } sort grep { -d $_ } glob("lib/*") ) . ')'
18            },
19  );  );
20    
21  has path => (  
22    has filter_class => (
23            is => 'rw',
24            isa => 'Bool',
25            default => 1,
26    );
27    
28    has filter_extends => (
29            is => 'rw',
30            isa => 'Bool',
31            default => 1,
32    );
33    
34    has filter_includes => (
35            is => 'rw',
36            isa => 'Bool',
37            default => 1,
38    );
39    
40    has filter_roles => (
41            is => 'rw',
42            isa => 'Bool',
43            default => 1,
44    );
45    
46    
47    has show_extends => (
48            documentation => 'connect to superclasses',
49            is => 'rw',
50            isa => 'Bool',
51    );
52    
53    has show_includes => (
54            documentation => 'use and require connections',
55            is => 'rw',
56            isa => 'Bool',
57            default => 1,
58    );
59    
60    has show_roles => (
61            documentation => 'roles consumers connections',
62            is => 'rw',
63            isa => 'Bool',
64    );
65    
66    has show_disconnected => (
67            is => 'ro',
68            isa => 'Bool',
69    );
70    
71    
72    has layout => (
73            documentation => 'layout algorithm',
74          is => 'rw',          is => 'rw',
75          isa => 'Str',          isa => 'Str',
76          required => 1,          required => 1,
77          default => 'var/introspect/',  );
78    
79    sub layout_available { q/
80    dot             directed graph
81    neato   spring model
82    twopi   radial
83    circo   circular
84    fdp             force directed spring model
85    / }
86    
87    has portrait => (
88            documentation => 'vertical layout',
89            is => 'rw',
90            isa => 'Bool',
91    );
92    
93    has no_overlap => (
94            documentation => 'avoid overlaping nodes',
95            is => 'rw',
96            isa => 'Bool',
97  );  );
98    
99  has produce_dot => (  has produce_dot => (
100            documentation => 'dump .dot text format',
101          is => 'rw',          is => 'rw',
102          isa => 'Bool',          isa => 'Bool',
103  );  );
104    
105    sub introspect_path { 'var/introspect/' };
106    
107  sub as_markup {  sub as_markup {
108          my ($self) = @_;          my ($self) = @_;
109    
110            my $rankdir = $self->portrait;
111    
112          my $g = GraphViz->new(          my $g = GraphViz->new(
113                  rankdir => 1, # horizontal                  rankdir => $rankdir,
114                    layout => $self->layout,
115  #               layout => 'neato', # grabs too much memory  #               layout => 'neato', # grabs too much memory
116  #               layout => 'twopi', # grabs too much memory  #               layout => 'twopi', # grabs too much memory
117  #               overlap => 'compress',  #               overlap => 'compress',
118  #               no_overlap => 1,                  no_overlap => $self->no_overlap,
119    
120                    node => {
121                            shape => 'box',
122                            style =>'filled',
123                            color => 'grey',
124                            fillcolor =>'lightgray',
125                            fontname  => 'verdana',
126                            fontsize  => '12',
127    
128                    },
129                    edge => {
130                            color => 'grey',
131                            fontname  => 'verdana',
132                            fontsize  => '8',
133                            fontcolor => 'grey',
134                    }
135          );          );
136    
137          our $count = {};          my $count;
138          my $filter = $self->filter;          my $filter = $self->filter;
139    
140          foreach my $path ( $self->dir_extension( $self->path, qr{\.(ya?ml)$}) ) {          foreach my $path ( $self->dir_extension( $self->introspect_path, qr{\.(ya?ml)$}) ) {
141    
142                  my $class = $self->strip_path_extension( $path ) || die "can't strip $path";                  my $class = $self->strip_path_extension( $path ) || die "can't strip $path";
                 my $data = $self->load( $path );  
 #               warn "## $class $path ", $self->dump( $data ); # if $self->debug;  
   
                 sub count_label {  
                         my ($self,$package) = @_;  
                         my $label = $package;  
                         $label .= $self->dump( $count->{$package} );  
                         return $label;  
                 }  
   
                 next if $filter && $class !~ m{$filter};  
143    
144                  if ( my $includes = $data->{includes} ) {                  $count->{$class}++ if $self->show_disconnected;
                         foreach my $type ( keys %$includes ) {  
                                 foreach my $package ( @{ $includes->{$type} } ) {  
145    
146                                          my $usage = $count->{$package}->{$type}->{$class}++;                  my $data = $self->load( $path );
147    #               warn "## $class $path ", $self->dump( $data ); # if $self->debug;
148    
149                                          my $label = $self->count_label($package);                  next if $filter && $self->filter_class && $class !~ m{$filter};
150    
151                                          next if $filter && $package !~ m{$filter};                  if ( $self->show_includes && defined $data->{includes} ) {
152                            foreach my $type ( keys %{ $data->{includes} } ) {
153                                    foreach my $package ( @{ $data->{includes}->{$type} } ) {
154                                            next if $filter && $self->filter_includes && $package !~ m{$filter};
155                                            warn "# $class\t$type\t$package\n";
156                                            $g->add_edge( $class => $package, label => $type, color => 'blue' );
157                                            $count->{$class}++;
158                                            $count->{$package}++;
159                                    }
160                            }
161                    }
162    
163                                          warn "# $class\t$type\t$package\n$label\n";                  if ( $self->show_roles && defined $data->{roles} ) {
164                            foreach my $role ( keys %{ $data->{roles} } ) {
165                                    next if $filter && $self->filter_roles && $role !~ m{$filter};
166                                    warn "# $class\trole\t$role\n";
167                                    $g->add_edge( $role => $class, label => 'role', color => 'yellow' );
168    #                               $g->add_node( $role, rank => 'role' );
169                                    $count->{$class}++;
170                                    $count->{$role}++;
171                            }
172                    }
173    
174                                          $g->add_edge( $class => $package, label => $type );                  if ( $self->show_extends && defined $data->{superclass} ) {
175                                  }                          foreach my $extends ( keys %{ $data->{superclass} } ) {
176                                    next if $filter && $self->filter_extends && $extends !~ m{$filter};
177                                    warn "# $class\textends\t$extends\n";
178                                    $g->add_edge( $extends => $class, label => 'extends', color => 'green' );
179                                    $count->{$class}++;
180                                    $count->{$extends}++;
181                          }                          }
182                  }                  }
183    
# Line 77  sub as_markup { Line 185  sub as_markup {
185    
186          warn "# count ",$self->dump( $count );          warn "# count ",$self->dump( $count );
187    
188          $self->store( 'var/classes.dot', $g->as_text );          my $max_count = 1;
189            foreach ( keys %$count ) {
190                    my $v = $count->{$_};
191                    $max_count = $v if $v > $max_count;
192            }
193            warn "# max_count: $max_count";
194    
195            foreach my $node ( keys %$count ) {
196                    my $v = $count->{$node};
197                    my $pcnt = $v / $max_count;
198                    my $color = join(",", ( $pcnt, $pcnt, 0.75 ) );
199    
200                    $g->add_node( $node,
201                            style =>'filled',
202                            color => $color,
203                            fillcolor => $color,
204    #                       label => "$node\n$v",
205                    );
206    
207            }
208    
209          if ( $self->produce_dot ) {          if ( $self->produce_dot ) {
210                  $self->content_type( 'text/plain' );                  $self->content_type( 'text/plain' );
211                    $self->store( 'var/classes.dot', $g->as_canon );
212                  return $g->as_canon;                  return $g->as_canon;
213          }          }
214    
Legend:
Removed from v.972  
changed lines
  Added in v.1080
  ViewVC Help
Powered by ViewVC 1.1.26