File Coverage

blib/lib/List/Collection.pm
Criterion Covered Total %
statement 44 44 100.0
branch 4 6 66.6
condition 1 3 33.3
subroutine 8 8 100.0
pod 5 5 100.0
total 62 66 93.9


line stmt bran cond sub pod time code
1             package List::Collection;
2 3     3   5707 use Modern::Perl;
  3         12789  
  3         22  
3 3     3   482 use Exporter;
  3         6  
  3         2045  
4              
5             our $VERSION = '0.0.2'; # VERSION
6             # ABSTRACT: List::Collection
7              
8              
9             our @ISA = qw/Exporter/;
10             our @EXPORT = qw/intersect union subtract complement/;
11              
12              
13             sub new {
14 1     1 1 2445 my $class = shift;
15 1         4 return bless { @_ }, $class;
16             }
17              
18             sub _remove_obj {
19 7 50   7   17 return if @_ == 0;
20 7 50 33     35 shift if ($_[0] and ref $_[0] eq __PACKAGE__);
21 7         17 return @_;
22             }
23              
24              
25             sub intersect {
26 2     2 1 17 my @lists = _remove_obj(@_);
27 2         3 my $list_count = @lists;
28 2         3 my (%elements, @out);
29 2         4 for my $list (@lists) {
30 4         40 $elements{$_}++ for (@$list);
31             }
32 2         17 for my $key (sort keys %elements) {
33 30 100       65 push (@out, $key) if $elements{$key} == $list_count;
34             }
35 2         9 @out = sort { $a <=> $b } @out;
  22         28  
36 2         12 return @out;
37             }
38              
39              
40             sub union {
41 2     2 1 9 my @lists = _remove_obj(@_);
42 2         4 my (%elements, @out);
43 2         4 for my $list (@lists) {
44 4         32 $elements{$_} = 1 for (@$list);
45             }
46 2         9 @out = sort { $a <=> $b } keys %elements;
  82         92  
47 2         16 return @out;
48             }
49              
50              
51             sub subtract {
52 2     2 1 8 my @lists = _remove_obj(@_);
53 2         3 my %elements;
54 2         3 $elements{$_} = 1 for (@{$lists[0]});
  2         18  
55 2         3 delete $elements{$_} for (@{$lists[1]});
  2         11  
56 2         13 my @out = sort { $a <=> $b } keys %elements;
  24         32  
57 2         11 return @out;
58             }
59              
60              
61             sub complement {
62 1     1 1 7 my @lists = _remove_obj(@_);
63 1         3 my @union = union(@lists);
64 1         4 my @intersect = intersect(@lists);
65 1         3 my @out = subtract(\@union, \@intersect);
66 1         3 @out = sort { $a <=> $b } @out;
  18         20  
67 1         6 return @out;
68             }
69              
70             1;
71              
72             __END__