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   #predicates are autmagically generated for lazy and non-required attrs
  18   has message => (is => 'rw', isa => 'Str', clearer => 'clear_message');
  19
  20   after clear_value => sub {
  21     my $self = shift;
  22     $self->clear_message if $self->has_message;
  23     $self->needs_sync(1);
  24   };
  25
  26   implements adopt_value => as {
  27     my ($self) = @_;
  28     $self->clear_message if $self->has_message;
  29     $self->needs_sync(1); # if $self->has_attribute;
  30   };
  31
  32   implements can_sync_to_action => as {
  33     my $self = shift;
  34     return 1 unless $self->needs_sync;
  35     my $attr = $self->attribute;
  36
  37     if ($self->has_value) {
  38       my $value = $self->value;
  39       if (my $tc = $attr->type_constraint) {
  40         $value = $tc->coercion->coerce($value) if ($tc->has_coercion);
  41         if (defined (my $error = $tc->validate($value))) {
  42           $self->message($error);
  43           return;
  44         }
  45       }
  46     } else {
  47       return if $attr->is_required;
  48     }
  49     return 1;
  50   };
  51
  52   implements sync_to_action => as {
  53     my ($self) = @_;
  54     return unless $self->needs_sync;
  55     return unless $self->can_sync_to_action;
  56
  57     my $attr = $self->attribute;
  58
  59     if ($self->has_value) {
  60       my $value = $self->value;
  61       if (my $tc = $attr->type_constraint) {
  62         #this will go away when we have moose dbic. until then though...
  63         $value = $tc->coercion->coerce($value) if ($tc->has_coercion);
  64       }
  65       my $writer = $attr->get_write_method;
  66       confess "No writer for attribute" unless defined($writer);
  67       $self->model->$writer($value);
  68     } else {
  69       my $predicate = $attr->get_predicate_method;
  70       confess "No predicate for attribute" unless defined($predicate);
  71       if ($self->model->$predicate) {
  72         my $clearer = $attr->get_clearer_method;
  73         confess "${predicate} returned true but no clearer for attribute"
  74           unless defined($clearer);
  75         $self->model->$clearer;
  76       }
  77     }
  78     $self->needs_sync(0);
  79   };
  80
  81   implements sync_from_action => as {
  82     my ($self) = @_;
  83     return unless !$self->needs_sync; # && $self->has_attribute;
  84     if( !$self->has_message ){
  85       if(my $error = $self->model->error_for($self->attribute) ){
  86         $self->message( $error );
  87       }
  88     }
  89   };
  90
  91   around accept_events => sub { ('value', shift->(@_)) };
  92
  93 };
  94
  95 1;
  96
  97 =head1 NAME
  98
  99 Reaction::UI::ViewPort::Role::Actions
 100
 101 =head1 DESCRIPTION
 102
 103 A role to ease attaching actions to L<Reaction::InterfaceModel::Object>s
 104
 105 =head1 ATTRIBUTES
 106
 107 =head2 needs_sync
 108
 109 =head2 message
 110
 111 =head2 model
 112
 113 =head2 attribute
 114
 115 =head2 value
 116
 117 =head1 METHODS
 118
 119 =head2 accept_events
 120
 121 =head2 sync_from_action
 122
 123 =head2 sync_to_action
 124
 125 =head2 adopt_value
 126
 127 =head1 AUTHORS
 128
 129 See L<Reaction::Class> for authors.
 130
 131 =head1 LICENSE
 132
 133 See L<Reaction::Class> for the license.
 134
 135 =cut