| 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; |