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
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
|
package Reaction::UI::ViewPort::Field::Role::Mutable;
use Reaction::Role;
use aliased 'Reaction::InterfaceModel::Action';
use aliased 'Reaction::Meta::InterfaceModel::Action::ParameterAttribute';
use MooseX::Types::Moose qw/Int Str/;
use namespace::clean -except => [ qw(meta) ];
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); #should be bool?
has message => (is => 'rw', isa => Str, clearer => 'clear_message');
has is_modified => ( #sould be bool?
is => 'ro', writer => '_set_modified',
required => 1, default => 1, init_arg => undef
);
after clear_value => sub {
my $self = shift;
$self->clear_message if $self->has_message;
$self->needs_sync(1);
};
sub adopt_value {
my ($self) = @_;
$self->clear_message if $self->has_message;
$self->needs_sync(1); # if $self->has_attribute;
}
sub can_sync_to_action {
my $self = shift;
# if field is already sync'ed, it can be sync'ed again
# this will make sync_to_action no-op if needs_sync is 0
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 {
if( $self->model->attribute_is_required($attr) ){
if(my $error = $self->model->error_for($self->attribute) ){
$self->message( $error );
}
return;
}
}
return 1;
};
sub sync_to_action {
my ($self) = @_;
# don't sync if we're already synced
return unless $self->needs_sync;
# if we got here, needs_sync is 1
# can_sync_to_action will do coercion checks, etc.
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);
};
sub sync_from_action {
my ($self) = @_;
return if $self->needs_sync;
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
|
