Frey/Class/Graph.pm

package Frey::Class::Graph;
use Moose;

extends 'Frey';
with 'Frey::Web';
with 'Frey::File';
with 'Frey::Storage';

use GraphViz;

has filter => (
        documentation => 'Regex to select classes',
        is => 'rw',
        isa => 'Str',
        default => 'Frey',
);

has path => (
        is => 'rw',
        isa => 'Str',
        required => 1,
        default => 'var/introspect/',
);

has produce_dot => (
        is => 'rw',
        isa => 'Bool',
);

sub as_markup {
        my ($self) = @_;

        my $g = GraphViz->new(
                rankdir => 1, # horizontal
#               layout => 'neato', # grabs too much memory
#               layout => 'twopi', # grabs too much memory
#               overlap => 'compress',
#               no_overlap => 1,
        );

        our $count = {};
        my $filter = $self->filter;

        foreach my $path ( $self->dir_extension( $self->path, qr{\.(ya?ml)$}) ) {

                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};

                if ( my $includes = $data->{includes} ) {
                        foreach my $type ( keys %$includes ) {
                                foreach my $package ( @{ $includes->{$type} } ) {

                                        my $usage = $count->{$package}->{$type}->{$class}++;

                                        my $label = $self->count_label($package);

                                        next if $filter && $package !~ m{$filter};

                                        warn "# $class\t$type\t$package\n$label\n";

                                        $g->add_edge( $class => $package, label => $type );
                                }
                        }
                }

=for later

                foreach my $role ( keys %{ $data->{roles} } ) {
                        next if $filter && $role !~ m{$filter};
                        $g->add_edge( $role => $class, label => 'role' );
                }

=cut

        }

        warn "# count ",$self->dump( $count );


        if ( $self->produce_dot ) {
                $self->content_type( 'text/plain' );
                $self->store( 'var/classes.dot', $g->as_canon );
                return $g->as_canon;
        }

        $self->content_type( 'image/png' );
        return $g->as_png;

}

1;
1	package Frey::Class::Graph;
2	use Moose;
3
4	extends 'Frey';
5	with 'Frey::Web';
6	with 'Frey::File';
7	with 'Frey::Storage';
8
9	use GraphViz;
10
11	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',
20	isa => 'Str',
21	required => 1,
22	default => 'var/introspect/',
23	);
24
25	has produce_dot => (
26	is => 'rw',
27	isa => 'Bool',
28	);
29
30	sub as_markup {
31	my ($self) = @_;
32
33	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	next if $filter && $class !~ m{$filter};
58
59	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	=for later
77
78	foreach my $role ( keys %{ $data->{roles} } ) {
79	next if $filter && $role !~ m{$filter};
80	$g->add_edge( $role => $class, label => 'role' );
81	}
82
83	=cut
84
85	}
86
87	warn "# count ",$self->dump( $count );
88
89
90	if ( $self->produce_dot ) {
91	$self->content_type( 'text/plain' );
92	$self->store( 'var/classes.dot', $g->as_canon );
93	return $g->as_canon;
94	}
95
96	$self->content_type( 'image/png' );
97	return $g->as_png;
98
99	}
100
101	1;