File Coverage

blib/lib/Farly/Object/Set.pm
Criterion Covered Total %
statement 92 104 88.4
branch 33 48 68.7
condition n/a
subroutine 15 17 88.2
pod 12 13 92.3
total 152 182 83.5


line stmt bran cond sub pod time code
1             package Farly::Object::Set;
2            
3 16     16   17897 use 5.008008;
  16         54  
  16         743  
4 16     16   85 use strict;
  16         29  
  16         688  
5 16     16   78 use warnings;
  16         33  
  16         496  
6 16     16   89 use Carp;
  16         27  
  16         45610  
7            
8             our $VERSION = '0.26';
9            
10             sub new {
11 7     7 1 15 my ($class) = @_;
12 7         22 return bless [], $class;
13             }
14            
15             sub add {
16 11     11 1 27 my ( $self, $object ) = @_;
17            
18 11 50       24 croak "Farly::Object object required"
19             unless ( defined $object );
20            
21 11 50       34 croak "Farly::Object object required"
22             unless ( $object->isa('Farly::Object') );
23            
24 11         12 push @{$self}, $object;
  11         32  
25             }
26            
27             sub size {
28 10     10 1 12 return scalar( @{ $_[0] } );
  10         30  
29             }
30            
31             sub iter {
32 27     27 1 25 return @{ $_[0] };
  27         50  
33             }
34            
35             sub equals {
36 4     4 1 12 my ( $self, $other ) = @_;
37            
38 4 100       38 if ( $other->isa(__PACKAGE__) ) {
39            
40 3 100       11 if ( $self->size() != $other->size() ) {
41 1         5 return undef;
42             }
43            
44 2         6 foreach my $s ( $self->iter() ) {
45 3         5 my $match;
46 3         7 foreach my $o ( $other->iter() ) {
47 5 100       14 if ( $s->equals($o) ) {
48 3         6 $match = 1;
49             }
50             }
51 3 50       9 if ( !$match ) {
52 0         0 return undef;
53             }
54             }
55            
56 2         8 return 1;
57             }
58             }
59            
60             sub contains {
61 2     2 1 4 my ( $self, $other ) = @_;
62            
63 2 50       17 if ( $other->isa(__PACKAGE__) ) {
64            
65 2         4 foreach my $o ( $other->iter() ) {
66 3         4 my $contained;
67 3         6 foreach my $s ( $self->iter() ) {
68 3 100       10 if ( $s->contains($o) ) {
69 2         3 $contained = 1;
70 2         3 last;
71             }
72             }
73 3 100       9 if ( !$contained ) {
74 1         4 return undef;
75             }
76             }
77 1         4 return 1;
78             }
79            
80 0 0       0 if ( $other->isa('Farly::Object') ) {
81 0         0 foreach my $s ( $self->iter() ) {
82 0 0       0 return 1 if ( $s->contains($other) );
83             }
84             }
85             }
86            
87             sub includes {
88 6     6 1 11 my ( $self, $other ) = @_;
89            
90 6 100       34 if ( $other->isa(__PACKAGE__) ) {
91            
92 1         2 foreach my $o ( $other->iter() ) {
93 2         3 my $included;
94 2         4 foreach my $s ( $self->iter() ) {
95 7 100       16 if ( $s->matches($o) ) {
96 2         4 $included = 1;
97 2         3 last;
98             }
99             }
100 2 50       6 if ( !$included ) {
101 0         0 return undef;
102             }
103             }
104 1         14 return 1;
105             }
106            
107 5 50       31 if ( $other->isa('Farly::Object') ) {
108 5         9 foreach my $s ( $self->iter() ) {
109 7 100       15 if ( $s->matches($other) ) {
110 4         13 return 1;
111             }
112             }
113             }
114             }
115            
116             sub intersects {
117 0     0 1 0 my ( $self, $other ) = @_;
118 0 0       0 return 1 if ( $self->intersection($other)->size() >= 1 );
119             }
120            
121             sub intersection {
122 2     2 1 3 my ( $self, $other ) = @_;
123            
124 2 50       19 confess "Set required"
125             unless $other->isa(__PACKAGE__);
126            
127 2         5 my $isect = __PACKAGE__->new();
128            
129 2         5 foreach my $s ( $self->iter() ) {
130 2         6 foreach my $o ( $other->iter() ) {
131 3 100       8 if ( $s->matches($o) ) {
132 1         2 $isect->add($s);
133 1         3 last;
134             }
135             }
136             }
137            
138 2         5 return $isect;
139             }
140            
141             sub union {
142 1     1 1 1 my ( $self, $other ) = @_;
143            
144 1 50       6 confess "Set required"
145             unless $other->isa(__PACKAGE__);
146            
147 1         2 my $union = __PACKAGE__->new();
148            
149 1         3 foreach my $s ( $self->iter() ) {
150 1         2 $union->add($s);
151             }
152            
153 1         4 foreach my $o ( $other->iter() ) {
154 2 100       5 if ( !$union->includes($o) ) {
155 1         3 $union->add($o);
156             }
157             }
158            
159 1         3 return $union;
160             }
161            
162             sub disjoint {
163 1     1 1 5 my ( $self, $other ) = @_;
164 1         3 my $isect = $self->intersection($other);
165 1         3 return $isect->size() == 0;
166             }
167            
168             sub difference {
169 1     1 1 2 my ( $self, $other ) = @_;
170            
171 1 50       5 confess "Set required"
172             unless $other->isa(__PACKAGE__);
173            
174 1         3 my $diff = __PACKAGE__->new();
175            
176 1         2 foreach my $s ( $self->iter() ) {
177 2         3 my $in_other;
178 2         4 foreach my $o ( $other->iter() ) {
179 2 100       5 if ( $s->matches($o) ) {
180 1         1 $in_other = 1;
181 1         2 last;
182             }
183             }
184 2 100       5 if ( !$in_other ) {
185 1         3 $diff->add($s);
186             }
187             }
188            
189 1         4 return $diff;
190             }
191            
192             sub as_string {
193 0     0 0   my ($self) = @_;
194            
195             #carp "called as_string on Set";
196 0           my $string;
197 0           foreach my $s ( $self->iter() ) {
198 0           $string .= $s->as_string() . " ";
199             }
200 0           return $string;
201             }
202            
203             1;
204             __END__