File Coverage

blib/lib/GraphViz/Graph/Node.pm
Criterion Covered Total %
statement 11 37 29.7
branch 0 2 0.0
condition n/a
subroutine 4 9 44.4
pod 0 5 0.0
total 15 53 28.3


line stmt bran cond sub pod time code
1             package GraphViz::Graph::Node;
2              
3 9     9   48 use warnings;
  9         20  
  9         238  
4 9     9   40 use strict;
  9         18  
  9         144  
5 9     9   117 use 5.10.0; # state
  9         30  
6 9     9   43 use Carp;
  9         17  
  9         2554  
7              
8              
9             #_{ Version
10             our $VERSION = $GraphViz::Graph::Version;
11             #_}
12             #_{ Methods
13             #_{ POD
14              
15             =encoding utf8
16              
17             =head1 METHODS
18              
19             =cut
20              
21             #_}
22             sub new { #_{
23             #_{ POD
24             =head2 new
25             =cut
26             #_}
27 0     0 0   my $class = shift;
28 0           my $opts = shift;
29 0           my $self = {};
30              
31              
32             # croak 'Options expected' unless defined $opts;
33             # croak 'Options must be a HASH' unless ref $opts eq 'HASH';
34              
35             # croak "Unrecognized opts " . join "/", keys %$opts if keys %$opts;
36              
37 0           state $id = 0;
38 0           $self->{id} = sprintf('nd_%04d', ++$id);
39 0           $self->{shape} = 'none';
40              
41 0           bless $self, $class;
42              
43 0           $self->shape('none');
44 0           return $self;
45              
46             } #_}
47             sub label { #_{
48             #_{ POD
49             =head2 label
50             =cut
51             #_}
52              
53 0     0 0   my $self = shift;
54 0           my $opts = shift;
55              
56 0           $self->{label} = GraphViz::Graph::Label->new($opts);
57              
58             } #_}
59             sub shape { #_{
60             #_{ POD
61             =head2 shape
62              
63             Sets the shape of node. Possible values can be, among others:
64              
65             =over 4
66              
67             =item * C<'none'>
68              
69             =item * C<'point'>
70              
71             =item * C<'rect'>
72              
73             =item * C<'square'>
74              
75             =item * C<'star'>
76              
77             =item * etc …
78              
79             =back
80              
81             =cut
82             #_}
83              
84 0     0 0   my $self = shift;
85 0           my $shape_text = shift; # none, point, rect, square, star etc // TODO: record
86              
87 0           $self->{shape_text} = $shape_text;
88              
89 0           return $self;
90              
91             } #_}
92             sub dot_text { #_{
93             #_{ POD
94             =head2 dot_text
95              
96             Returns the dot-text that represents the node on which it was called.
97              
98             Called by L's C.
99              
100             =cut
101             #_}
102              
103 0     0 0   my $self = shift;
104              
105 0           my $ret = " $self->{id} [\n";
106 0           $ret .= " shape=" . $self->{shape_text} . "\n";
107              
108 0 0         if (exists $self->{label}) {
109 0           $ret .= " " . $self->{label}->dot_text();
110             }
111 0           $ret .= " ];\n\n";
112 0           return $ret;
113              
114             } #_}
115             sub port { #_{
116             #_{ POD
117             =head2 port
118              
119             C<< $node->port() >> is needed to connect from or to ports with edges.
120              
121             my $nd_one = $graph->node();
122             my $nd_two = $graph->node();
123              
124             $nd_two->label({html=>"
125            
fg
126            
"});
127              
128             $graph->edge($nd_one, $nd_two->port('port_f')):
129              
130             =cut
131              
132             #_}
133            
134 0     0 0   my $self = shift;
135 0           my $port_id = shift;
136              
137 0           return $self->{id} . ":$port_id";
138              
139             } #_}
140              
141             #_}
142              
143             'tq84';