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