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 |
|
|
100 |
isa => 'Bool', |
isa => 'Bool', |
101 |
); |
); |
102 |
|
|
103 |
|
has clusters => ( |
104 |
|
documentation => 'cluster by classes', |
105 |
|
is => 'rw', |
106 |
|
isa => 'Bool', |
107 |
|
); |
108 |
|
|
109 |
sub introspect_path { 'var/introspect/' }; |
sub introspect_path { 'var/introspect/' }; |
110 |
|
|
111 |
sub as_markup { |
sub as_markup { |
153 |
next if $filter && $self->filter_class && $class !~ m{$filter}; |
next if $filter && $self->filter_class && $class !~ m{$filter}; |
154 |
|
|
155 |
if ( $self->show_includes && defined $data->{includes} ) { |
if ( $self->show_includes && defined $data->{includes} ) { |
156 |
|
|
157 |
|
my $edge; |
158 |
|
|
159 |
foreach my $type ( keys %{ $data->{includes} } ) { |
foreach my $type ( keys %{ $data->{includes} } ) { |
160 |
foreach my $package ( @{ $data->{includes}->{$type} } ) { |
foreach my $package ( @{ $data->{includes}->{$type} } ) { |
161 |
next if $filter && $self->filter_includes && $package !~ m{$filter}; |
next if $filter && $self->filter_includes && $package !~ m{$filter}; |
162 |
warn "# $class\t$type\t$package\n"; |
warn "# $class\t$type\t$package\n"; |
163 |
$g->add_edge( $class => $package, label => $type, color => 'blue' ); |
my $e = "$class $package"; |
164 |
|
if ( $edge->{$e} ) { |
165 |
|
$edge->{$e}->{style} = 'dashed'; |
166 |
|
$edge->{$e}->{label} .= "\n$type"; |
167 |
|
} else { |
168 |
|
$edge->{$e} = { |
169 |
|
color => 'blue', |
170 |
|
label => $type, |
171 |
|
}; |
172 |
|
} |
173 |
$count->{$class}++; |
$count->{$class}++; |
174 |
$count->{$package}++; |
$count->{$package}++; |
175 |
} |
} |
176 |
} |
} |
177 |
|
|
178 |
|
foreach my $e ( keys %$edge ) { |
179 |
|
my ($c,$p) = split(/\s/, $e); |
180 |
|
$g->add_edge( $c => $p, %{ $edge->{$e} } ) |
181 |
|
} |
182 |
|
|
183 |
} |
} |
184 |
|
|
185 |
if ( $self->show_roles && defined $data->{roles} ) { |
if ( $self->show_roles && defined $data->{roles} ) { |
219 |
my $pcnt = $v / $max_count; |
my $pcnt = $v / $max_count; |
220 |
my $color = join(",", ( $pcnt, $pcnt, 0.75 ) ); |
my $color = join(",", ( $pcnt, $pcnt, 0.75 ) ); |
221 |
|
|
222 |
|
my @cluster; |
223 |
|
if ( $self->clusters ) { |
224 |
|
my $name = $1 if $node =~ m{^([^:]+)}; |
225 |
|
@cluster = ( 'cluster' => { |
226 |
|
name => $name, |
227 |
|
style => 'filled', |
228 |
|
bgcolor => 'lightgrey', |
229 |
|
color => 'lightgrey', |
230 |
|
}); |
231 |
|
} |
232 |
|
|
233 |
$g->add_node( $node, |
$g->add_node( $node, |
234 |
style =>'filled', |
style =>'filled', |
235 |
color => $color, |
color => $color, |
236 |
fillcolor => $color, |
fillcolor => $color, |
237 |
# label => "$node\n$v", |
# label => "$node\n$v", |
238 |
|
@cluster, |
239 |
); |
); |
240 |
|
|
241 |
} |
} |
251 |
|
|
252 |
} |
} |
253 |
|
|
254 |
|
__PACKAGE__->meta->make_immutable; |
255 |
|
no Moose; |
256 |
|
|
257 |
1; |
1; |