/[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 980 by dpavlin, Fri Jan 9 23:02:36 2009 UTC revision 981 by dpavlin, Sat Jan 10 01:03:28 2009 UTC
# Line 35  has show_roles => ( Line 35  has show_roles => (
35          isa => 'Bool',          isa => 'Bool',
36  );  );
37    
38    has show_disconnected => (
39            is => 'ro',
40            isa => 'Bool',
41    );
42    
43  has portrait => (  has portrait => (
44          documentation => 'vertical layout',          documentation => 'vertical layout',
45          is => 'rw',          is => 'rw',
# Line 60  sub as_markup { Line 65  sub as_markup {
65  #               layout => 'twopi', # grabs too much memory  #               layout => 'twopi', # grabs too much memory
66  #               overlap => 'compress',  #               overlap => 'compress',
67  #               no_overlap => 1,  #               no_overlap => 1,
68    
69                  node => {                  node => {
70                          shape => 'box',                          shape => 'box',
71  #                       style =>'filled',                          style =>'filled',
72  #                       color => 'grey',                          color => 'grey',
73  #                       fillcolor =>'lightgray',                          fillcolor =>'lightgray',
74                            fontname  => 'verdana',
75                            fontsize  => '12',
76    
77                  },                  },
78                  edge => {                  edge => {
79                          color => 'grey',                          color => 'grey',
80                            fontname  => 'verdana',
81                            fontsize  => '8',
82                            fontcolor => 'grey',
83                  }                  }
84          );          );
85    
86          our $count = {};          my $count;
         our $max_count = {};  
87          my $filter = $self->filter;          my $filter = $self->filter;
88    
89          foreach my $path ( $self->dir_extension( $self->introspect_path, qr{\.(ya?ml)$}) ) {          foreach my $path ( $self->dir_extension( $self->introspect_path, qr{\.(ya?ml)$}) ) {
90    
91                  my $class = $self->strip_path_extension( $path ) || die "can't strip $path";                  my $class = $self->strip_path_extension( $path ) || die "can't strip $path";
92                  $max_count->{$class} = ++$count->{$class};  
93                    $count->{$class}++ if $self->show_disconnected;
94    
95                  my $data = $self->load( $path );                  my $data = $self->load( $path );
96  #               warn "## $class $path ", $self->dump( $data ); # if $self->debug;  #               warn "## $class $path ", $self->dump( $data ); # if $self->debug;
# Line 91  sub as_markup { Line 103  sub as_markup {
103                                          next if $filter && $package !~ m{$filter};                                          next if $filter && $package !~ m{$filter};
104                                          warn "# $class\t$type\t$package\n";                                          warn "# $class\t$type\t$package\n";
105                                          $g->add_edge( $class => $package, label => $type, color => 'blue' );                                          $g->add_edge( $class => $package, label => $type, color => 'blue' );
106                                          $max_count->{$package} = ++$count->{$package};                                          $count->{$class}++;
107                                            $count->{$package}++;
108                                  }                                  }
109                          }                          }
110                  }                  }
# Line 102  sub as_markup { Line 115  sub as_markup {
115                                  warn "# $class\trole\t$role\n";                                  warn "# $class\trole\t$role\n";
116                                  $g->add_edge( $role => $class, label => 'role', color => 'yellow' );                                  $g->add_edge( $role => $class, label => 'role', color => 'yellow' );
117  #                               $g->add_node( $role, rank => 'role' );  #                               $g->add_node( $role, rank => 'role' );
118                                  $max_count->{$role} = ++$count->{$role};                                  $count->{$class}++;
119                                    $count->{$role}++;
120                          }                          }
121                  }                  }
122    
# Line 111  sub as_markup { Line 125  sub as_markup {
125                                  next if $filter && $extends !~ m{$filter};                                  next if $filter && $extends !~ m{$filter};
126                                  warn "# $class\textends\t$extends\n";                                  warn "# $class\textends\t$extends\n";
127                                  $g->add_edge( $extends => $class, label => 'extends', color => 'green' );                                  $g->add_edge( $extends => $class, label => 'extends', color => 'green' );
128                                  $max_count->{$extends} = ++$count->{$extends};                                  $count->{$class}++;
129                                    $count->{$extends}++;
130                          }                          }
131                  }                  }
132    
133          }          }
134    
 =for xxx  
135          warn "# count ",$self->dump( $count );          warn "# count ",$self->dump( $count );
136    
137            my $max_count = 1;
138            foreach ( keys %$count ) {
139                    my $v = $count->{$_};
140                    $max_count = $v if $v > $max_count;
141            }
142            warn "# max_count: $max_count";
143    
144          foreach my $node ( keys %$count ) {          foreach my $node ( keys %$count ) {
145                  my $pcnt = $count->{$node} / $max_count->{$node};                  my $v = $count->{$node};
146                  my $color = join(",", ( $pcnt, 0.5, 0.75 ) );                  my $pcnt = $v / $max_count;
147                    my $color = join(",", ( $pcnt, $pcnt, 0.75 ) );
148    
149                  $g->add_node( $node,                  $g->add_node( $node,
150                          style =>'filled',                          style =>'filled',
151                          color => $color,                          color => $color,
152                          fillcolor => $color,                          fillcolor => $color,
153                          label => "$node\n$pcnt",  #                       label => "$node\n$v",
154                  );                  );
155    
156          }          }
 =cut  
157    
158          if ( $self->produce_dot ) {          if ( $self->produce_dot ) {
159                  $self->content_type( 'text/plain' );                  $self->content_type( 'text/plain' );
Legend:
Removed from v.980  
changed lines
  Added in v.981
  ViewVC Help
Powered by ViewVC 1.1.26