File Coverage

blib/lib/Array/Set.pm
Criterion Covered Total %
statement 153 184 83.1
branch 150 190 78.9
condition 23 36 63.8
subroutine 9 9 100.0
pod 4 4 100.0
total 339 423 80.1


line stmt bran cond sub pod time code
1             package Array::Set;
2              
3 1     1   73201 use 5.010001;
  1         11  
4 1     1   5 use strict;
  1         2  
  1         20  
5 1     1   5 use warnings;
  1         2  
  1         42  
6              
7 1     1   14 use Exporter qw(import);
  1         2  
  1         2071  
8              
9             our $AUTHORITY = 'cpan:PERLANCAR'; # AUTHORITY
10             our $DATE = '2021-10-12'; # DATE
11             our $DIST = 'Array-Set'; # DIST
12             our $VERSION = '0.063'; # VERSION
13              
14             our @EXPORT_OK = qw(set_diff set_symdiff set_union set_intersect);
15              
16             sub _doit {
17 12     12   18 my $op = shift;
18              
19 12         17 my $opts;
20 12 50       37 if (ref($_[0]) eq 'HASH') {
21 12         17 $opts = shift;
22             } else {
23 0         0 $opts = {};
24             }
25              
26 12         579 require Tie::IxHash;
27 12         4716 tie my(%res), 'Tie::IxHash';
28              
29 12         175 my $ic = $opts->{ignore_case};
30 12         18 my $ib = $opts->{ignore_blanks};
31 12         16 my $ar = $opts->{allow_refs};
32 12   33     41 my $ign = $ic || $ib || $ar;
33              
34 12 100       24 if ($ar) {
35 4         668 require Storable;
36             }
37              
38 12         4130 my $i = 0;
39             SET:
40 12         34 for my $i (1..@_) {
41 24         37 my $set = $_[$i-1];
42              
43 24 100       93 if ($op eq 'union') {
    100          
    100          
    50          
44              
45 6 50       15 if ($ign) {
46 6         11 for (@$set) {
47              
48             # determine key (this code is copy-pasted)
49 15 100       141 my $k = $ar ? (ref $_ ? "R" : defined($_) ? "S":"U") : ""; # R=ref/undef, D=defined scalar, U=undef
    100          
    100          
50 15 100       34 if ($k eq 'R') {
    100          
51 3         7 $k .= Storable::freeze($_);
52             } elsif (defined $_) {
53 11 100       22 $k .= $ic ? lc($_) : $_;
54 11 100       25 $k =~ s/\s+//g if $ib;
55             }
56              
57 15 100       163 $res{$k} = $_ unless exists $res{$k};
58             }
59             # return result
60 6 100       114 if ($i == @_) {
61 3         9 return [values %res];
62             }
63             } else {
64 0         0 for (@$set) { $res{$_}++ }
  0         0  
65             # return result
66 0 0       0 if ($i == @_) {
67 0         0 return [keys %res];
68             }
69             }
70              
71             } elsif ($op eq 'intersect') {
72              
73 6 50       12 if ($ign) {
74 6 100       13 if ($i == 1) {
75 3         6 for (@$set) {
76              
77             # determine key (this code is copy-pasted)
78 8 50       121 my $k = $ar ? (ref $_ ? "R" : defined($_) ? "S":"U") : ""; # R=ref/undef, D=defined scalar, U=undef
    100          
    100          
79 8 100       20 if ($k eq 'R') {
    50          
80 2         6 $k .= Storable::freeze($_);
81             } elsif (defined $_) {
82 6 100       12 $k .= $ic ? lc($_) : $_;
83 6 100       21 $k =~ s/\s+//g if $ib;
84             }
85              
86 8 50       109 $res{$k} = [1,$_] unless exists $res{$k};
87             }
88             } else {
89 3         5 for (@$set) {
90              
91             # determine key (this code is copy-pasted)
92 7 50       37 my $k = $ar ? (ref $_ ? "R" : defined($_) ? "S":"U") : ""; # R=ref/undef, D=defined scalar, U=undef
    100          
    100          
93 7 100       16 if ($k eq 'R') {
    50          
94 1         4 $k .= Storable::freeze($_);
95             } elsif (defined $_) {
96 6 100       10 $k .= $ic ? lc($_) : $_;
97 6 100       14 $k =~ s/\s+//g if $ib;
98             }
99              
100 7 100 66     67 if ($res{$k} && $res{$k}[0] == $i-1) {
101 4         62 $res{$k}[0]++;
102             }
103             }
104             }
105             # return result
106 6 100       82 if ($i == @_) {
107 4         29 return [map {$res{$_}[1]}
108 3         8 grep {$res{$_}[0] == $i} keys %res];
  8         102  
109             }
110             } else {
111 0 0       0 if ($i == 1) {
112 0         0 for (@$set) { $res{$_} = 1 }
  0         0  
113             } else {
114 0         0 for (@$set) {
115 0 0 0     0 if ($res{$_} && $res{$_} == $i-1) {
116 0         0 $res{$_}++;
117             }
118             }
119             }
120             # return result
121 0 0       0 if ($i == @_) {
122 0         0 return [grep {$res{$_} == $i} keys %res];
  0         0  
123             }
124             }
125              
126             } elsif ($op eq 'diff') {
127              
128 6 50       9 if ($ign) {
129 6 100       12 if ($i == 1) {
130 3         7 for (@$set) {
131              
132             # determine key (this code is copy-pasted)
133 8 50       144 my $k = $ar ? (ref $_ ? "R" : defined($_) ? "S":"U") : ""; # R=ref/undef, D=defined scalar, U=undef
    100          
    100          
134 8 100       21 if ($k eq 'R') {
    50          
135 2         8 $k .= Storable::freeze($_);
136             } elsif (defined $_) {
137 6 100       13 $k .= $ic ? lc($_) : $_;
138 6 100       23 $k =~ s/\s+//g if $ib;
139             }
140              
141 8 50       140 $res{$k} = $_ unless exists $res{$k};
142             }
143             } else {
144 3         7 for (@$set) {
145              
146             # determine key (this code is copy-pasted)
147 7 50       93 my $k = $ar ? (ref $_ ? "R" : defined($_) ? "S":"U") : ""; # R=ref/undef, D=defined scalar, U=undef
    100          
    100          
148 7 100       15 if ($k eq 'R') {
    50          
149 1         4 $k .= Storable::freeze($_);
150             } elsif (defined $_) {
151 6 100       12 $k .= $ic ? lc($_) : $_;
152 6 100       18 $k =~ s/\s+//g if $ib;
153             }
154              
155 7         47 delete $res{$k};
156             }
157             }
158             # return result
159 6 100       98 if ($i == @_) {
160 3         10 return [values %res];
161             }
162             } else {
163 0 0       0 if ($i == 1) {
164 0         0 for (@$set) { $res{$_}++ }
  0         0  
165             } else {
166 0         0 for (@$set) {
167 0         0 delete $res{$_};
168             }
169             }
170             # return result
171 0 0       0 if ($i == @_) {
172 0         0 return [keys %res];
173             }
174             }
175              
176             } elsif ($op eq 'symdiff') {
177              
178 6 50       13 if ($ign) {
179 6 100       12 if ($i == 1) {
180 3         7 for (@$set) {
181              
182             # determine key (this code is copy-pasted)
183 8 50       117 my $k = $ar ? (ref $_ ? "R" : defined($_) ? "S":"U") : ""; # R=ref/undef, D=defined scalar, U=undef
    100          
    100          
184 8 100       21 if ($k eq 'R') {
    50          
185 2         5 $k .= Storable::freeze($_);
186             } elsif (defined $_) {
187 6 100       11 $k .= $ic ? lc($_) : $_;
188 6 100       20 $k =~ s/\s+//g if $ib;
189             }
190              
191 8 50       122 $res{$k} = [1,$_] unless exists $res{$k};
192             }
193             } else {
194 3         6 for (@$set) {
195              
196             # determine key (this code is copy-pasted)
197 7 50       47 my $k = $ar ? (ref $_ ? "R" : defined($_) ? "S":"U") : ""; # R=ref/undef, D=defined scalar, U=undef
    100          
    100          
198 7 100       17 if ($k eq 'R') {
    50          
199 1         3 $k .= Storable::freeze($_);
200             } elsif (defined $_) {
201 6 100       12 $k .= $ic ? lc($_) : $_;
202 6 100       14 $k =~ s/\s+//g if $ib;
203             }
204              
205 7 100       64 if (!$res{$k}) {
    50          
206 3         21 $res{$k} = [1, $_];
207             } elsif ($res{$k}[0] <= 2) {
208 4         57 $res{$k}[0]++;
209             }
210             }
211             }
212             # return result
213 6 100       99 if ($i == @_) {
214 7         49 return [map {$res{$_}[1]}
215 3         9 grep {$res{$_}[0] == 1} keys %res];
  11         127  
216             }
217             } else {
218 0 0       0 if ($i == 1) {
219 0         0 for (@$set) { $res{$_} = 1 }
  0         0  
220             } else {
221 0         0 for (@$set) {
222 0 0 0     0 if (!$res{$_} || $res{$_} <= 2) {
223 0         0 $res{$_}++;
224             }
225             }
226             }
227             # return result
228 0 0       0 if ($i == @_) {
229 0         0 return [grep {$res{$_} == 1} keys %res];
  0         0  
230             }
231             }
232              
233             }
234              
235             } # for set
236              
237             # caller does not specify any sets
238 0         0 return [];
239             }
240              
241             sub set_diff {
242 6 100   6 1 2403 my $opts = ref($_[0]) eq 'HASH' ? shift : {};
243 6 100 100     33 if ($opts->{ignore_case} || $opts->{ignore_blanks} || $opts->{allow_refs}) {
      66        
244 3         9 _doit('diff', $opts, @_);
245             } else {
246             # fast version, without ib/ic/ar
247 3         5 my $set1 = shift;
248 3         6 my $res = $set1;
249 3         8 while (@_) {
250 3         5 my %set2 = map { $_=>1 } @{ shift @_ };
  11         24  
  3         6  
251 3         7 $res = [];
252 3         6 for my $el (@$set1) {
253 10 100       23 push @$res, $el unless $set2{$el};
254             }
255 3         10 $set1 = $res;
256             }
257 3         15 $res;
258             }
259             }
260              
261             sub set_symdiff {
262 6 100   6 1 4330 my $opts = ref($_[0]) eq 'HASH' ? shift : {};
263 6 100 100     36 if ($opts->{ignore_case} || $opts->{ignore_blanks} || $opts->{allow_refs}) {
      66        
264 3         8 _doit('symdiff', $opts, @_);
265             } else {
266             # fast version, without ib/ic/ar
267 3         5 my $set1 = shift;
268 3         5 my $res = $set1;
269 3         5 my %set1;
270             my %set2;
271 3         9 while (@_) {
272 3         5 my $set2 = shift;
273 3         14 $set2{$_} = 1 for @$set2;
274 3         5 $res = [];
275 3         7 for my $el (@$set1) {
276 10 100       24 push @$res, $el unless $set2{$el};
277             }
278 3         10 $set1{$_} = 1 for @$set1;
279 3         5 for my $el (@$set2) {
280 12 100       24 push @$res, $el unless $set1{$el};
281             }
282 3         7 $set1 = $res;
283             }
284 3         16 $res;
285             }
286             }
287              
288             sub set_union {
289 6 100   6 1 3941 my $opts = ref($_[0]) eq 'HASH' ? shift : {};
290 6 100 100     34 if ($opts->{ignore_case} || $opts->{ignore_blanks} || $opts->{allow_refs}) {
      66        
291 3         8 _doit('union', $opts, @_);
292             } else {
293             # fast version, without ib/ic/ar
294 3         5 my %mem;
295 3         5 my $res = [];
296 3         8 while (@_) {
297 6         8 for my $el (@{ shift @_ }) {
  6         12  
298 21 100       56 push @$res, $el unless $mem{$el}++;
299             }
300             }
301 3         16 $res;
302             }
303             }
304              
305             sub set_intersect {
306 6 100   6 1 3979 my $opts = ref($_[0]) eq 'HASH' ? shift : {};
307 6 100 100     35 if ($opts->{ignore_case} || $opts->{ignore_blanks} || $opts->{allow_refs}) {
      66        
308 3         8 _doit('intersect', $opts, @_);
309             } else {
310             # fast version, without ib/ic/ar
311 3         7 my $set1 = shift;
312 3         4 my $res = $set1;
313 3         9 while (@_) {
314 3         5 my %set2 = map { $_=>1 } @{ shift @_ };
  12         25  
  3         7  
315 3         7 $res = [];
316 3         8 for my $el (@$set1) {
317 11 100       27 push @$res, $el if $set2{$el};
318             }
319 3         7 $set1 = $res;
320             }
321 3         14 $res;
322             }
323             }
324              
325             1;
326             # ABSTRACT: Perform set operations on arrays
327              
328             __END__