File Coverage

blib/lib/Set/Tiny.pm

Criterion	Covered	Total	%
statement	72	72	100.0
branch	17	18	94.4
condition	5	5	100.0
subroutine	28	28	100.0
pod	25	25	100.0
total	147	148	99.3

package Set::Tiny;
use strict;
use warnings;

our $VERSION = '0.06';

use Exporter 'import';
our @EXPORT_OK = qw(set);

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

sub set { ## no critic (NamingConventions::ProhibitAmbiguousNames)
    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 !!0 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__