File Coverage

blib/lib/Set/Tiny.pm
Criterion Covered Total %
statement 60 60 100.0
branch 14 14 100.0
condition 5 5 100.0
subroutine 26 26 100.0
pod 24 24 100.0
total 129 129 100.0


line stmt bran cond sub pod time code
1             package Set::Tiny;
2              
3 2     2   1190 use 5.004;
  2         6  
  2         87  
4 2     2   11 use strict;
  2         3  
  2         1377  
5              
6             require Exporter;
7             @Set::Tiny::ISA = qw(Exporter);
8             @Set::Tiny::EXPORT_OK = qw(set);
9              
10             $Set::Tiny::VERSION = '0.02';
11              
12             sub new {
13 40     40 1 768 my $class = shift;
14 40         41 my %self;
15 40         87 @self{@_} = ();
16 40         132 return bless \%self, $class;
17             }
18              
19             sub set {
20 3 100   3 1 704 if ( ref( $_[ 0 ] ) ne '' ) {
21 1         1 return Set::Tiny->new( @{ $_[ 0 ] } );
  1         4  
22             }
23             else {
24 2         4 return Set::Tiny->new(@_);
25             }
26             }
27              
28 93     93 1 1761 sub as_string { "(" . join(" ", sort keys %{$_[0]}) . ")" }
  93         980  
29              
30 28     28 1 550 sub size { scalar keys %{$_[0]} }
  28         265  
31              
32 3 100   3 1 536 sub element { exists $_[0]->{$_[1]} ? $_[1] : () }
33              
34 3     3 1 4 sub elements { keys %{$_[0]} }
  3         22  
35              
36             sub contains {
37 19     19 1 707 my $self = shift;
38 19   100     92 exists $self->{$_} or return for @_;
39 15         84 return 1;
40             }
41              
42             sub clone {
43 33     33 1 50 my $class = ref $_[0];
44 33         33 return $class->new( keys %{$_[0]} );
  33         106  
45             }
46              
47             sub clear {
48 2     2 1 4 %{$_[0]} = ();
  2         8  
49 2         5 return $_[0];
50             }
51              
52             sub insert {
53 1     1 1 3 my $self = shift;
54 1         2 @{$self}{@_} = ();
  1         4  
55 1         3 return $self;
56             }
57              
58             sub remove {
59 23     23 1 27 my $self = shift;
60 23         24 delete @{$self}{@_};
  23         43  
61 23         75 return $self;
62             }
63              
64             sub invert {
65 3     3 1 6 my $self = shift;
66 3 100       27 exists $self->{$_} ? delete $self->{$_} : ($self->{$_} = undef) for @_;
67 3         9 return $self;
68             }
69              
70 3     3 1 1226 sub is_null { ! %{$_[0]} }
  3         16  
71              
72 15     15 1 29 sub is_subset { $_[1]->contains( keys %{$_[0]} ) }
  15         50  
73              
74 4 100   4 1 15 sub is_proper_subset { $_[0]->size < $_[1]->size && $_[0]->is_subset($_[1]) }
75              
76 4     4 1 854 sub is_superset { $_[1]->is_subset($_[0]) }
77              
78 4 100   4 1 15 sub is_proper_superset { $_[0]->size > $_[1]->size && $_[1]->is_subset($_[0]) }
79              
80 3 100   3 1 12 sub is_equal { $_[1]->is_subset($_[0]) && $_[0]->is_subset($_[1]) }
81              
82 7     7 1 1103 sub is_disjoint { ! $_[0]->intersection($_[1])->size }
83              
84             sub is_properly_intersecting {
85 4 100 100 4 1 505 ! $_[0]->is_disjoint($_[1])
86             && $_[0]->difference($_[1])->size
87             && $_[1]->difference($_[0])->size
88             }
89              
90 21     21 1 44 sub difference { $_[0]->clone->remove(keys %{$_[1]}) }
  21         60  
91              
92             sub union {
93 1     1 1 3 my $class = ref $_[0];
94 1         2 return $class->new( keys %{$_[0]}, keys %{$_[1]} );
  1         5  
  1         6  
95             }
96              
97 8     8 1 24 sub intersection { $_[0]->difference( $_[0]->clone->difference($_[1]) ) }
98              
99 2     2 1 13 sub symmetric_difference { $_[0]->clone->invert(keys %{$_[1]}) }
  2         10  
100              
101             {
102             *copy = \&clone;
103             *has = \&contains;
104             *member = \&element;
105             *members = \&elements;
106             *delete = \&remove;
107             *is_empty = \&is_null;
108             *unique = \&symmetric_difference;
109             }
110              
111             1;
112              
113             __END__