File Coverage

blib/lib/GraphViz/Graph.pm
Criterion Covered Total %
statement 49 74 66.2
branch 8 16 50.0
condition 1 2 50.0
subroutine 10 14 71.4
pod 1 7 14.2
total 69 113 61.0


line stmt bran cond sub pod time code
1             #_{ Encoding and name
2             =encoding utf8
3              
4             =head1 NAME
5              
6             GraphViz::Graph - Object Oriented interface to graphviz.
7             =cut
8              
9             package GraphViz::Graph;
10              
11 9     9   47372 use strict;
  9         22  
  9         222  
12 9     9   42 use warnings;
  9         16  
  9         183  
13 9     9   4154 use utf8;
  9         114  
  9         85  
14             #_}
15             #_{ Version
16             =head1 VERSION
17              
18             Version 0.02
19              
20             =cut
21              
22             our $VERSION = '0.02';
23             #_}
24             #_{ Synopsis
25             =head1 SYNOPSIS
26              
27             use GraphViz::Graph;
28              
29             my $graph = GraphViz::Graph->new('filename-without-suffix');
30              
31             # Create nodes:
32             my $nd_1 = $graph->node(…);
33             my $nd_2 = $graph->node(…);
34              
35             # Connect nodes:
36             $graph->edge($nd_1, $nd_2);
37              
38             # Create .dot file, run graphviz/dot to
39             # create filename-without-suffix.png:
40             $graph->create('png');
41             =cut
42             #_}
43             #_{ use …
44              
45 9     9   412 use Carp;
  9         18  
  9         550  
46 9     9   2732 use GraphViz::Graph::Edge;
  9         62  
  9         220  
47 9     9   2732 use GraphViz::Graph::Label;
  9         25  
  9         298  
48 9     9   2704 use GraphViz::Graph::Node;
  9         24  
  9         4041  
49              
50             #_}
51             #_{ Methods
52             =head1 METHODS
53             =cut
54              
55             sub new { #_{
56              
57             =head2 new
58              
59             my $graph = GraphViz::Graph->new('FileNameBase');
60              
61             Start a graph. C<'FileNameBase'> is the base name for the produced dot and png/pdf/svg… etc. output file.
62             =cut
63              
64 5     5 1 2206 my $class = shift;
65 5         11 my $file_base_name = shift;
66 5   50     31 my $opts = shift // {};
67              
68 5         13 my $self = {};
69              
70 5 100       27 croak 'File base name must be passed' unless defined $file_base_name;
71 4 100       40 croak 'File base name must be sclar' unless ref \$file_base_name eq 'SCALAR';
72              
73 2         8 $self -> {file_base_name} = $file_base_name;
74              
75             # $opts->{file_base_name} = $file_base_name;
76              
77 2 50       11 croak "Unrecognized opts " . join "/", keys %$opts if keys %$opts;
78              
79 2         6 $self->{nodes} = [];
80 2         7 $self->{edges} = [];
81              
82 2         5 bless $self, $class;
83 2         9 return $self;
84              
85             } #_}
86             sub label { #_{
87             #_{ POD
88             =head2 label
89              
90             GraphViz::Graph->label({text => 'Graph Title'}');
91             GraphViz::Graph->label({html => 'Say Hello World'}');
92              
93             Add a label to a graph. Most probably used as a title.
94              
95             =cut
96             #_}
97 0     0 0 0 my $self = shift;
98 0         0 my $opts = shift;
99              
100 0         0 $self -> {label} = GraphViz::Graph::Label->new($opts);
101              
102             } #_}
103             sub node { #_{
104             #_{
105             =head2 node
106              
107             my $nd_foo = GraphViz::Graph->node();
108             # … later:
109             $nd_foo -> label({html=>"BoldItalic"});
110              
111             Add a node to a graph
112              
113             =cut
114             #_}
115 0     0 0 0 my $self = shift;
116 0         0 my $opts = shift;
117              
118              
119 0         0 my $node = GraphViz::Graph::Node -> new($opts);
120              
121 0         0 push @{$self->{nodes}}, $node;
  0         0  
122              
123 0         0 return $node;
124              
125             } #_}
126             sub edge { #_{
127             #_{
128             =head2 edge
129              
130             Add an edge to a graph.
131              
132             my $nd_one = $graph->node();
133             my $nd_two = $graph->node();
134             my $nd_three = $graph->node();
135              
136             $nd_one->label({html=>"…"});
137              
138             $nd_two->label({html=>"
139            
fg
140            
"});
141              
142             $graph->edge($nd_one, $nd_two->port('port_f')):
143             $graph->edge($nd_two, $nd_three);
144              
145             =cut
146             #_}
147 0     0 0 0 my $self = shift;
148 0         0 my $from = shift;
149 0         0 my $to = shift;
150              
151 0         0 my $edge = GraphViz::Graph::Edge -> new($from, $to);
152              
153 0         0 push @{$self->{edges}}, $edge;
  0         0  
154              
155 0         0 return $edge;
156              
157             } #_}
158             sub write_dot { #_{
159              
160 1     1 0 2 my $self = shift;
161 1         102 open my $out, '>', "$self->{file_base_name}.dot";
162              
163 1         12 print $out "digraph {\n";
164              
165 1         3 for my $node (@{$self->{nodes}}) {
  1         4  
166 0         0 print $out $node -> dot_text();
167             }
168 1         2 for my $edge (@{$self->{edges}}) {
  1         3  
169 0         0 print $out $edge -> dot_text();
170             }
171              
172             # Define the graph label end of your dot file,
173             # otherwise subgraphs will inherit those properties.
174             # https://stackoverflow.com/a/4716607/180275
175 1 50       5 if ($self->{label}) {
176 0         0 print $out $self->{label}->dot_text;
177             }
178              
179 1         54 print $out "}\n";
180              
181             } #_}
182             sub create { #_{
183              
184 1     1 0 10 my $self = shift;
185 1         2 my $filetype = shift;
186              
187 1 50       4 croak "unspecified filetype" unless $filetype;
188              
189 1         5 $self->write_dot();
190              
191 1         6 my $command = "dot $self->{file_base_name}.dot -T$filetype -o$self->{file_base_name}.$filetype";
192              
193 1         1771 my $rc = system ($command);
194              
195 1 50       277 croak "rc = $rc, command=$command" if $rc;
196              
197             } #_}
198             sub node_or_port_to_string_ { #_{
199             #_{ POD
200             =head2 node_or_port_to_string_
201              
202             This function is internally used by the constructur (C) of L.
203              
204             =cut
205             #_}
206              
207 0     0 0   my $node_or_port = shift;
208              
209 0 0         if (ref $node_or_port eq 'GraphViz::Graph::Node') {
210 0           return $node_or_port->{id};
211             }
212 0 0         unless (ref $node_or_port) {
213             # String ???
214 0           return $node_or_port;
215             }
216              
217 0           croak "Graph - node_or_port ($node_or_port) neither Node nor string";
218             } #_}
219              
220             #_}
221             #_{ POD: Copyright
222              
223             =head1 Copyright
224              
225             Copyright © 2017 René Nyffenegger, Switzerland. All rights reserved.
226              
227             This program is free software; you can redistribute it and/or modify it
228             under the terms of the the Artistic License (2.0). You may obtain a
229             copy of the full license at: L
230              
231             =cut
232              
233             #_}
234             #_{ Testing
235              
236             =head1 Testing
237              
238             The tests need L.
239              
240             =cut
241              
242             #_}
243             'tq84'