The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
package Form::Toolkit::Field::Set;
use Moose;

extends qw/Form::Toolkit::Field/;

=head1 NAME

Form::Toolkit::Field::Set - A Set of Pure scalar Value's (Not references).

=head1 NOTES

The 'value' field of this is in fact a set of values.

=cut

has '+value' => ( isa => 'ArrayRef[Value]' , trigger => \&_value_set );

has '_values_idx' => ( isa => 'HashRef[Value]' , is => 'rw' , required => 1 , default => sub{ {}; } );

__PACKAGE__->meta->short_class('Set');
__PACKAGE__->meta->make_immutable();

=head2 value_clone

Returns a shallow clone of the set of contained values (or undef)

=cut

sub value_clone{
  my ($self) = @_;
  unless( $self->value() ){ return ; }
  return [ @{$self->value()} ];
}

=head2 has_value

Tests if this field is currently holding the given value.

Usage:

 if( $this->has_value($whatever_value) ){
    ...
 }

=cut

sub has_value{
  my ($self, $v) = @_;
  return exists $self->_values_idx->{$v};
}


=head2 add_value

Adding value to this set. Will NOT add duplicates.
Return false on duplicate and true on success.

=cut

sub add_value{
  my ($self, $v) = @_;
  if( $self->has_value($v) ){ return; }
  ## Initialize if needed.
  $self->value() // $self->value([]);
  my $last_idx = scalar(@{$self->value()});
  push @{$self->value()} , $v;
  $self->_values_idx()->{$v} = $last_idx;
  return 1;
}

=head2 remove_value

Removes value from this set. Returns false on failure (it was not in this set)
and true on success.

=cut

sub remove_value{
  my ($self, $v) = @_;
  my $idx = $self->_values_idx()->{$v};
  unless( defined $idx ){ return; };

  # Splice the array for one element at idx
  splice( @{$self->value()} , $idx , 1);

  ## Delete index key for $v
  delete $self->_values_idx()->{$v};

  ## Update the index so all values from idx onward gets decremented.
  foreach my $value ( @{$self->value}[$idx..scalar(@{$self->value})-1] ){
    $self->_values_idx()->{$value} -= 1;
  }
  return 1;
}

sub _value_set{
  my ($self , $value, $old_value ) = @_;
  $self->_values_idx({});
  my $v_index = 0;
  foreach my $v ( @$value ){
    $self->_values_idx()->{$v} = $v_index++;
  }
}

=head2 value_struct

See superclass.

=cut

sub value_struct{
  my ($self) = @_;
  unless( $self->value() ){
    return undef;
  }
  return $self->value();
}

=head2 clear

Overrides clear so it maintains the value index.

=cut

sub clear{
   my ($self) = @_;
   $self->next::method();
   $self->_values_idx({});
};

1;