line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Graphviz::DSL::Node; |
2
|
8
|
|
|
8
|
|
49434
|
use strict; |
|
8
|
|
|
|
|
18
|
|
|
8
|
|
|
|
|
429
|
|
3
|
8
|
|
|
8
|
|
43
|
use warnings; |
|
8
|
|
|
|
|
17
|
|
|
8
|
|
|
|
|
241
|
|
4
|
|
|
|
|
|
|
|
5
|
8
|
|
|
8
|
|
7834
|
use parent qw/Graphviz::DSL::Component/; |
|
8
|
|
|
|
|
1212
|
|
|
8
|
|
|
|
|
44
|
|
6
|
|
|
|
|
|
|
|
7
|
8
|
|
|
8
|
|
473
|
use Carp (); |
|
8
|
|
|
|
|
16
|
|
|
8
|
|
|
|
|
189
|
|
8
|
8
|
|
|
8
|
|
40
|
use Scalar::Util qw/blessed/; |
|
8
|
|
|
|
|
15
|
|
|
8
|
|
|
|
|
956
|
|
9
|
8
|
|
|
8
|
|
1188
|
use Graphviz::DSL::Util qw/parse_id validate_compass/; |
|
8
|
|
|
|
|
21
|
|
|
8
|
|
|
|
|
10529
|
|
10
|
|
|
|
|
|
|
|
11
|
|
|
|
|
|
|
sub new { |
12
|
356
|
|
|
356
|
0
|
21324
|
my ($class, %args) = @_; |
13
|
|
|
|
|
|
|
|
14
|
356
|
100
|
|
|
|
1016
|
unless (exists $args{id}) { |
15
|
1
|
|
|
|
|
219
|
Carp::croak("missing mandatory parameter 'id'"); |
16
|
|
|
|
|
|
|
} |
17
|
|
|
|
|
|
|
|
18
|
355
|
|
|
|
|
589
|
my $id = delete $args{id}; |
19
|
355
|
|
100
|
|
|
1354
|
my $attrs = delete $args{attributes} || []; |
20
|
355
|
50
|
|
|
|
930
|
unless (ref $attrs eq 'ARRAY') { |
21
|
0
|
|
|
|
|
0
|
Carp::croak("'attributes' parameter should be ArrayRef"); |
22
|
|
|
|
|
|
|
} |
23
|
|
|
|
|
|
|
|
24
|
355
|
|
100
|
|
|
1299
|
my $port = delete $args{port} || undef; |
25
|
355
|
|
100
|
|
|
5681
|
my $compass = delete $args{compass} || undef; |
26
|
|
|
|
|
|
|
|
27
|
355
|
100
|
|
|
|
774
|
if (defined $compass) { |
28
|
21
|
|
|
|
|
61
|
validate_compass($compass); |
29
|
|
|
|
|
|
|
} |
30
|
|
|
|
|
|
|
|
31
|
|
|
|
|
|
|
bless { |
32
|
354
|
|
|
|
|
3074
|
id => $id, |
33
|
|
|
|
|
|
|
attributes => $attrs, |
34
|
|
|
|
|
|
|
port => $port, |
35
|
|
|
|
|
|
|
compass => $compass, |
36
|
|
|
|
|
|
|
}, $class; |
37
|
|
|
|
|
|
|
} |
38
|
|
|
|
|
|
|
|
39
|
|
|
|
|
|
|
sub as_string { |
40
|
66
|
|
|
66
|
0
|
93
|
my $self = shift; |
41
|
|
|
|
|
|
|
|
42
|
66
|
|
|
|
|
141
|
my $str = qq{"$self->{id}"}; |
43
|
66
|
100
|
|
|
|
154
|
if ($self->{port}) { |
44
|
2
|
|
|
|
|
4
|
$str .= qq{:"$self->{port}"}; |
45
|
|
|
|
|
|
|
} |
46
|
|
|
|
|
|
|
|
47
|
66
|
50
|
|
|
|
132
|
if ($self->{compass}) { |
48
|
0
|
|
|
|
|
0
|
$str .= ":$self->{compass}"; |
49
|
|
|
|
|
|
|
} |
50
|
|
|
|
|
|
|
|
51
|
66
|
|
|
|
|
720
|
return $str; |
52
|
|
|
|
|
|
|
} |
53
|
|
|
|
|
|
|
|
54
|
|
|
|
|
|
|
sub update_attributes { |
55
|
4
|
|
|
4
|
0
|
18
|
my ($self, $attrs) = @_; |
56
|
|
|
|
|
|
|
|
57
|
4
|
|
|
|
|
12
|
OUTER: |
58
|
4
|
|
|
|
|
9
|
for my $attr (@{$attrs}) { |
59
|
6
|
|
|
|
|
11
|
my ($key, $val) = @{$attr}; |
|
6
|
|
|
|
|
13
|
|
60
|
6
|
|
|
|
|
10
|
for my $old_attr (@{$self->{attributes}}) { |
|
6
|
|
|
|
|
18
|
|
61
|
7
|
|
|
|
|
10
|
my ($old_key, $old_val) = @{$old_attr}; |
|
7
|
|
|
|
|
14
|
|
62
|
|
|
|
|
|
|
|
63
|
7
|
100
|
|
|
|
22
|
if ($key eq $old_key) { |
64
|
2
|
|
|
|
|
653
|
$old_attr->[1] = $val; |
65
|
2
|
|
|
|
|
9
|
next OUTER; |
66
|
|
|
|
|
|
|
} |
67
|
|
|
|
|
|
|
} |
68
|
|
|
|
|
|
|
|
69
|
4
|
|
|
|
|
8
|
push @{$self->{attributes}}, $attr; |
|
4
|
|
|
|
|
21
|
|
70
|
|
|
|
|
|
|
} |
71
|
|
|
|
|
|
|
} |
72
|
|
|
|
|
|
|
|
73
|
|
|
|
|
|
|
sub equal_to { |
74
|
756
|
|
|
756
|
0
|
1230
|
my ($self, $node) = @_; |
75
|
|
|
|
|
|
|
|
76
|
756
|
50
|
33
|
|
|
5358
|
unless (blessed $node && $node->isa('Graphviz::DSL::Node')) { |
77
|
0
|
|
|
|
|
0
|
return 0; |
78
|
|
|
|
|
|
|
} |
79
|
|
|
|
|
|
|
|
80
|
756
|
100
|
|
|
|
2538
|
unless ($self->{id} eq $node->{id}) { |
81
|
654
|
|
|
|
|
3211
|
return 0; |
82
|
|
|
|
|
|
|
} |
83
|
|
|
|
|
|
|
|
84
|
102
|
100
|
|
|
|
208
|
my ($port1, $port2) = map { defined $_ ? $_ : '' } ($self->{port}, $node->{port}); |
|
204
|
|
|
|
|
734
|
|
85
|
102
|
50
|
|
|
|
244
|
unless ($port1 eq $port2) { |
86
|
0
|
|
|
|
|
0
|
return 0; |
87
|
|
|
|
|
|
|
} |
88
|
|
|
|
|
|
|
|
89
|
102
|
100
|
|
|
|
328
|
my ($comp1, $comp2) = map { defined $_ ? $_ : '' } ($self->{compass}, $node->{compass}); |
|
204
|
|
|
|
|
491
|
|
90
|
102
|
100
|
|
|
|
231
|
unless ($comp1 eq $comp2) { |
91
|
1
|
|
|
|
|
8
|
return 0; |
92
|
|
|
|
|
|
|
} |
93
|
|
|
|
|
|
|
|
94
|
101
|
|
|
|
|
506
|
return 1; |
95
|
|
|
|
|
|
|
} |
96
|
|
|
|
|
|
|
|
97
|
|
|
|
|
|
|
sub update { |
98
|
0
|
|
|
0
|
0
|
0
|
my ($self, $node_id) = @_; |
99
|
|
|
|
|
|
|
|
100
|
0
|
|
|
|
|
0
|
my ($id, $port, $compass) = parse_id($node_id); |
101
|
|
|
|
|
|
|
|
102
|
|
|
|
|
|
|
# id is same |
103
|
0
|
|
|
|
|
0
|
$self->{port} = $port; |
104
|
0
|
|
|
|
|
0
|
$self->{compass} = $compass; |
105
|
|
|
|
|
|
|
} |
106
|
|
|
|
|
|
|
|
107
|
|
|
|
|
|
|
# accessor |
108
|
344
|
|
|
344
|
0
|
3142
|
sub id { $_[0]->{id}; } |
109
|
3
|
|
|
3
|
0
|
16
|
sub port { $_[0]->{port}; } |
110
|
5
|
|
|
5
|
0
|
21
|
sub compass { $_[0]->{compass}; } |
111
|
|
|
|
|
|
|
|
112
|
|
|
|
|
|
|
1; |