File Coverage

blib/lib/Set/Tiny.pm

Criterion	Covered	Total	%
statement	68	68	100.0
branch	17	18	94.4
condition	5	5	100.0
subroutine	27	27	100.0
pod	25	25	100.0
total	142	143	99.3

package Set::Tiny;

use 5.004;
use strict;

require Exporter;
@Set::Tiny::ISA = qw(Exporter);
@Set::Tiny::EXPORT_OK = qw(set);

$Set::Tiny::VERSION = '0.04';

sub new {
    my $class = shift;
    my %self;
    @self{@_} = ();
    return bless \%self, $class;
}

sub set {
    if (ref($_[0]) eq "Set::Tiny") {
        return $_[0]->clone();
    }
    elsif (ref($_[0]) eq 'ARRAY') {
        return Set::Tiny->new(@{$_[0]});
    }
    else {
        return Set::Tiny->new(@_);
    }
}

sub as_string { "(" . join(" ", sort keys %{$_[0]}) . ")" }

sub size { scalar keys %{$_[0]} }

sub element { exists $_[0]->{$_[1]} ? $_[1] : () }

sub elements { keys %{$_[0]} }

sub contains {
    my $self = shift;
    exists $self->{$_} or return for @_;
    return 1;
}

sub clone {
    my $class = ref $_[0];
    return $class->new( keys %{$_[0]} );
}

sub clear {
    %{$_[0]} = ();
    return $_[0];
}

sub insert {
    my $self = shift;
    @{$self}{@_} = ();
    return $self;
}

sub remove {
    my $self = shift;
    delete @{$self}{@_};
    return $self;
}

sub invert {
    my $self = shift;
    exists $self->{$_} ? delete $self->{$_} : ($self->{$_} = undef) for @_;
    return $self;
}

sub is_null { ! %{$_[0]} }

sub is_subset { $_[1]->contains( keys %{$_[0]} ) }

sub is_proper_subset { $_[0]->size < $_[1]->size && $_[0]->is_subset($_[1]) }

sub is_superset { $_[1]->is_subset($_[0]) }

sub is_proper_superset { $_[0]->size > $_[1]->size && $_[1]->is_subset($_[0]) }

sub is_equal { $_[1]->is_subset($_[0]) && $_[0]->is_subset($_[1]) }

sub is_disjoint { ! $_[0]->intersection($_[1])->size }

sub is_properly_intersecting {
    ! $_[0]->is_disjoint($_[1])
      && $_[0]->difference($_[1])->size
      && $_[1]->difference($_[0])->size
}

sub difference { $_[0]->clone->remove(keys %{$_[1]}) }

sub union {
    my $class = ref $_[0];
    return $class->new( keys %{$_[0]}, keys %{$_[1]} );
}

sub intersection {
    my $class = ref $_[0];
    return $class->new( grep { exists($_[0]->{$_}) } keys %{$_[1]} );
}

sub intersection2 {
    my $class = ref $_[0];
    my ($a, $b) = $_[0]->size > $_[1]->size ? ($_[0], $_[1]) : ($_[1], $_[0]);
    return $class->new( grep { exists($a->{$_}) } keys %{$b} );
}

sub symmetric_difference { $_[0]->clone->invert(keys %{$_[1]}) }

{
    *copy = \&clone;
    *has = \&contains;
    *member = \&element;
    *members = \&elements;
    *delete = \&remove;
    *is_empty = \&is_null;
    *unique = \&symmetric_difference;
}

1;

__END__