lib/Reaction/UI/ViewPort/Field/Mutable/ChooseOne.pm

   1 package Reaction::UI::ViewPort::Field::Mutable::ChooseOne;
   2
   3 use Reaction::Class;
   4 use Scalar::Util ();
   5
   6 class ChooseOne is 'Reaction::UI::ViewPort::Field', which {
   7
   8   does 'Reaction::UI::ViewPort::Field::Role::Mutable';
   9   does 'Reaction::UI::ViewPort::Field::Role::Choices';
  10
  11   around value => sub {
  12     my $orig = shift;
  13     my $self = shift;
  14     return $orig->($self) unless @_;
  15     my $value = shift;
  16     if (defined $value) {
  17       $value = $self->str_to_ident($value) if (!ref $value);
  18       my $attribute = $self->attribute;
  19       my $checked = $attribute->check_valid_value($self->model, $value);
  20       unless (defined $checked) {
  21         require Data::Dumper;
  22         my $serialised = Data::Dumper->new([ $value ])->Indent(0)->Dump;
  23         $serialised =~ s/^\$VAR1 = //; $serialised =~ s/;$//;
  24         confess "${serialised} is not a valid value for ${\$attribute->name} on "
  25                 ."${\$attribute->associated_class->name}";
  26       }
  27       $value = $checked;
  28     }
  29     $orig->($self, $value);
  30   };
  31
  32   around _value_string_from_value => sub {
  33     my $orig = shift;
  34     my $self = shift;
  35     my $value = $self->$orig(@_);
  36     return $self->obj_to_name($value->{value}) if Scalar::Util::blessed($value);
  37     return $self->obj_to_name($value) if blessed $value;
  38     return "$value"; # force stringify. might work. probably won't.
  39   };
  40
  41   implements is_current_value => as {
  42     my ($self, $check_value) = @_;
  43     return unless $self->_model_has_value;
  44     my $our_value = $self->value;
  45     return unless ref($our_value);
  46     $check_value = $self->obj_to_str($check_value) if ref($check_value);
  47     return $self->obj_to_str($our_value) eq $check_value;
  48   };
  49
  50
  51 };
  52
  53 1;