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
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
|
package Reaction::UI::ViewPort::Field::Role::Mutable;
use MooseX::Role::Parameterized;
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) ];
=pod
15:24 mst:» I'm not sure I understand why the +foo is overwriting my after'ed clear_value
15:24 mst:» but I would argue it shouldn't do that
15:25 @doy:» because has '+foo' is creating an entirely new attribute
15:25 @doy:» and just copying the meta-attribute's attributes into it
15:25 @doy:» so it's creating a new clearer sub in the subclass
15:27 rafl:» mst: for that case, i tend to just parameterize the role on whatever i might want to override in its attribute definitions
=cut
parameter value_type => (
predicate => 'has_value_type'
);
role {
my $p = shift;
has model => (is => 'ro', isa => Action, required => 1);
has attribute => (is => 'ro', isa => ParameterAttribute, required => 1);
has value => (
is => 'rw', lazy_build => 1, trigger => sub { shift->adopt_value },
$p->has_value_type? (isa => $p->value_type) : ()
);
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
|
