File Coverage

blib/lib/List/Collection.pm
Criterion Covered Total %
statement 8 44 18.1
branch 0 6 0.0
condition 0 3 0.0
subroutine 3 8 37.5
pod 5 5 100.0
total 16 66 24.2


line stmt bran cond sub pod time code
1             package List::Collection;
2 2     2   4942 use Modern::Perl;
  2         5  
  2         15  
3 2     2   289 use Exporter;
  2         3  
  2         1432  
4              
5             our $VERSION = '0.0.3'; # 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 3604 my $class = shift;
15 1         3 return bless { @_ }, $class;
16             }
17              
18             sub _remove_obj {
19 0 0   0     return if @_ == 0;
20 0 0 0       shift if ($_[0] and ref $_[0] eq __PACKAGE__);
21 0           return @_;
22             }
23              
24              
25             sub intersect {
26 0     0 1   my @lists = _remove_obj(@_);
27 0           my $list_count = @lists;
28 0           my (%elements, @out);
29 0           for my $list (@lists) {
30 0           $elements{$_}++ for (@$list);
31             }
32 0           for my $key (sort keys %elements) {
33 0 0         push (@out, $key) if $elements{$key} == $list_count;
34             }
35 0           @out = sort { $a <=> $b } @out;
  0            
36 0           return @out;
37             }
38              
39              
40             sub union {
41 0     0 1   my @lists = _remove_obj(@_);
42 0           my (%elements, @out);
43 0           for my $list (@lists) {
44 0           $elements{$_} = 1 for (@$list);
45             }
46 0           @out = sort { $a <=> $b } keys %elements;
  0            
47 0           return @out;
48             }
49              
50              
51             sub subtract {
52 0     0 1   my @lists = _remove_obj(@_);
53 0           my %elements;
54 0           $elements{$_} = 1 for (@{$lists[0]});
  0            
55 0           delete $elements{$_} for (@{$lists[1]});
  0            
56 0           my @out = sort { $a <=> $b } keys %elements;
  0            
57 0           return @out;
58             }
59              
60              
61             sub complement {
62 0     0 1   my @lists = _remove_obj(@_);
63 0           my @union = union(@lists);
64 0           my @intersect = intersect(@lists);
65 0           my @out = subtract(\@union, \@intersect);
66 0           @out = sort { $a <=> $b } @out;
  0            
67 0           return @out;
68             }
69              
70             1;
71              
72             __END__