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