13 |
is => 'rw', |
is => 'rw', |
14 |
isa => 'Str', |
isa => 'Str', |
15 |
required => 1, |
required => 1, |
16 |
default => 'Frey', |
default => sub { |
17 |
|
'(' . join('|', map { s{lib/}{}; $_ } sort grep { -d $_ } glob("lib/*") ) . ')' |
18 |
|
}, |
19 |
); |
); |
20 |
|
|
21 |
|
|
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 => ( |
has show_extends => ( |
48 |
documentation => 'connect to superclasses', |
documentation => 'connect to superclasses', |
49 |
is => 'rw', |
is => 'rw', |
68 |
isa => 'Bool', |
isa => 'Bool', |
69 |
); |
); |
70 |
|
|
71 |
|
|
72 |
has portrait => ( |
has portrait => ( |
73 |
documentation => 'vertical layout', |
documentation => 'vertical layout', |
74 |
is => 'rw', |
is => 'rw', |
124 |
my $data = $self->load( $path ); |
my $data = $self->load( $path ); |
125 |
# warn "## $class $path ", $self->dump( $data ); # if $self->debug; |
# warn "## $class $path ", $self->dump( $data ); # if $self->debug; |
126 |
|
|
127 |
next if $filter && $class !~ m{$filter}; |
next if $filter && $self->filter_class && $class !~ m{$filter}; |
128 |
|
|
129 |
if ( $self->show_includes && defined $data->{includes} ) { |
if ( $self->show_includes && defined $data->{includes} ) { |
130 |
foreach my $type ( keys %{ $data->{includes} } ) { |
foreach my $type ( keys %{ $data->{includes} } ) { |
131 |
foreach my $package ( @{ $data->{includes}->{$type} } ) { |
foreach my $package ( @{ $data->{includes}->{$type} } ) { |
132 |
next if $filter && $package !~ m{$filter}; |
next if $filter && $self->filter_includes && $package !~ m{$filter}; |
133 |
warn "# $class\t$type\t$package\n"; |
warn "# $class\t$type\t$package\n"; |
134 |
$g->add_edge( $class => $package, label => $type, color => 'blue' ); |
$g->add_edge( $class => $package, label => $type, color => 'blue' ); |
135 |
$count->{$class}++; |
$count->{$class}++; |
140 |
|
|
141 |
if ( $self->show_roles && defined $data->{roles} ) { |
if ( $self->show_roles && defined $data->{roles} ) { |
142 |
foreach my $role ( keys %{ $data->{roles} } ) { |
foreach my $role ( keys %{ $data->{roles} } ) { |
143 |
next if $filter && $role !~ m{$filter}; |
next if $filter && $self->filter_roles && $role !~ m{$filter}; |
144 |
warn "# $class\trole\t$role\n"; |
warn "# $class\trole\t$role\n"; |
145 |
$g->add_edge( $role => $class, label => 'role', color => 'yellow' ); |
$g->add_edge( $role => $class, label => 'role', color => 'yellow' ); |
146 |
# $g->add_node( $role, rank => 'role' ); |
# $g->add_node( $role, rank => 'role' ); |
151 |
|
|
152 |
if ( $self->show_extends && defined $data->{superclass} ) { |
if ( $self->show_extends && defined $data->{superclass} ) { |
153 |
foreach my $extends ( keys %{ $data->{superclass} } ) { |
foreach my $extends ( keys %{ $data->{superclass} } ) { |
154 |
next if $filter && $extends !~ m{$filter}; |
next if $filter && $self->filter_extends && $extends !~ m{$filter}; |
155 |
warn "# $class\textends\t$extends\n"; |
warn "# $class\textends\t$extends\n"; |
156 |
$g->add_edge( $extends => $class, label => 'extends', color => 'green' ); |
$g->add_edge( $extends => $class, label => 'extends', color => 'green' ); |
157 |
$count->{$class}++; |
$count->{$class}++; |