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

   1 package Reaction::UI::ViewPort::Field::ChooseOne;
   2
   3 use Reaction::Class;
   4 use URI;
   5 use Scalar::Util 'blessed';
   6
   7 class ChooseOne is 'Reaction::UI::ViewPort::Field', which {
   8
   9   #has '+layout' => (default => 'select');
  10
  11   has valid_values  => (isa => 'ArrayRef', is => 'ro', lazy_build => 1);
  12   has value_choices => (isa => 'ArrayRef', is => 'ro', lazy_build => 1);
  13
  14   has value_map_method => (
  15     isa => 'Str', is => 'ro', required => 1, default => sub { 'display_name' },
  16   );
  17
  18   around value => sub {
  19     my $orig = shift;
  20     my $self = shift;
  21     if (@_) {
  22       my $value = shift;
  23       if (defined $value) {
  24         if (!ref $value) {
  25           $value = $self->str_to_ident($value);
  26         }
  27         my $checked = $self->attribute->check_valid_value($self->action, $value);
  28         confess "${value} is not a valid value" unless defined($checked);
  29         $value = $checked;
  30       }
  31       $orig->($self, $value);
  32     } else {
  33       $orig->($self);
  34     }
  35   };
  36
  37   implements _build_valid_values => as {
  38     my $self = shift;
  39     return [ $self->attribute->all_valid_values($self->action) ];
  40   };
  41
  42   implements _build_value_choices => sub{
  43     my $self  = shift;
  44     my @pairs = map{{value => $self->obj_to_str($_), name => $self->obj_to_name($_)}}
  45       @{ $self->valid_values };
  46     return [ sort { $a->{name} cmp $b->{name} } @pairs ];
  47   };
  48
  49   implements is_current_value => as {
  50     my ($self, $check_value) = @_;
  51     my $our_value = $self->value;
  52     return unless ref($our_value);
  53     $check_value = $self->obj_to_str($check_value) if ref($check_value);
  54     return $self->obj_to_str($our_value) eq $check_value;
  55   };
  56
  57   implements str_to_ident => as {
  58     my ($self, $str) = @_;
  59     my $u = URI->new('','http');
  60     $u->query($str);
  61     return { $u->query_form };
  62   };
  63
  64   implements obj_to_str => as {
  65     my ($self, $obj) = @_;
  66     return $obj unless ref($obj);
  67     confess "${obj} not an object" unless blessed($obj);
  68     my $ident = $obj->ident_condition;
  69     my $u = URI->new('', 'http');
  70     $u->query_form(%$ident);
  71     return $u->query;
  72   };
  73
  74   implements obj_to_name => as {
  75     my ($self, $obj) = @_;
  76     return $obj unless ref($obj);
  77     confess "${obj} not an object" unless blessed($obj);
  78     my $meth = $self->value_map_method;
  79     return $obj->$meth;
  80   };
  81
  82 };
  83
  84 1;
  85
  86 =head1 NAME
  87
  88 Reaction::UI::ViewPort::Field::ChooseOne
  89
  90 =head1 DESCRIPTION
  91
  92 =head1 METHODS
  93
  94 =head2 is_current_value
  95
  96 =head2 value
  97
  98 =head2 valid_values
  99
 100 =head2 valid_value_names
 101
 102 =head2 value_to_name_map
 103
 104 =head2 name_to_value_map
 105
 106 =head2 str_to_ident
 107
 108 =head2 obj_to_str
 109
 110 =head1 SEE ALSO
 111
 112 =head2 L<Reaction::UI::ViewPort::Field>
 113
 114 =head1 AUTHORS
 115
 116 See L<Reaction::Class> for authors.
 117
 118 =head1 LICENSE
 119
 120 See L<Reaction::Class> for the license.
 121
 122 =cut