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