File Coverage

Set/Hash.pm

Criterion	Covered	Total	%
statement	120	144	83.3
branch	53	80	66.2
condition	19	32	59.3
subroutine	23	25	92.0
pod	7	8	87.5
total	222	289	76.8

package Set::Hash;
use strict;
use attributes qw(reftype);
use Want;
use Carp;
use Set::Array;

use subs qw(delete exists keys length print reverse shift values);

use overload
   "==" => "is_equal",
   "!=" => "not_equal",
   "-"  => "difference",
   "*"  => "intersection",
   "+"  => "push",
   "%"  => "symmetric_difference",
   "fallback" => 1;

BEGIN{
   use vars qw(@ISA $VERSION);
   @ISA=qw(Set::Array);
   $VERSION = '0.01';
}

sub new{
   my($class,%hash) = @_;
   %hash = @$class if !%hash && ref($class);
   return bless \%hash, ref($class) || $class;
}

sub clear{
   my $self = CORE::shift;
   %$self = ();
   if(want("OBJECT") || !defined(wantarray)){
      return $self;
   }

   return () if wantarray;
   return {};
}

sub delete{
   my($self,@args) = @_;

   my @deleted = CORE::delete(@{$self}{@args});

   if( want("OBJECT") || !defined(wantarray) )
   {
      return $self;
   }

   return @deleted if wantarray;
   return \@deleted;
}

sub difference{
   my($op1,$op2,$reversed) = @_;
   ($op2,$op1) = ($op1,$op2) if $reversed;

   my %diff;
   while(my($key,$val) = CORE::each(%$op1))
   {
      unless(CORE::exists($op2->{$key}))
      {
         $diff{$key} = $val;
         next;
      }

      $diff{$key} = $val unless $op1->{$key} == $op2->{$key};
   }

   if(want("OBJECT") || !defined(wantarray))
   {
      %$op1 = %diff;
      return $op1;
   }
   return %diff if wantarray;
   return \%diff;
}

sub exists{
   my($self,@keys) = @_;
   CORE::foreach my $key(@keys)
   {
      return 0 unless CORE::exists($self->{$key});
   }
   return 1;
}

sub intersection{
   my($op1,$op2,$reversed) = @_;
   ($op2,$op1) = ($op1,$op2) if $reversed;

   my %inter;
   while(my($key,$val) = CORE::each(%$op1))
   {
      next unless CORE::exists($op2->{$key});
      if($op1->{$key} == $op2->{$key})
      {
         $inter{$key} = $val;
      }
   }

   if(want("OBJECT") || !defined(wantarray))
   {
      %$op1 = %inter;
      return $op1;
   }
   return %inter if wantarray;
   return \%inter;
}

sub is_equal{
   my($op1,$op2,$reversed) = @_;
   ($op2,$op1) = ($op1,$op2) if $reversed;

   # Automatic failure if they're not the same length
   return 0 unless scalar(CORE::keys(%$op1)) == scalar(CORE::keys(%$op2));

   while(my($key,$val) = CORE::each(%$op1))
   {
      return 0 unless $op1->{$key} == $op2->{$key};
   }
   return 1;
}

sub keys{
   my $self = CORE::shift;
   my @keys = CORE::keys(%$self);
   if(want("OBJECT") || !defined(wantarray)){
      return bless(\@keys);
   }

   return @keys if wantarray;
   return \@keys;
}

sub length{
   my $self = CORE::shift;
   my $length;

   if(reftype($self) eq "HASH"){
      $length = scalar(CORE::keys(%$self));
   }
   else{
      $length = $self->SUPER::length;
   }

   if(want("OBJECT") || !defined(wantarray)){
      return bless(\$length);
   }
   return $length;
}

sub not_equal{
   my($op1,$op2,$reversed) = @_;
   ($op2,$op1) = ($op1,$op2) if $reversed;

   # Automatically true if they're not the same length
   return 1 unless scalar(CORE::keys(%$op1)) == scalar(CORE::keys(%$op2));

   while(my($key,$val) = CORE::each(%$op1))
   {
      return 1 unless $op1->{$key} == $op2->{$key};
   }
   return 0;
}

sub print{
   my($self,$char) = @_;
   $char = "\n" if $char >= 1;

   if(reftype($self) eq "HASH"){ CORE::print(%$self) }
   if(reftype($self) eq "ARRAY"){ CORE::print(@$self) }
   if(reftype($self) eq "SCALAR"){ CORE::print($$self) }
   CORE::print($char) if $char;

   return $self;
}

sub push{
   my($self,@args) = @_;

   if(ref($args[0]) eq "Set::Hash")
   {
      my %merged;
      while(my($key,$val) = CORE::each(%$self))
      {
         $merged{$key} = $val;
      }

      while(my($key,$val) = CORE::each(%{$args[0]}))
      {
         $merged{$key} = $val;
      }
      return bless \%merged;
   }

   while(@args)
   {
      my $key = CORE::shift(@args);
      my $val = CORE::shift(@args) || undef;
      $self->{$key} = $val;
   }

   return $self;
}
*unshift = \&push;
*union = \&push;

sub reverse{
   my($self) = @_;

   if( (want('OBJECT')) || (!defined wantarray) ){
      %$self = CORE::reverse %$self;
      return $self;
   }

   my %temp = CORE::reverse %$self;
   if(wantarray){ return %temp }
   if(defined wantarray){ return \%temp }
}

sub shift{
   my $self = CORE::shift;

   my($key,$val) = CORE::each(%$self);
   CORE::delete($self->{$key});

   return ($key,$val) if wantarray;
   return {$key,$val} if defined wantarray;
   return $self;
}
*pop = \&shift;

sub symmetric_difference{
   my($op1,$op2,$reversed) = @_;
   ($op2,$op1) = ($op1,$op2) if $reversed;


}

sub values{
   my $self = CORE::shift;
   my @vals = CORE::values(%$self);
   if(want("OBJECT") || !defined(wantarray)){
      return bless(\@vals);
   }

   return @vals if wantarray;
   return \@vals;
}
1;
__END__