line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Form::Factory::Control; |
2
|
|
|
|
|
|
|
$Form::Factory::Control::VERSION = '0.022'; |
3
|
1
|
|
|
1
|
|
8282
|
use Moose::Role; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
8
|
|
4
|
|
|
|
|
|
|
|
5
|
1
|
|
|
1
|
|
4410
|
use Form::Factory::Control::Choice; |
|
1
|
|
|
|
|
263
|
|
|
1
|
|
|
|
|
34
|
|
6
|
1
|
|
|
1
|
|
7
|
use List::Util qw( first ); |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
528
|
|
7
|
|
|
|
|
|
|
|
8
|
|
|
|
|
|
|
requires qw( default_isa ); |
9
|
|
|
|
|
|
|
|
10
|
|
|
|
|
|
|
# ABSTRACT: high-level API for working with form controls |
11
|
|
|
|
|
|
|
|
12
|
|
|
|
|
|
|
|
13
|
|
|
|
|
|
|
has action => ( |
14
|
|
|
|
|
|
|
is => 'ro', |
15
|
|
|
|
|
|
|
does => 'Form::Factory::Action', |
16
|
|
|
|
|
|
|
required => 1, |
17
|
|
|
|
|
|
|
weak_ref => 1, |
18
|
|
|
|
|
|
|
); |
19
|
|
|
|
|
|
|
|
20
|
|
|
|
|
|
|
|
21
|
|
|
|
|
|
|
has name => ( |
22
|
|
|
|
|
|
|
is => 'ro', |
23
|
|
|
|
|
|
|
isa => 'Str', |
24
|
|
|
|
|
|
|
required => 1, |
25
|
|
|
|
|
|
|
); |
26
|
|
|
|
|
|
|
|
27
|
|
|
|
|
|
|
|
28
|
|
|
|
|
|
|
has documentation => ( |
29
|
|
|
|
|
|
|
is => 'ro', |
30
|
|
|
|
|
|
|
isa => 'Str', |
31
|
|
|
|
|
|
|
predicate => 'has_documentation', |
32
|
|
|
|
|
|
|
); |
33
|
|
|
|
|
|
|
|
34
|
|
|
|
|
|
|
|
35
|
|
|
|
|
|
|
has features => ( |
36
|
|
|
|
|
|
|
is => 'ro', |
37
|
|
|
|
|
|
|
isa => 'ArrayRef', |
38
|
|
|
|
|
|
|
required => 1, |
39
|
|
|
|
|
|
|
default => sub { [] }, |
40
|
|
|
|
|
|
|
); |
41
|
|
|
|
|
|
|
|
42
|
|
|
|
|
|
|
|
43
|
|
|
|
|
|
|
has value => ( |
44
|
|
|
|
|
|
|
is => 'rw', |
45
|
|
|
|
|
|
|
predicate => 'has_value', |
46
|
|
|
|
|
|
|
); |
47
|
|
|
|
|
|
|
|
48
|
|
|
|
|
|
|
|
49
|
|
|
|
|
|
|
has default_value => ( |
50
|
|
|
|
|
|
|
is => 'rw', |
51
|
|
|
|
|
|
|
predicate => 'has_default_value', |
52
|
|
|
|
|
|
|
); |
53
|
|
|
|
|
|
|
|
54
|
|
|
|
|
|
|
|
55
|
|
|
|
|
|
|
has control_to_value => ( |
56
|
|
|
|
|
|
|
is => 'ro', |
57
|
|
|
|
|
|
|
isa => 'Str|CodeRef', |
58
|
|
|
|
|
|
|
predicate => 'has_control_to_value', |
59
|
|
|
|
|
|
|
); |
60
|
|
|
|
|
|
|
|
61
|
|
|
|
|
|
|
|
62
|
|
|
|
|
|
|
has value_to_control => ( |
63
|
|
|
|
|
|
|
is => 'ro', |
64
|
|
|
|
|
|
|
isa => 'Str|CodeRef', |
65
|
|
|
|
|
|
|
predicate => 'has_value_to_control', |
66
|
|
|
|
|
|
|
); |
67
|
|
|
|
|
|
|
|
68
|
|
|
|
|
|
|
|
69
|
|
|
|
|
|
|
sub current_value { |
70
|
363
|
|
|
363
|
1
|
507
|
my $self = shift; |
71
|
|
|
|
|
|
|
|
72
|
363
|
100
|
|
|
|
3734
|
$self->value(@_) if @_; |
73
|
|
|
|
|
|
|
|
74
|
363
|
100
|
|
|
|
12273
|
return $self->value if $self->has_value; |
75
|
158
|
100
|
|
|
|
5677
|
return $self->default_value if $self->has_default_value; |
76
|
2
|
|
|
|
|
78
|
return scalar undef; |
77
|
|
|
|
|
|
|
} |
78
|
|
|
|
|
|
|
|
79
|
|
|
|
|
|
|
|
80
|
|
|
|
|
|
|
sub has_current_value { |
81
|
0
|
|
|
0
|
1
|
0
|
my $self = shift; |
82
|
0
|
|
0
|
|
|
0
|
return $self->has_value || $self->has_default_value; |
83
|
|
|
|
|
|
|
} |
84
|
|
|
|
|
|
|
|
85
|
|
|
|
|
|
|
|
86
|
|
|
|
|
|
|
sub convert_value_to_control { |
87
|
8
|
|
|
8
|
1
|
11
|
my ($self, $value) = @_; |
88
|
|
|
|
|
|
|
|
89
|
8
|
|
|
|
|
12
|
for my $feature (@{ $self->features }) { |
|
8
|
|
|
|
|
278
|
|
90
|
11
|
100
|
|
|
|
174
|
next unless $feature->does('Form::Factory::Feature::Role::ControlValueConverter'); |
91
|
|
|
|
|
|
|
|
92
|
3
|
|
|
|
|
1283
|
$value = $feature->value_to_control($value); |
93
|
|
|
|
|
|
|
} |
94
|
|
|
|
|
|
|
|
95
|
8
|
100
|
|
|
|
672
|
if ($self->has_value_to_control) { |
96
|
3
|
|
|
|
|
100
|
my $converter = $self->value_to_control; |
97
|
3
|
50
|
|
|
|
9
|
if (ref $converter) { |
98
|
0
|
|
|
|
|
0
|
$value = $converter->($self->action, $self, $value); |
99
|
|
|
|
|
|
|
} |
100
|
|
|
|
|
|
|
else { |
101
|
3
|
|
|
|
|
98
|
$value = $self->action->$converter($self, $value); |
102
|
|
|
|
|
|
|
} |
103
|
|
|
|
|
|
|
} |
104
|
|
|
|
|
|
|
|
105
|
8
|
|
|
|
|
41
|
return $value; |
106
|
|
|
|
|
|
|
} |
107
|
|
|
|
|
|
|
|
108
|
|
|
|
|
|
|
|
109
|
|
|
|
|
|
|
sub convert_control_to_value { |
110
|
20
|
|
|
20
|
1
|
27
|
my ($self, $value) = @_; |
111
|
|
|
|
|
|
|
|
112
|
20
|
|
|
|
|
17
|
for my $feature (@{ $self->features }) { |
|
20
|
|
|
|
|
671
|
|
113
|
7
|
100
|
|
|
|
112
|
next unless $feature->does('Form::Factory::Feature::Role::ControlValueConverter'); |
114
|
|
|
|
|
|
|
|
115
|
1
|
|
|
|
|
290
|
$value = $feature->control_to_value($value); |
116
|
|
|
|
|
|
|
} |
117
|
|
|
|
|
|
|
|
118
|
20
|
100
|
|
|
|
848
|
if ($self->has_control_to_value) { |
119
|
1
|
|
|
|
|
30
|
my $converter = $self->control_to_value; |
120
|
1
|
50
|
|
|
|
3
|
if (ref $converter) { |
121
|
0
|
|
|
|
|
0
|
$value = $converter->($self->action, $self, $value); |
122
|
|
|
|
|
|
|
} |
123
|
|
|
|
|
|
|
else { |
124
|
1
|
|
|
|
|
31
|
$value = $self->action->$converter($self, $value); |
125
|
|
|
|
|
|
|
} |
126
|
|
|
|
|
|
|
} |
127
|
|
|
|
|
|
|
|
128
|
20
|
|
|
|
|
47
|
return $value; |
129
|
|
|
|
|
|
|
} |
130
|
|
|
|
|
|
|
|
131
|
|
|
|
|
|
|
|
132
|
|
|
|
|
|
|
sub set_attribute_value { |
133
|
21
|
|
|
21
|
1
|
32
|
my ($self, $action, $attribute) = @_; |
134
|
|
|
|
|
|
|
|
135
|
21
|
|
|
|
|
55
|
my $value = $self->current_value; |
136
|
21
|
100
|
|
|
|
50
|
if (defined $value) { |
137
|
20
|
|
|
|
|
61
|
$value = $self->convert_control_to_value($value); |
138
|
20
|
|
|
|
|
90
|
$attribute->set_value($action, $value); |
139
|
|
|
|
|
|
|
} |
140
|
|
|
|
|
|
|
else { |
141
|
1
|
|
|
|
|
11
|
$attribute->clear_value($action); |
142
|
|
|
|
|
|
|
} |
143
|
|
|
|
|
|
|
} |
144
|
|
|
|
|
|
|
|
145
|
|
|
|
|
|
|
|
146
|
|
|
|
|
|
|
sub get_feature_by_name { |
147
|
129
|
|
|
129
|
1
|
148
|
my ($self, $name) = @_; |
148
|
129
|
|
|
34
|
|
492
|
return first { $_->name eq $name } @{ $self->features }; |
|
34
|
|
|
|
|
1197
|
|
|
129
|
|
|
|
|
3803
|
|
149
|
|
|
|
|
|
|
} |
150
|
|
|
|
|
|
|
|
151
|
|
|
|
|
|
|
|
152
|
|
|
|
|
|
|
sub has_feature { |
153
|
129
|
|
|
129
|
1
|
181
|
my ($self, $name) = @_; |
154
|
129
|
100
|
|
|
|
272
|
return 1 if $self->get_feature_by_name($name); |
155
|
124
|
|
|
|
|
663
|
return ''; |
156
|
|
|
|
|
|
|
} |
157
|
|
|
|
|
|
|
|
158
|
|
|
|
|
|
|
1; |
159
|
|
|
|
|
|
|
|
160
|
|
|
|
|
|
|
__END__ |
161
|
|
|
|
|
|
|
|
162
|
|
|
|
|
|
|
=pod |
163
|
|
|
|
|
|
|
|
164
|
|
|
|
|
|
|
=encoding UTF-8 |
165
|
|
|
|
|
|
|
|
166
|
|
|
|
|
|
|
=head1 NAME |
167
|
|
|
|
|
|
|
|
168
|
|
|
|
|
|
|
Form::Factory::Control - high-level API for working with form controls |
169
|
|
|
|
|
|
|
|
170
|
|
|
|
|
|
|
=head1 VERSION |
171
|
|
|
|
|
|
|
|
172
|
|
|
|
|
|
|
version 0.022 |
173
|
|
|
|
|
|
|
|
174
|
|
|
|
|
|
|
=head1 SYNOPSIS |
175
|
|
|
|
|
|
|
|
176
|
|
|
|
|
|
|
package MyApp::Control::Slider; |
177
|
|
|
|
|
|
|
use Moose; |
178
|
|
|
|
|
|
|
|
179
|
|
|
|
|
|
|
with qw( |
180
|
|
|
|
|
|
|
Form::Feature::Control |
181
|
|
|
|
|
|
|
Form::Feature::Control::Role::ScalarValue |
182
|
|
|
|
|
|
|
); |
183
|
|
|
|
|
|
|
|
184
|
|
|
|
|
|
|
has minimum_value => ( |
185
|
|
|
|
|
|
|
is => 'rw', |
186
|
|
|
|
|
|
|
isa => 'Num', |
187
|
|
|
|
|
|
|
required => 1, |
188
|
|
|
|
|
|
|
default => 0, |
189
|
|
|
|
|
|
|
); |
190
|
|
|
|
|
|
|
|
191
|
|
|
|
|
|
|
has maximum_value => ( |
192
|
|
|
|
|
|
|
is => 'rw', |
193
|
|
|
|
|
|
|
isa => 'Num', |
194
|
|
|
|
|
|
|
required => 1, |
195
|
|
|
|
|
|
|
default => 100, |
196
|
|
|
|
|
|
|
); |
197
|
|
|
|
|
|
|
|
198
|
|
|
|
|
|
|
has value => ( |
199
|
|
|
|
|
|
|
is => 'rw', |
200
|
|
|
|
|
|
|
isa => 'Num', |
201
|
|
|
|
|
|
|
required => 1, |
202
|
|
|
|
|
|
|
default => 50, |
203
|
|
|
|
|
|
|
); |
204
|
|
|
|
|
|
|
|
205
|
|
|
|
|
|
|
sub current_value { |
206
|
|
|
|
|
|
|
my $self = shift |
207
|
|
|
|
|
|
|
if (@_) { $self->value(shift) } |
208
|
|
|
|
|
|
|
return $self->value; |
209
|
|
|
|
|
|
|
} |
210
|
|
|
|
|
|
|
|
211
|
|
|
|
|
|
|
package Form::Factory::Control::Custom::Slider; |
212
|
|
|
|
|
|
|
sub register_implementation { 'MyApp::Control::Slider' } |
213
|
|
|
|
|
|
|
|
214
|
|
|
|
|
|
|
=head1 DESCRIPTION |
215
|
|
|
|
|
|
|
|
216
|
|
|
|
|
|
|
Allows for high level processing, validation, filtering, etc. of form control information. |
217
|
|
|
|
|
|
|
|
218
|
|
|
|
|
|
|
=head1 ATTRIBUTES |
219
|
|
|
|
|
|
|
|
220
|
|
|
|
|
|
|
=head2 action |
221
|
|
|
|
|
|
|
|
222
|
|
|
|
|
|
|
This is the action to which the control is attached. This is a weak reference to prevent memory leaks. |
223
|
|
|
|
|
|
|
|
224
|
|
|
|
|
|
|
=head2 name |
225
|
|
|
|
|
|
|
|
226
|
|
|
|
|
|
|
This is the base name for the control. |
227
|
|
|
|
|
|
|
|
228
|
|
|
|
|
|
|
=head2 documentation |
229
|
|
|
|
|
|
|
|
230
|
|
|
|
|
|
|
This holds a copy the documentation attribute of the original meta attribute. |
231
|
|
|
|
|
|
|
|
232
|
|
|
|
|
|
|
=head2 features |
233
|
|
|
|
|
|
|
|
234
|
|
|
|
|
|
|
This is the list of L<Form::Factory::Feature::Role::Control> features associated with the control. |
235
|
|
|
|
|
|
|
|
236
|
|
|
|
|
|
|
=head2 value |
237
|
|
|
|
|
|
|
|
238
|
|
|
|
|
|
|
This is the value of the control. This attribute provides a C<has_value> predicate. See L</current_value>. |
239
|
|
|
|
|
|
|
|
240
|
|
|
|
|
|
|
=head2 default_value |
241
|
|
|
|
|
|
|
|
242
|
|
|
|
|
|
|
This is the default or fallback value for the control used when L</value> is not set. This attribute provides a C<has_default_value> predicate. See L</current_value>. |
243
|
|
|
|
|
|
|
|
244
|
|
|
|
|
|
|
=head2 control_to_value |
245
|
|
|
|
|
|
|
|
246
|
|
|
|
|
|
|
This may be a method name or a code reference that can be run in order to coerce the control's current value to the action attribute's value during action processing. The given method or subroutine will always be called with 3 arguments: |
247
|
|
|
|
|
|
|
|
248
|
|
|
|
|
|
|
=over |
249
|
|
|
|
|
|
|
|
250
|
|
|
|
|
|
|
=item 1 |
251
|
|
|
|
|
|
|
|
252
|
|
|
|
|
|
|
The action object the control has been attached to. |
253
|
|
|
|
|
|
|
|
254
|
|
|
|
|
|
|
=item 2 |
255
|
|
|
|
|
|
|
|
256
|
|
|
|
|
|
|
The control object we are converting from. |
257
|
|
|
|
|
|
|
|
258
|
|
|
|
|
|
|
=item 3 |
259
|
|
|
|
|
|
|
|
260
|
|
|
|
|
|
|
The current value of the control. |
261
|
|
|
|
|
|
|
|
262
|
|
|
|
|
|
|
=back |
263
|
|
|
|
|
|
|
|
264
|
|
|
|
|
|
|
The method or subroutien should return the converted value. |
265
|
|
|
|
|
|
|
|
266
|
|
|
|
|
|
|
This attribute provides a C<has_control_to_value> predicate. |
267
|
|
|
|
|
|
|
|
268
|
|
|
|
|
|
|
=head2 value_to_control |
269
|
|
|
|
|
|
|
|
270
|
|
|
|
|
|
|
This is either a method name (to be called on the action the control is connected with) to a code reference. This method or subroutine will be called to conver the action attribute value to the control's value. |
271
|
|
|
|
|
|
|
|
272
|
|
|
|
|
|
|
The method or subroutine will always be called with three arguments: |
273
|
|
|
|
|
|
|
|
274
|
|
|
|
|
|
|
=over |
275
|
|
|
|
|
|
|
|
276
|
|
|
|
|
|
|
=item 1 |
277
|
|
|
|
|
|
|
|
278
|
|
|
|
|
|
|
The action object the control belongs to. |
279
|
|
|
|
|
|
|
|
280
|
|
|
|
|
|
|
=item 2 |
281
|
|
|
|
|
|
|
|
282
|
|
|
|
|
|
|
The control object that will receive the value. |
283
|
|
|
|
|
|
|
|
284
|
|
|
|
|
|
|
=item 3 |
285
|
|
|
|
|
|
|
|
286
|
|
|
|
|
|
|
The value of the attribute that is being assigned to the control. |
287
|
|
|
|
|
|
|
|
288
|
|
|
|
|
|
|
=back |
289
|
|
|
|
|
|
|
|
290
|
|
|
|
|
|
|
The method or subroutine should return the converted value. |
291
|
|
|
|
|
|
|
|
292
|
|
|
|
|
|
|
This attribute provides a C<has_value_to_control> predicate. |
293
|
|
|
|
|
|
|
|
294
|
|
|
|
|
|
|
=head1 METHODS |
295
|
|
|
|
|
|
|
|
296
|
|
|
|
|
|
|
=head2 current_value |
297
|
|
|
|
|
|
|
|
298
|
|
|
|
|
|
|
This is the current value of the control. If L</value> is set, then that is returned. If that is not set, but L</defautl_value> is set, then that is returned. If neither are set, then C<undef> is returned. |
299
|
|
|
|
|
|
|
|
300
|
|
|
|
|
|
|
This may also be passed a value. In which case the L</value> is set and that value is returned. |
301
|
|
|
|
|
|
|
|
302
|
|
|
|
|
|
|
=head2 has_current_value |
303
|
|
|
|
|
|
|
|
304
|
|
|
|
|
|
|
Returns true if either C<value> or C<default_value> is set. |
305
|
|
|
|
|
|
|
|
306
|
|
|
|
|
|
|
=head2 convert_value_to_control |
307
|
|
|
|
|
|
|
|
308
|
|
|
|
|
|
|
Given an attribute value, convert it to a control value. This will cause any associated L<Form::Factory::Feature::Role::ControlValueConverter> features to run and run the L</value_to_control> conversion. The value to convert should be passed as the lone argument. The converted value is returned. |
309
|
|
|
|
|
|
|
|
310
|
|
|
|
|
|
|
=head2 convert_control_to_value |
311
|
|
|
|
|
|
|
|
312
|
|
|
|
|
|
|
Given a control value, convert it to an attribute value. This will run any L<Form::Factory::Feature::Role::ControlValueConverter> features and the L</control_to_value> conversion (if set). The value to convert should be passed as the only argument and the converted value is returned. |
313
|
|
|
|
|
|
|
|
314
|
|
|
|
|
|
|
=head2 set_attribute_value |
315
|
|
|
|
|
|
|
|
316
|
|
|
|
|
|
|
$control->set_attribute_value($action, $attribute); |
317
|
|
|
|
|
|
|
|
318
|
|
|
|
|
|
|
Sets the value of the action attribute with current value of teh control. |
319
|
|
|
|
|
|
|
|
320
|
|
|
|
|
|
|
=head2 get_feature_by_name |
321
|
|
|
|
|
|
|
|
322
|
|
|
|
|
|
|
my $feature = $control->get_feature_by_name($name); |
323
|
|
|
|
|
|
|
|
324
|
|
|
|
|
|
|
Given a feature name, it returns the named feature object. Returns C<undef> if no such feature is attached to this control. |
325
|
|
|
|
|
|
|
|
326
|
|
|
|
|
|
|
=head2 has_feature |
327
|
|
|
|
|
|
|
|
328
|
|
|
|
|
|
|
if ($control->has_feature($name)) { |
329
|
|
|
|
|
|
|
# do something about it... |
330
|
|
|
|
|
|
|
} |
331
|
|
|
|
|
|
|
|
332
|
|
|
|
|
|
|
Returns a true value if the named feature is attached to this control. Returns false otherwise. |
333
|
|
|
|
|
|
|
|
334
|
|
|
|
|
|
|
=head1 AUTHOR |
335
|
|
|
|
|
|
|
|
336
|
|
|
|
|
|
|
Andrew Sterling Hanenkamp <hanenkamp@cpan.org> |
337
|
|
|
|
|
|
|
|
338
|
|
|
|
|
|
|
=head1 COPYRIGHT AND LICENSE |
339
|
|
|
|
|
|
|
|
340
|
|
|
|
|
|
|
This software is copyright (c) 2015 by Qubling Software LLC. |
341
|
|
|
|
|
|
|
|
342
|
|
|
|
|
|
|
This is free software; you can redistribute it and/or modify it under |
343
|
|
|
|
|
|
|
the same terms as the Perl 5 programming language system itself. |
344
|
|
|
|
|
|
|
|
345
|
|
|
|
|
|
|
=cut |