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

   1 package Reaction::UI::ViewPort::Field::Role::Mutable;
   2
   3 use Reaction::Role;
   4
   5 use aliased 'Reaction::InterfaceModel::Action';
   6 use aliased 'Reaction::Meta::InterfaceModel::Action::ParameterAttribute';
   7
   8 role Mutable, which {
   9   has model     => (is => 'ro', isa => Action, required => 1);
  10   has attribute => (is => 'ro', isa => ParameterAttribute, required => 1);
  11
  12   has value      => (
  13     is => 'rw', lazy_build => 1, trigger_adopt('value'),
  14     clearer => 'clear_value',
  15   );
  16   has needs_sync => (is => 'rw', isa => 'Int', default => 0);
  17   has message    => (is => 'rw', isa => 'Str');
  18
  19   around value => sub {
  20     my $orig = shift;
  21     my $self = shift;
  22     if (@_ && !ref($_[0]) && defined($_[0]) && !length($_[0])) { # ''
  23       unless ($self->value_is_required) {
  24         return $self->clear_value;
  25       }
  26     }
  27     $self->$orig(@_);
  28   };
  29
  30   after clear_value => sub {
  31     shift->needs_sync(1);
  32   };
  33
  34   implements adopt_value => as {
  35     my ($self) = @_;
  36     $self->needs_sync(1); # if $self->has_attribute;
  37   };
  38
  39   implements sync_to_action => as {
  40     my ($self) = @_;
  41     return unless $self->needs_sync && $self->has_value;
  42     my $attr = $self->attribute;
  43
  44     if ($self->has_value) {
  45       my $value = $self->value;
  46       if (my $tc = $attr->type_constraint) {
  47         $value = $tc->coercion->coerce($value) if ($tc->has_coercion);
  48         #my $error = $tc->validate($self->value); # should we be checking against $value?
  49         my $error = $tc->validate($value);
  50         if (defined $error) {
  51           $self->message($error);
  52           return;
  53         }
  54       }
  55       my $writer = $attr->get_write_method;
  56       confess "No writer for attribute" unless defined($writer);
  57       $self->model->$writer($value);
  58     } else {
  59       my $predicate = $attr->get_predicate;
  60       confess "No predicate for attribute" unless defined($predicate);
  61       if ($self->model->$predicate) {
  62         my $clearer = $attr->get_clearer;
  63         confess "${predicate} returned true but no clearer for attribute"
  64           unless defined($clearer);
  65         $self->model->$clearer;
  66       }
  67     }
  68     $self->needs_sync(0);
  69   };
  70
  71   implements sync_from_action => as {
  72     my ($self) = @_;
  73     return unless !$self->needs_sync; # && $self->has_attribute;
  74     $self->message($self->model->error_for($self->attribute) || '');
  75   };
  76
  77   around accept_events => sub { ('value', shift->(@_)) };
  78
  79 };
  80
  81 1;
  82
  83 =head1 NAME
  84
  85 Reaction::UI::ViewPort::Role::Actions
  86
  87 =head1 DESCRIPTION
  88
  89 A role to ease attaching actions to L<Reaction::InterfaceModel::Object>s
  90
  91 =head1 ATTRIBUTES
  92
  93 =head2 needs_sync
  94
  95 =head2 message
  96
  97 =head2 model
  98
  99 =head2 attribute
 100
 101 =head2 value
 102
 103 =head1 METHODS
 104
 105 =head2 accept_events
 106
 107 =head2 sync_from_action
 108
 109 =head2 sync_to_action
 110
 111 =head2 adopt_value
 112
 113 =head1 AUTHORS
 114
 115 See L<Reaction::Class> for authors.
 116
 117 =head1 LICENSE
 118
 119 See L<Reaction::Class> for the license.
 120
 121 =cut