File Coverage

blib/lib/Map/Tube/GraphViz.pm
Criterion Covered Total %
statement 16 18 88.8
branch n/a
condition n/a
subroutine 6 6 100.0
pod n/a
total 22 24 91.6


line stmt bran cond sub pod time code
1             package Map::Tube::GraphViz;
2              
3             # Pragmas.
4 3     3   27828 use strict;
  3         5  
  3         93  
5 3     3   11 use warnings;
  3         3  
  3         81  
6              
7             # Modules.
8 3     3   1395 use Class::Utils qw(set_params);
  3         55863  
  3         59  
9 3     3   164 use English;
  3         4  
  3         15  
10 3     3   1257 use Error::Pure qw(err);
  3         4  
  3         99  
11 3     3   65636 use GraphViz2;
  0            
  0            
12             use List::MoreUtils qw(none);
13             use Map::Tube::GraphViz::Utils qw(node_color);
14             use Scalar::Util qw(blessed);
15              
16             # Version.
17             our $VERSION = 0.06;
18              
19             # Constructor.
20             sub new {
21             my ($class, @params) = @_;
22              
23             # Create object.
24             my $self = bless {}, $class;
25              
26             # Edge callback.
27             $self->{'callback_edge'} = sub {
28             my ($self, $from, $to) = @_;
29             $self->{'g'}->add_edge(
30             'from' => $from,
31             'to' => $to,
32             );
33             return;
34             };
35              
36             # Node callback.
37             $self->{'callback_node'} = \&node_color;
38              
39             # Driver.
40             $self->{'driver'} = 'neato';
41              
42             # Name of map.
43             $self->{'name'} = undef;
44              
45             # GraphViz2 object.
46             $self->{'g'} = undef;
47              
48             # Output.
49             $self->{'output'} = 'png';
50              
51             # Map::Tube object.
52             $self->{'tube'} = undef;
53              
54             # Process params.
55             set_params($self, @params);
56              
57             # Check Map::Tube object.
58             if (! defined $self->{'tube'}) {
59             err "Parameter 'tube' is required.";
60             }
61             if (! defined &UNIVERSAL::DOES) {
62             eval {
63             require UNIVERSAL::DOES;
64             };
65             if ($EVAL_ERROR) {
66             err 'Cannot load UNIVERSAL::DOES module.';
67             }
68             }
69             if (! blessed($self->{'tube'})
70             || ! $self->{'tube'}->DOES('Map::Tube')) {
71              
72             err "Parameter 'tube' must be 'Map::Tube' object.";
73             }
74              
75             # GraphViz2 object.
76             if (defined $self->{'g'}) {
77             if (defined $self->{'name'}) {
78             err "Parameter 'name' cannot be used with ".
79             "'g' parameter.";
80             }
81              
82             # Check GraphViz2 object.
83             if (! blessed($self->{'g'})
84             || ! $self->{'g'}->isa('GraphViz2')) {
85              
86             err "Parameter 'g' must be 'GraphViz2' object.";
87             }
88             } else {
89             my $name = $self->{'name'};
90             if (! defined $name) {
91             $name = $self->{'tube'}->name;
92             }
93             $self->{'g'} = GraphViz2->new(
94             'global' => {
95             'directed' => 0,
96             },
97             $name ? (
98             'graph' => {
99             'label' => $name,
100             'labelloc' => 'top',
101             },
102             ) : (),
103             );
104             }
105              
106             # Check output format.
107             if (! defined $self->{'output'}) {
108             err "Parameter 'output' is required.";
109             }
110             if (none { $self->{'output'} eq $_ }
111             keys %{$self->{'g'}->valid_attributes->{'output_format'}}) {
112              
113             err "Unsupported 'output' parameter '$self->{'output'}'.";
114             }
115              
116             # Object.
117             return $self;
118             }
119              
120             # Get graph.
121             sub graph {
122             my ($self, $output_file) = @_;
123             foreach my $node (values %{$self->{'tube'}->nodes}) {
124             $self->{'callback_node'}->($self, $node);
125             }
126             my @processed;
127             foreach my $node (values %{$self->{'tube'}->nodes}) {
128             foreach my $link (split m/,/ms, $node->link) {
129             if (none {
130             ($_->[0] eq $node->id && $_->[1] eq $link)
131             ||
132             ($_->[0] eq $link && $_->[1] eq $node->id)
133             } @processed) {
134              
135             $self->{'callback_edge'}->($self, $node->id,
136             $link);
137             push @processed, [$node->id, $link];
138             }
139             }
140             }
141             eval {
142             $self->{'g'}->run(
143             'driver' => $self->{'driver'},
144             'format' => $self->{'output'},
145             'output_file' => $output_file,
146             );
147             };
148             if ($EVAL_ERROR) {
149             err 'Cannot create GraphViz output.',
150             'Error', $EVAL_ERROR,
151             'Dot input', $self->{'g'}->dot_input;
152             }
153             return;
154             }
155              
156             1;
157              
158             __END__