File Coverage

blib/lib/Form/Factory/Feature/Control/FillOnAssignment.pm
Criterion Covered Total %
statement 32 32 100.0
branch 5 6 83.3
condition 2 5 40.0
subroutine 8 8 100.0
pod 3 3 100.0
total 50 54 92.5


line stmt bran cond sub pod time code
1             package Form::Factory::Feature::Control::FillOnAssignment;
2             $Form::Factory::Feature::Control::FillOnAssignment::VERSION = '0.022';
3 1     1   514 use Moose;
  1         2  
  1         6  
4              
5             with qw(
6             Form::Factory::Feature
7             Form::Factory::Feature::Role::BuildAttribute
8             Form::Factory::Feature::Role::InitializeControl
9             Form::Factory::Feature::Role::Control
10             );
11              
12 1     1   4941 use Carp ();
  1         2  
  1         18  
13              
14             # ABSTRACT: Control gets the value of the attribute
15              
16              
17 1     1   4 use Moose::Util::TypeConstraints;
  1         1  
  1         8  
18              
19             enum 'Form::Factory::Feature::Control::FillOnAssignment::Slot'
20             => [qw( value default_value )];
21              
22 1     1   1556 no Moose::Util::TypeConstraints;
  1         2  
  1         5  
23              
24             has slot => (
25             is => 'ro',
26             isa => 'Form::Factory::Feature::Control::FillOnAssignment::Slot',
27             required => 1,
28             default => 'default_value',
29             );
30              
31              
32 8     8 1 14 sub check_control { }
33              
34              
35             sub build_attribute {
36 4     4 1 10 my ($self, $options, $meta, $name, $attr) = @_;
37              
38 4 100       19 unless ($options->{no_warning}) {
39 3 50 33     20 Carp::carp("the $name attribute is read-only, but the fill_on_assignment feature is enabled for it, are you sure this is correct?")
40             if $attr->{is} eq 'ro' or $attr->{is} eq 'bare';
41             }
42              
43 4   50     24 my $slot = $options->{slot} || 'default_value';
44             $attr->{trigger} = sub {
45 5     5   6037 my ($self, $value) = @_;
46 5         184 my $control = $self->controls->{$name};
47 5         24 $value = $control->convert_value_to_control($value);
48 5         171 $self->controls->{$name}->$slot($value);
49 4         31 };
50             }
51              
52              
53             sub initialize_control {
54 8     8 1 11 my $self = shift;
55 8         313 my $action = $self->action;
56 8         329 my $control = $self->control;
57              
58 8         45 my $attr = $action->meta->find_attribute_by_name($control->name);
59 8         431 my $value = $attr->get_value($action);
60              
61 8 100       846 if (defined $value) {
62 3         15 $value = $control->convert_value_to_control($value);
63 3         121 my $slot = $self->slot;
64 3         106 $control->$slot($value);
65             }
66              
67 8         33 return $self;
68             };
69              
70             __PACKAGE__->meta->make_immutable;
71              
72             __END__
73              
74             =pod
75              
76             =encoding UTF-8
77              
78             =head1 NAME
79              
80             Form::Factory::Feature::Control::FillOnAssignment - Control gets the value of the attribute
81              
82             =head1 VERSION
83              
84             version 0.022
85              
86             =head1 SYNOPSIS
87              
88             package MyApp::Action::Thing;
89             use Form::Factory::Processor;
90              
91             has_control title => (
92             control => 'text',
93             features => {
94             fill_on_assignment => 1,
95             },
96             );
97              
98             package Somewhere::Else;
99              
100             my $interface = Form::Factory->new_interface('HTML');
101             my $action = $itnerface->new_action('MyApp::Action::Thing' => {
102             title => 'Some preset title',
103             });
104              
105             $action->render; # outputs an INPUT with value="Some preset title"
106              
107             $action->title('A different value');
108              
109             $action->render; # outputs an INPUT with value="A different value"
110              
111             =head1 DESCRIPTION
112              
113             This feature adds a trigger to the control so that any assignment to the action value causes the control to also gain that value.
114              
115             =head1 ATTRIBUTES
116              
117             =head2 slot
118              
119             This names the slot that will be filled with the value. This must be either C<value> or C<default_value>. The default is C<default_value>.
120              
121             =head1 METHODS
122              
123             =head2 check_control
124              
125             No op.
126              
127             =head2 build_attribute
128              
129             This modifies the attribute being created to have a C<trigger> that causes the default value of the control to gain the value of the action's attribute on set. Unless C<no_warning> is set, this will cause a warning if the "is" setting is not set to "rw".
130              
131             =head2 initialize_control
132              
133             After the control is initialized, this will set the default value of the control to the value currently held by the action attribute.
134              
135             =head1 AUTHOR
136              
137             Andrew Sterling Hanenkamp <hanenkamp@cpan.org>
138              
139             =head1 COPYRIGHT AND LICENSE
140              
141             This software is copyright (c) 2015 by Qubling Software LLC.
142              
143             This is free software; you can redistribute it and/or modify it under
144             the same terms as the Perl 5 programming language system itself.
145              
146             =cut