/[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 971 by dpavlin, Fri Jan 9 16:21:26 2009 UTC revision 972 by dpavlin, Fri Jan 9 19:33:26 2009 UTC
# Line 3  use Moose; Line 3  use Moose;
3    
4  extends 'Frey';  extends 'Frey';
5  with 'Frey::Web';  with 'Frey::Web';
6  #with 'Frey::Storage';  with 'Frey::File';
7    with 'Frey::Storage';
8    
9  use GraphViz;  use GraphViz;
10    
11  has skeleton => (  has filter => (
12            documentation => 'Regex to select classes',
13            is => 'rw',
14            isa => 'Str',
15            default => 'Frey',
16    );
17    
18    has path => (
19          is => 'rw',          is => 'rw',
20          isa => 'Str',          isa => 'Str',
21          required => 1,          required => 1,
22          default => 'skeleton',          default => 'var/introspect/',
23    );
24    
25    has produce_dot => (
26            is => 'rw',
27            isa => 'Bool',
28  );  );
29    
30  sub as_markup {  sub as_markup {
31          my ($self) = @_;          my ($self) = @_;
32    
33          my $g = GraphViz->new();          my $g = GraphViz->new(
34                    rankdir => 1, # horizontal
35    #               layout => 'neato', # grabs too much memory
36    #               layout => 'twopi', # grabs too much memory
37    #               overlap => 'compress',
38    #               no_overlap => 1,
39            );
40    
41            our $count = {};
42            my $filter = $self->filter;
43    
44            foreach my $path ( $self->dir_extension( $self->path, qr{\.(ya?ml)$}) ) {
45    
46                    my $class = $self->strip_path_extension( $path ) || die "can't strip $path";
47                    my $data = $self->load( $path );
48    #               warn "## $class $path ", $self->dump( $data ); # if $self->debug;
49    
50                    sub count_label {
51                            my ($self,$package) = @_;
52                            my $label = $package;
53                            $label .= $self->dump( $count->{$package} );
54                            return $label;
55                    }
56    
57          $g->add_node( 'foo' );                  next if $filter && $class !~ m{$filter};
         $g->add_node( 'bar' );  
58    
59          $g->add_edge( 'foo' => 'bar' );                  if ( my $includes = $data->{includes} ) {
60                            foreach my $type ( keys %$includes ) {
61                                    foreach my $package ( @{ $includes->{$type} } ) {
62    
63                                            my $usage = $count->{$package}->{$type}->{$class}++;
64    
65                                            my $label = $self->count_label($package);
66    
67                                            next if $filter && $package !~ m{$filter};
68    
69                                            warn "# $class\t$type\t$package\n$label\n";
70    
71                                            $g->add_edge( $class => $package, label => $type );
72                                    }
73                            }
74                    }
75    
76            }
77    
78            warn "# count ",$self->dump( $count );
79    
80            $self->store( 'var/classes.dot', $g->as_text );
81    
82            if ( $self->produce_dot ) {
83                    $self->content_type( 'text/plain' );
84                    return $g->as_canon;
85            }
86    
87          $self->content_type( 'image/png' );          $self->content_type( 'image/png' );
88          return $g->as_png;          return $g->as_png;
89    
90  }  }
91    
92  1;  1;
Legend:
Removed from v.971  
changed lines
  Added in v.972
  ViewVC Help
Powered by ViewVC 1.1.26