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   after clear_value => sub {
  20     shift->needs_sync(1);
  21   };
  22
  23   implements adopt_value => as {
  24     my ($self) = @_;
  25     $self->needs_sync(1); # if $self->has_attribute;
  26   };
  27
  28   implements sync_to_action => as {
  29     my ($self) = @_;
  30     return unless $self->needs_sync;
  31     my $attr = $self->attribute;
  32
  33     if ($self->has_value) {
  34       my $value = $self->value;
  35       if (my $tc = $attr->type_constraint) {
  36         $value = $tc->coercion->coerce($value) if ($tc->has_coercion);
  37         #my $error = $tc->validate($self->value); # should we be checking against $value?
  38         my $error = $tc->validate($value);
  39         if (defined $error) {
  40           $self->message($error);
  41           return;
  42         }
  43       }
  44       my $writer = $attr->get_write_method;
  45       confess "No writer for attribute" unless defined($writer);
  46       $self->model->$writer($value);
  47     } else {
  48       my $predicate = $attr->predicate;
  49       confess "No predicate for attribute" unless defined($predicate);
  50       if ($self->model->$predicate) {
  51         my $clearer = $attr->clearer;
  52         confess "${predicate} returned true but no clearer for attribute"
  53           unless defined($clearer);
  54         $self->model->$clearer;
  55       }
  56     }
  57     $self->needs_sync(0);
  58   };
  59
  60   implements sync_from_action => as {
  61     my ($self) = @_;
  62     return unless !$self->needs_sync; # && $self->has_attribute;
  63     $self->message($self->model->error_for($self->attribute) || '');
  64   };
  65
  66   around accept_events => sub { ('value', shift->(@_)) };
  67
  68 };
  69
  70 1;
  71
  72 =head1 NAME
  73
  74 Reaction::UI::ViewPort::Role::Actions
  75
  76 =head1 DESCRIPTION
  77
  78 A role to ease attaching actions to L<Reaction::InterfaceModel::Object>s
  79
  80 =head1 ATTRIBUTES
  81
  82 =head2 needs_sync
  83
  84 =head2 message
  85
  86 =head2 model
  87
  88 =head2 attribute
  89
  90 =head2 value
  91
  92 =head1 METHODS
  93
  94 =head2 accept_events
  95
  96 =head2 sync_from_action
  97
  98 =head2 sync_to_action
  99
 100 =head2 adopt_value
 101
 102 =head1 AUTHORS
 103
 104 See L<Reaction::Class> for authors.
 105
 106 =head1 LICENSE
 107
 108 See L<Reaction::Class> for the license.
 109
 110 =cut