File Coverage

blib/lib/Form/Factory/Control.pm
Criterion Covered Total %
statement 47 51 92.1
branch 20 22 90.9
condition 0 3 0.0
subroutine 10 11 90.9
pod 7 7 100.0
total 84 94 89.3


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