File Coverage

lib/BalanceOfPower/Relations/Role/Relation.pm
Criterion Covered Total %
statement 26 61 42.6
branch 4 20 20.0
condition 8 31 25.8
subroutine 8 14 57.1
pod 0 11 0.0
total 46 137 33.5


line stmt bran cond sub pod time code
1             package BalanceOfPower::Relations::Role::Relation;
2             $BalanceOfPower::Relations::Role::Relation::VERSION = '0.400115';
3 13     13   5898 use strict;
  13         34  
  13         406  
4 13     13   54 use Moo::Role;
  13         29  
  13         78  
5 13     13   10783 use HTML::Entities;
  13         67083  
  13         9685  
6              
7             has node1 => (
8             is => 'ro'
9             );
10             has node2 => (
11             is => 'ro'
12             );
13              
14             sub bidirectional
15             {
16 114     114 0 374 return 1;
17             }
18              
19             sub has_node
20             {
21 143     143 0 176 my $self = shift;
22 143         158 my $node = shift;
23 143   100     1120 return $self->node1 eq $node || $self->node2 eq $node;
24             }
25             sub is_between
26             {
27 0     0 0 0 my $self = shift;
28 0   0     0 my $node1 = shift || "";
29 0   0     0 my $node2 = shift || "";
30              
31 0   0     0 return ($self->node1 eq $node1 && $self->node2 eq $node2) ||
32             ($self->node1 eq $node2 && $self->node2 eq $node1 && $self->bidirectional);
33             }
34             sub involve
35             {
36 9     9 0 17 my $self = shift;
37 9   50     40 my $node1 = shift || "";
38 9   50     28 my $node2 = shift || "";
39              
40 9   66     132 return ($self->node1 eq $node1 && $self->node2 eq $node2) ||
41             ($self->node1 eq $node2 && $self->node2 eq $node1);
42             }
43             sub destination
44             {
45 268     268 0 320 my $self = shift;
46 268         290 my $node = shift;
47 268 100 33     927 if($self->node1 eq $node)
    50          
48             {
49 154         617 return $self->node2;
50             }
51             elsif($self->node2 eq $node && $self->bidirectional)
52             {
53 114         414 return $self->node1;
54             }
55             else
56             {
57 0         0 return undef;
58             }
59             }
60             sub start
61             {
62 5     5 0 10 my $self = shift;
63 5         5 my $node = shift;
64 5 50 0     19 if($self->node2 eq $node)
    0          
65             {
66 5         18 return $self->node1;
67             }
68             elsif($self->node1 eq $node && $self->bidirectional)
69             {
70 0           return $self->node1;
71             }
72             else
73             {
74 0           return undef;
75             }
76             }
77             sub output
78             {
79 0     0 0   my $self = shift;
80 0           my $mode = shift;
81 0 0         if($mode eq 'print')
    0          
82             {
83 0           return $self->print;
84             }
85             elsif($mode eq 'html')
86             {
87 0           return $self->html;
88             }
89             }
90              
91              
92             sub print
93             {
94 0     0 0   my $self = shift;
95 0           my $from = shift;
96 0 0 0       if($from && $from eq $self->node1)
    0 0        
97             {
98 0           return $from . " -> " . $self->node2;
99             }
100             elsif($from && $from eq $self->node2 )
101             {
102 0 0         if($self->bidirectional)
103             {
104 0           return $self->node2 . " -> " . $self->node1;
105             }
106             else
107             {
108 0           return $self->node1 . " -> " . $self->node2;
109             }
110             }
111             else
112             {
113 0 0         if($self->bidirectional)
114             {
115 0           return $self->node1 . " <-> " . $self->node2;
116             }
117             else
118             {
119 0           return $self->node1 . " -> " . $self->node2;
120             }
121             }
122             }
123             sub html
124             {
125 0     0 0   my $self = shift;
126 0           return encode_entities($self->print);
127             }
128             sub dump
129             {
130 0     0 0   my $self = shift;
131 0           my $io = shift;
132 0   0       my $indent = shift || "";
133 0           print {$io} $indent . $self->node1 . ";" . $self->node2 . "\n";
  0            
134             }
135             sub load
136             {
137 0     0 0   my $self = shift;
138 0           my $data = shift;
139 0           $data =~ s/^\s+//;
140 0           chomp $data;
141 0           my ($node1, $node2) = split ";", $data;
142 0           return $self->new(node1 => $node1, node2 => $node2);
143             }
144             1;