line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package HTML::FormHandler; |
2
|
|
|
|
|
|
|
# ABSTRACT: HTML forms using Moose |
3
|
|
|
|
|
|
|
|
4
|
3
|
|
|
3
|
|
53810
|
use Moose; |
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
5
|
|
|
|
|
|
|
extends 'HTML::FormHandler::Base'; # to make some methods overridable by roles |
6
|
|
|
|
|
|
|
with 'HTML::FormHandler::Model', 'HTML::FormHandler::Fields', |
7
|
|
|
|
|
|
|
'HTML::FormHandler::BuildFields', |
8
|
|
|
|
|
|
|
'HTML::FormHandler::TraitFor::I18N'; |
9
|
|
|
|
|
|
|
with 'HTML::FormHandler::InitResult'; |
10
|
|
|
|
|
|
|
with 'HTML::FormHandler::Widget::ApplyRole'; |
11
|
|
|
|
|
|
|
with 'HTML::FormHandler::Traits'; |
12
|
|
|
|
|
|
|
with 'HTML::FormHandler::Blocks'; |
13
|
|
|
|
|
|
|
|
14
|
|
|
|
|
|
|
use Carp; |
15
|
|
|
|
|
|
|
use Class::MOP; |
16
|
|
|
|
|
|
|
use HTML::FormHandler::Result; |
17
|
|
|
|
|
|
|
use HTML::FormHandler::Field; |
18
|
|
|
|
|
|
|
use Try::Tiny; |
19
|
|
|
|
|
|
|
use MooseX::Types::LoadableClass qw/ LoadableClass /; |
20
|
|
|
|
|
|
|
use namespace::autoclean; |
21
|
|
|
|
|
|
|
use HTML::FormHandler::Merge ('merge'); |
22
|
|
|
|
|
|
|
use Sub::Name; |
23
|
|
|
|
|
|
|
use Data::Clone; |
24
|
|
|
|
|
|
|
|
25
|
|
|
|
|
|
|
use 5.008; |
26
|
|
|
|
|
|
|
|
27
|
|
|
|
|
|
|
# always use 5 digits after decimal because of toolchain issues |
28
|
|
|
|
|
|
|
our $VERSION = '0.40057'; |
29
|
|
|
|
|
|
|
|
30
|
|
|
|
|
|
|
|
31
|
|
|
|
|
|
|
# for consistency in api with field nodes |
32
|
|
|
|
|
|
|
sub form { shift } |
33
|
|
|
|
|
|
|
sub is_form { 1 } |
34
|
|
|
|
|
|
|
sub has_form { 1 } |
35
|
|
|
|
|
|
|
|
36
|
|
|
|
|
|
|
# Moose attributes |
37
|
|
|
|
|
|
|
has 'name' => ( |
38
|
|
|
|
|
|
|
isa => 'Str', |
39
|
|
|
|
|
|
|
is => 'rw', |
40
|
|
|
|
|
|
|
default => sub { return 'form' . int( rand 1000 ) } |
41
|
|
|
|
|
|
|
); |
42
|
|
|
|
|
|
|
sub full_name { '' } |
43
|
|
|
|
|
|
|
sub full_accessor { '' } |
44
|
|
|
|
|
|
|
has 'parent' => ( is => 'rw' ); |
45
|
|
|
|
|
|
|
has 'result' => ( |
46
|
|
|
|
|
|
|
isa => 'HTML::FormHandler::Result', |
47
|
|
|
|
|
|
|
is => 'ro', |
48
|
|
|
|
|
|
|
writer => '_set_result', |
49
|
|
|
|
|
|
|
clearer => 'clear_result', |
50
|
|
|
|
|
|
|
lazy => 1, |
51
|
|
|
|
|
|
|
builder => 'build_result', |
52
|
|
|
|
|
|
|
predicate => 'has_result', |
53
|
|
|
|
|
|
|
handles => [ |
54
|
|
|
|
|
|
|
'input', '_set_input', '_clear_input', 'has_input', |
55
|
|
|
|
|
|
|
'value', '_set_value', '_clear_value', 'has_value', |
56
|
|
|
|
|
|
|
'add_result', 'results', 'validated', 'ran_validation', |
57
|
|
|
|
|
|
|
'is_valid', |
58
|
|
|
|
|
|
|
'form_errors', 'all_form_errors', 'push_form_errors', 'clear_form_errors', |
59
|
|
|
|
|
|
|
'has_form_errors', 'num_form_errors', |
60
|
|
|
|
|
|
|
], |
61
|
|
|
|
|
|
|
); |
62
|
|
|
|
|
|
|
|
63
|
|
|
|
|
|
|
sub build_result { |
64
|
|
|
|
|
|
|
my $self = shift; |
65
|
|
|
|
|
|
|
my $result_class = 'HTML::FormHandler::Result'; |
66
|
|
|
|
|
|
|
if ( $self->widget_form ) { |
67
|
|
|
|
|
|
|
my $role = $self->get_widget_role( $self->widget_form, 'Form' ); |
68
|
|
|
|
|
|
|
$result_class = $result_class->with_traits( $role ); |
69
|
|
|
|
|
|
|
} |
70
|
|
|
|
|
|
|
my $result = $result_class->new( name => $self->name, form => $self ); |
71
|
|
|
|
|
|
|
return $result; |
72
|
|
|
|
|
|
|
} |
73
|
|
|
|
|
|
|
|
74
|
|
|
|
|
|
|
has 'index' => ( |
75
|
|
|
|
|
|
|
is => 'ro', isa => 'HashRef[HTML::FormHandler::Field]', traits => ['Hash'], |
76
|
|
|
|
|
|
|
default => sub {{}}, |
77
|
|
|
|
|
|
|
handles => { |
78
|
|
|
|
|
|
|
add_to_index => 'set', |
79
|
|
|
|
|
|
|
field_from_index => 'get', |
80
|
|
|
|
|
|
|
field_in_index => 'exists', |
81
|
|
|
|
|
|
|
} |
82
|
|
|
|
|
|
|
); |
83
|
|
|
|
|
|
|
has '_repeatable_fields' => ( is => 'rw', isa => 'ArrayRef', |
84
|
|
|
|
|
|
|
traits => ['Array'], default => sub {[]}, |
85
|
|
|
|
|
|
|
handles => { |
86
|
|
|
|
|
|
|
add_repeatable_field => 'push', |
87
|
|
|
|
|
|
|
has_repeatable_fields => 'count', |
88
|
|
|
|
|
|
|
all_repeatable_fields => 'elements', |
89
|
|
|
|
|
|
|
}, |
90
|
|
|
|
|
|
|
); |
91
|
|
|
|
|
|
|
|
92
|
|
|
|
|
|
|
has 'field_traits' => ( is => 'ro', traits => ['Array'], isa => 'ArrayRef', |
93
|
|
|
|
|
|
|
default => sub {[]}, handles => { 'has_field_traits' => 'count' } ); |
94
|
|
|
|
|
|
|
has 'widget_name_space' => ( |
95
|
|
|
|
|
|
|
is => 'ro', |
96
|
|
|
|
|
|
|
isa => 'HFH::ArrayRefStr', |
97
|
|
|
|
|
|
|
traits => ['Array'], |
98
|
|
|
|
|
|
|
default => sub {[]}, |
99
|
|
|
|
|
|
|
coerce => 1, |
100
|
|
|
|
|
|
|
handles => { |
101
|
|
|
|
|
|
|
add_widget_name_space => 'push', |
102
|
|
|
|
|
|
|
}, |
103
|
|
|
|
|
|
|
); |
104
|
|
|
|
|
|
|
# it only really makes sense to set these before widget_form is applied in BUILD |
105
|
|
|
|
|
|
|
has 'widget_form' => ( is => 'ro', isa => 'Str', default => 'Simple', writer => 'set_widget_form' ); |
106
|
|
|
|
|
|
|
has 'widget_wrapper' => ( is => 'ro', isa => 'Str', default => 'Simple', writer => 'set_widget_wrapper' ); |
107
|
|
|
|
|
|
|
has 'do_form_wrapper' => ( is => 'rw', builder => 'build_do_form_wrapper' ); |
108
|
|
|
|
|
|
|
sub build_do_form_wrapper { 0 } |
109
|
|
|
|
|
|
|
has 'no_widgets' => ( is => 'ro', isa => 'Bool' ); |
110
|
|
|
|
|
|
|
has 'no_preload' => ( is => 'ro', isa => 'Bool' ); |
111
|
|
|
|
|
|
|
has 'no_update' => ( is => 'rw', isa => 'Bool', clearer => 'clear_no_update' ); |
112
|
|
|
|
|
|
|
has 'active' => ( |
113
|
|
|
|
|
|
|
is => 'rw', |
114
|
|
|
|
|
|
|
traits => ['Array'], |
115
|
|
|
|
|
|
|
isa => 'ArrayRef[Str]', |
116
|
|
|
|
|
|
|
default => sub {[]}, |
117
|
|
|
|
|
|
|
handles => { |
118
|
|
|
|
|
|
|
add_active => 'push', |
119
|
|
|
|
|
|
|
has_active => 'count', |
120
|
|
|
|
|
|
|
clear_active => 'clear', |
121
|
|
|
|
|
|
|
} |
122
|
|
|
|
|
|
|
); |
123
|
|
|
|
|
|
|
has 'inactive' => ( |
124
|
|
|
|
|
|
|
is => 'rw', |
125
|
|
|
|
|
|
|
traits => ['Array'], |
126
|
|
|
|
|
|
|
isa => 'ArrayRef[Str]', |
127
|
|
|
|
|
|
|
default => sub {[]}, |
128
|
|
|
|
|
|
|
handles => { |
129
|
|
|
|
|
|
|
add_inactive => 'push', |
130
|
|
|
|
|
|
|
has_inactive => 'count', |
131
|
|
|
|
|
|
|
clear_inactive => 'clear', |
132
|
|
|
|
|
|
|
} |
133
|
|
|
|
|
|
|
); |
134
|
|
|
|
|
|
|
|
135
|
|
|
|
|
|
|
|
136
|
|
|
|
|
|
|
# object with which to initialize |
137
|
|
|
|
|
|
|
has 'init_object' => ( is => 'rw', clearer => 'clear_init_object' ); |
138
|
|
|
|
|
|
|
has 'update_field_list' => ( is => 'rw', |
139
|
|
|
|
|
|
|
isa => 'HashRef', |
140
|
|
|
|
|
|
|
default => sub {{}}, |
141
|
|
|
|
|
|
|
traits => ['Hash'], |
142
|
|
|
|
|
|
|
handles => { |
143
|
|
|
|
|
|
|
clear_update_field_list => 'clear', |
144
|
|
|
|
|
|
|
has_update_field_list => 'count', |
145
|
|
|
|
|
|
|
set_update_field_list => 'set', |
146
|
|
|
|
|
|
|
}, |
147
|
|
|
|
|
|
|
); |
148
|
|
|
|
|
|
|
has 'defaults' => ( is => 'rw', isa => 'HashRef', default => sub {{}}, traits => ['Hash'], |
149
|
|
|
|
|
|
|
handles => { has_defaults => 'count', clear_defaults => 'clear' }, |
150
|
|
|
|
|
|
|
); |
151
|
|
|
|
|
|
|
has 'use_defaults_over_obj' => ( is => 'rw', isa => 'Bool', clearer => 'clear_use_defaults_over_obj' ); |
152
|
|
|
|
|
|
|
has 'use_init_obj_over_item' => ( is => 'rw', isa => 'Bool', clearer => 'clear_use_init_obj_over_item' ); |
153
|
|
|
|
|
|
|
has 'use_init_obj_when_no_accessor_in_item' => ( is => 'rw', isa => 'Bool' ); |
154
|
|
|
|
|
|
|
has 'use_fields_for_input_without_param' => ( is => 'rw', isa => 'Bool' ); |
155
|
|
|
|
|
|
|
# flags |
156
|
|
|
|
|
|
|
has [ 'verbose', 'processed', 'did_init_obj' ] => ( isa => 'Bool', is => 'rw' ); |
157
|
|
|
|
|
|
|
has 'user_data' => ( isa => 'HashRef', is => 'rw' ); |
158
|
|
|
|
|
|
|
has 'ctx' => ( is => 'rw', weak_ref => 1, clearer => 'clear_ctx' ); |
159
|
|
|
|
|
|
|
has 'html_prefix' => ( isa => 'Bool', is => 'ro' ); |
160
|
|
|
|
|
|
|
has 'active_column' => ( isa => 'Str', is => 'ro' ); |
161
|
|
|
|
|
|
|
has 'http_method' => ( isa => 'Str', is => 'ro', default => 'post' ); |
162
|
|
|
|
|
|
|
has 'enctype' => ( is => 'rw', isa => 'Str' ); |
163
|
|
|
|
|
|
|
has 'error_message' => ( is => 'rw', predicate => 'has_error_message', clearer => 'clear_error_message' ); |
164
|
|
|
|
|
|
|
has 'success_message' => ( is => 'rw', predicate => 'has_success_message', clearer => 'clear_success_message' ); |
165
|
|
|
|
|
|
|
has 'info_message' => ( is => 'rw', predicate => 'has_info_message', clearer => 'clear_info_message' ); |
166
|
|
|
|
|
|
|
# deprecated |
167
|
|
|
|
|
|
|
has 'style' => ( isa => 'Str', is => 'rw' ); |
168
|
|
|
|
|
|
|
|
169
|
|
|
|
|
|
|
has 'is_html5' => ( isa => 'Bool', is => 'ro', default => 0 ); |
170
|
|
|
|
|
|
|
# deprecated. use form_element_attr instead |
171
|
|
|
|
|
|
|
has 'html_attr' => ( is => 'rw', traits => ['Hash'], |
172
|
|
|
|
|
|
|
default => sub { {} }, handles => { has_html_attr => 'count', |
173
|
|
|
|
|
|
|
set_html_attr => 'set', delete_html_attr => 'delete' }, |
174
|
|
|
|
|
|
|
trigger => \&_html_attr_set, |
175
|
|
|
|
|
|
|
); |
176
|
|
|
|
|
|
|
sub _html_attr_set { |
177
|
|
|
|
|
|
|
my ( $self, $value ) = @_; |
178
|
|
|
|
|
|
|
my $class = delete $value->{class}; |
179
|
|
|
|
|
|
|
$self->form_element_attr($value); |
180
|
|
|
|
|
|
|
$self->add_form_element_class if $class; |
181
|
|
|
|
|
|
|
} |
182
|
|
|
|
|
|
|
|
183
|
|
|
|
|
|
|
{ |
184
|
|
|
|
|
|
|
# create the attributes and methods for |
185
|
|
|
|
|
|
|
# form_element_attr, build_form_element_attr, form_element_class, |
186
|
|
|
|
|
|
|
# form_wrapper_attr, build_form_wrapper_atrr, form_wrapper_class |
187
|
|
|
|
|
|
|
no strict 'refs'; |
188
|
|
|
|
|
|
|
foreach my $attr ('form_wrapper', 'form_element' ) { |
189
|
|
|
|
|
|
|
my $add_meth = "add_${attr}_class"; |
190
|
|
|
|
|
|
|
has "${attr}_attr" => ( is => 'rw', traits => ['Hash'], |
191
|
|
|
|
|
|
|
builder => "build_${attr}_attr", |
192
|
|
|
|
|
|
|
handles => { |
193
|
|
|
|
|
|
|
"has_${attr}_attr" => 'count', |
194
|
|
|
|
|
|
|
"get_${attr}_attr" => 'get', |
195
|
|
|
|
|
|
|
"set_${attr}_attr" => 'set', |
196
|
|
|
|
|
|
|
"delete_${attr}_attr" => 'delete', |
197
|
|
|
|
|
|
|
"exists_${attr}_attr" => 'exists', |
198
|
|
|
|
|
|
|
}, |
199
|
|
|
|
|
|
|
); |
200
|
|
|
|
|
|
|
# create builders for _attr |
201
|
|
|
|
|
|
|
my $attr_builder = __PACKAGE__ . "::build_${attr}_attr"; |
202
|
|
|
|
|
|
|
*$attr_builder = subname $attr_builder, sub {{}}; |
203
|
|
|
|
|
|
|
# create the 'class' slots |
204
|
|
|
|
|
|
|
has "${attr}_class" => ( is => 'rw', isa => 'HFH::ArrayRefStr', |
205
|
|
|
|
|
|
|
traits => ['Array'], |
206
|
|
|
|
|
|
|
coerce => 1, |
207
|
|
|
|
|
|
|
builder => "build_${attr}_class", |
208
|
|
|
|
|
|
|
handles => { |
209
|
|
|
|
|
|
|
"has_${attr}_class" => 'count', |
210
|
|
|
|
|
|
|
"_add_${attr}_class" => 'push', |
211
|
|
|
|
|
|
|
}, |
212
|
|
|
|
|
|
|
); |
213
|
|
|
|
|
|
|
# create builders for classes |
214
|
|
|
|
|
|
|
my $class_builder = __PACKAGE__ . "::build_${attr}_class"; |
215
|
|
|
|
|
|
|
*$class_builder = subname $class_builder, sub {[]}; |
216
|
|
|
|
|
|
|
# create wrapper for add_to_ to accept arrayref |
217
|
|
|
|
|
|
|
my $add_to_class = __PACKAGE__ . "::add_${attr}_class"; |
218
|
|
|
|
|
|
|
my $_add_meth = __PACKAGE__ . "::_add_${attr}_class"; |
219
|
|
|
|
|
|
|
# create add method that takes an arrayref |
220
|
|
|
|
|
|
|
*$add_to_class = subname $add_to_class, sub { shift->$_add_meth((ref $_[0] eq 'ARRAY' ? @{$_[0]} : @_)); } |
221
|
|
|
|
|
|
|
} |
222
|
|
|
|
|
|
|
} |
223
|
|
|
|
|
|
|
|
224
|
|
|
|
|
|
|
sub attributes { shift->form_element_attributes(@_) } |
225
|
|
|
|
|
|
|
sub form_element_attributes { |
226
|
|
|
|
|
|
|
my ( $self, $result ) = @_; |
227
|
|
|
|
|
|
|
$result ||= $self->result; |
228
|
|
|
|
|
|
|
my $attr = {}; |
229
|
|
|
|
|
|
|
$attr->{id} = $self->name; |
230
|
|
|
|
|
|
|
$attr->{action} = $self->action if $self->action; |
231
|
|
|
|
|
|
|
$attr->{method} = $self->http_method if $self->http_method; |
232
|
|
|
|
|
|
|
$attr->{enctype} = $self->enctype if $self->enctype; |
233
|
|
|
|
|
|
|
$attr->{style} = $self->style if $self->style; |
234
|
|
|
|
|
|
|
$attr = {%$attr, %{$self->form_element_attr}}; |
235
|
|
|
|
|
|
|
my $class = [@{$self->form_element_class}]; |
236
|
|
|
|
|
|
|
$attr->{class} = $class if @$class; |
237
|
|
|
|
|
|
|
my $mod_attr = $self->html_attributes($self, 'form_element', $attr); |
238
|
|
|
|
|
|
|
return ref $mod_attr eq 'HASH' ? $mod_attr : $attr; |
239
|
|
|
|
|
|
|
} |
240
|
|
|
|
|
|
|
sub form_wrapper_attributes { |
241
|
|
|
|
|
|
|
my ( $self, $result ) = @_; |
242
|
|
|
|
|
|
|
$result ||= $self->result; |
243
|
|
|
|
|
|
|
my $attr = {%{$self->form_wrapper_attr}}; |
244
|
|
|
|
|
|
|
my $class = [@{$self->form_wrapper_class}]; |
245
|
|
|
|
|
|
|
$attr->{class} = $class if @$class; |
246
|
|
|
|
|
|
|
my $mod_attr = $self->html_attributes($self, 'form_wrapper', $attr); |
247
|
|
|
|
|
|
|
return ref $mod_attr eq 'HASH' ? $mod_attr : $attr; |
248
|
|
|
|
|
|
|
} |
249
|
|
|
|
|
|
|
|
250
|
|
|
|
|
|
|
sub html_attributes { |
251
|
|
|
|
|
|
|
my ( $self, $obj, $type, $attrs, $result ) = @_; |
252
|
|
|
|
|
|
|
# deprecated 'field_html_attributes'; name changed, remove eventually |
253
|
|
|
|
|
|
|
if( $self->can('field_html_attributes') ) { |
254
|
|
|
|
|
|
|
$attrs = $self->field_html_attributes( $obj, $type, $attrs, $result ); |
255
|
|
|
|
|
|
|
} |
256
|
|
|
|
|
|
|
return $attrs; |
257
|
|
|
|
|
|
|
} |
258
|
|
|
|
|
|
|
|
259
|
|
|
|
|
|
|
sub has_flag { |
260
|
|
|
|
|
|
|
my ( $self, $flag_name ) = @_; |
261
|
|
|
|
|
|
|
return unless $self->can($flag_name); |
262
|
|
|
|
|
|
|
return $self->$flag_name; |
263
|
|
|
|
|
|
|
} |
264
|
|
|
|
|
|
|
|
265
|
|
|
|
|
|
|
has 'form_tags' => ( |
266
|
|
|
|
|
|
|
traits => ['Hash'], |
267
|
|
|
|
|
|
|
isa => 'HashRef', |
268
|
|
|
|
|
|
|
is => 'ro', |
269
|
|
|
|
|
|
|
builder => 'build_form_tags', |
270
|
|
|
|
|
|
|
handles => { |
271
|
|
|
|
|
|
|
_get_tag => 'get', |
272
|
|
|
|
|
|
|
set_tag => 'set', |
273
|
|
|
|
|
|
|
tag_exists => 'exists', |
274
|
|
|
|
|
|
|
has_tag => 'exists', |
275
|
|
|
|
|
|
|
}, |
276
|
|
|
|
|
|
|
); |
277
|
|
|
|
|
|
|
sub build_form_tags {{}} |
278
|
|
|
|
|
|
|
sub get_tag { |
279
|
|
|
|
|
|
|
my ( $self, $name ) = @_; |
280
|
|
|
|
|
|
|
return '' unless $self->tag_exists($name); |
281
|
|
|
|
|
|
|
my $tag = $self->_get_tag($name); |
282
|
|
|
|
|
|
|
return $self->$tag if ref $tag eq 'CODE'; |
283
|
|
|
|
|
|
|
return $tag unless $tag =~ /^%/; |
284
|
|
|
|
|
|
|
( my $block_name = $tag ) =~ s/^%//; |
285
|
|
|
|
|
|
|
return $self->form->block($block_name)->render |
286
|
|
|
|
|
|
|
if ( $self->form && $self->form->block_exists($block_name) ); |
287
|
|
|
|
|
|
|
return ''; |
288
|
|
|
|
|
|
|
} |
289
|
|
|
|
|
|
|
has 'for_js' => ( |
290
|
|
|
|
|
|
|
isa => 'HashRef', |
291
|
|
|
|
|
|
|
traits => ['Hash'], |
292
|
|
|
|
|
|
|
is => 'rw', |
293
|
|
|
|
|
|
|
default => sub { {} }, |
294
|
|
|
|
|
|
|
handles => { |
295
|
|
|
|
|
|
|
set_for_js => 'set', |
296
|
|
|
|
|
|
|
has_for_js => 'count', |
297
|
|
|
|
|
|
|
clear_for_js => 'clear', |
298
|
|
|
|
|
|
|
} |
299
|
|
|
|
|
|
|
); |
300
|
|
|
|
|
|
|
|
301
|
|
|
|
|
|
|
has 'action' => ( is => 'rw' ); |
302
|
|
|
|
|
|
|
has 'posted' => ( is => 'rw', isa => 'Bool', clearer => 'clear_posted', predicate => 'has_posted' ); |
303
|
|
|
|
|
|
|
has 'params' => ( |
304
|
|
|
|
|
|
|
traits => ['Hash'], |
305
|
|
|
|
|
|
|
isa => 'HashRef', |
306
|
|
|
|
|
|
|
is => 'rw', |
307
|
|
|
|
|
|
|
default => sub { {} }, |
308
|
|
|
|
|
|
|
trigger => sub { shift->_munge_params(@_) }, |
309
|
|
|
|
|
|
|
handles => { |
310
|
|
|
|
|
|
|
set_param => 'set', |
311
|
|
|
|
|
|
|
get_param => 'get', |
312
|
|
|
|
|
|
|
clear_params => 'clear', |
313
|
|
|
|
|
|
|
has_params => 'count', |
314
|
|
|
|
|
|
|
}, |
315
|
|
|
|
|
|
|
); |
316
|
|
|
|
|
|
|
sub submitted { shift->has_params } |
317
|
|
|
|
|
|
|
has 'dependency' => ( isa => 'ArrayRef', is => 'rw' ); |
318
|
|
|
|
|
|
|
has '_required' => ( |
319
|
|
|
|
|
|
|
traits => ['Array'], |
320
|
|
|
|
|
|
|
isa => 'ArrayRef[HTML::FormHandler::Field]', |
321
|
|
|
|
|
|
|
is => 'rw', |
322
|
|
|
|
|
|
|
default => sub { [] }, |
323
|
|
|
|
|
|
|
handles => { |
324
|
|
|
|
|
|
|
clear_required => 'clear', |
325
|
|
|
|
|
|
|
add_required => 'push', |
326
|
|
|
|
|
|
|
} |
327
|
|
|
|
|
|
|
); |
328
|
|
|
|
|
|
|
|
329
|
|
|
|
|
|
|
# these messages could apply to either fields or form |
330
|
|
|
|
|
|
|
has 'messages' => ( is => 'rw', |
331
|
|
|
|
|
|
|
isa => 'HashRef', |
332
|
|
|
|
|
|
|
traits => ['Hash'], |
333
|
|
|
|
|
|
|
builder => 'build_messages', |
334
|
|
|
|
|
|
|
handles => { |
335
|
|
|
|
|
|
|
'_get_form_message' => 'get', |
336
|
|
|
|
|
|
|
'_has_form_message' => 'exists', |
337
|
|
|
|
|
|
|
'set_message' => 'set', |
338
|
|
|
|
|
|
|
}, |
339
|
|
|
|
|
|
|
); |
340
|
|
|
|
|
|
|
sub build_messages { {} } |
341
|
|
|
|
|
|
|
|
342
|
|
|
|
|
|
|
my $class_messages = {}; |
343
|
|
|
|
|
|
|
sub get_class_messages { |
344
|
|
|
|
|
|
|
return $class_messages; |
345
|
|
|
|
|
|
|
} |
346
|
|
|
|
|
|
|
|
347
|
|
|
|
|
|
|
sub get_message { |
348
|
|
|
|
|
|
|
my ( $self, $msg ) = @_; |
349
|
|
|
|
|
|
|
return $self->_get_form_message($msg) if $self->_has_form_message($msg); |
350
|
|
|
|
|
|
|
return $self->get_class_messages->{$msg}; |
351
|
|
|
|
|
|
|
} |
352
|
|
|
|
|
|
|
sub all_messages { |
353
|
|
|
|
|
|
|
my $self = shift; |
354
|
|
|
|
|
|
|
return { %{$self->get_class_messages}, %{$self->messages} }; |
355
|
|
|
|
|
|
|
} |
356
|
|
|
|
|
|
|
|
357
|
|
|
|
|
|
|
has 'params_class' => ( |
358
|
|
|
|
|
|
|
is => 'ro', |
359
|
|
|
|
|
|
|
isa => LoadableClass, |
360
|
|
|
|
|
|
|
coerce => 1, |
361
|
|
|
|
|
|
|
default => 'HTML::FormHandler::Params', |
362
|
|
|
|
|
|
|
); |
363
|
|
|
|
|
|
|
|
364
|
|
|
|
|
|
|
has 'params_args' => ( is => 'ro', isa => 'ArrayRef' ); |
365
|
|
|
|
|
|
|
|
366
|
|
|
|
|
|
|
sub BUILDARGS { |
367
|
|
|
|
|
|
|
my $class = shift; |
368
|
|
|
|
|
|
|
|
369
|
|
|
|
|
|
|
if ( scalar @_ == 1 && ref( $_[0]) ne 'HASH' ) { |
370
|
|
|
|
|
|
|
my $arg = $_[0]; |
371
|
|
|
|
|
|
|
return blessed($arg) ? { item => $arg } : { item_id => $arg }; |
372
|
|
|
|
|
|
|
} |
373
|
|
|
|
|
|
|
return $class->SUPER::BUILDARGS(@_); |
374
|
|
|
|
|
|
|
} |
375
|
|
|
|
|
|
|
|
376
|
|
|
|
|
|
|
sub BUILD { |
377
|
|
|
|
|
|
|
my $self = shift; |
378
|
|
|
|
|
|
|
|
379
|
|
|
|
|
|
|
$self->before_build; # hook to allow customizing forms |
380
|
|
|
|
|
|
|
# HTML::FormHandler::Widget::Form::Simple is applied in Base |
381
|
|
|
|
|
|
|
$self->apply_widget_role( $self, $self->widget_form, 'Form' ) |
382
|
|
|
|
|
|
|
unless ( $self->no_widgets || $self->widget_form eq 'Simple' ); |
383
|
|
|
|
|
|
|
$self->_build_fields; # create the form fields (BuildFields.pm) |
384
|
|
|
|
|
|
|
$self->build_active if $self->has_active || $self->has_inactive || $self->has_flag('is_wizard'); |
385
|
|
|
|
|
|
|
$self->after_build; # hook for customizing |
386
|
|
|
|
|
|
|
return if defined $self->item_id && !$self->item; |
387
|
|
|
|
|
|
|
# Load values from object (if any) |
388
|
|
|
|
|
|
|
# Would rather not load results at all here, but skipping it breaks |
389
|
|
|
|
|
|
|
# existing apps that perform certain actions between 'new' and 'process'. |
390
|
|
|
|
|
|
|
# Added fudge flag no_preload to enable skipping. |
391
|
|
|
|
|
|
|
# A well-behaved program that always does ->process shouldn't need this preloading. |
392
|
|
|
|
|
|
|
unless( $self->no_preload ) { |
393
|
|
|
|
|
|
|
if ( my $init_object = $self->use_init_obj_over_item ? |
394
|
|
|
|
|
|
|
($self->init_object || $self->item) : ( $self->item || $self->init_object ) ) { |
395
|
|
|
|
|
|
|
$self->_result_from_object( $self->result, $init_object ); |
396
|
|
|
|
|
|
|
} |
397
|
|
|
|
|
|
|
else { |
398
|
|
|
|
|
|
|
$self->_result_from_fields( $self->result ); |
399
|
|
|
|
|
|
|
} |
400
|
|
|
|
|
|
|
} |
401
|
|
|
|
|
|
|
$self->dump_fields if $self->verbose; |
402
|
|
|
|
|
|
|
return; |
403
|
|
|
|
|
|
|
} |
404
|
|
|
|
|
|
|
sub before_build {} |
405
|
|
|
|
|
|
|
sub after_build {} |
406
|
|
|
|
|
|
|
|
407
|
|
|
|
|
|
|
sub process { |
408
|
|
|
|
|
|
|
my $self = shift; |
409
|
|
|
|
|
|
|
|
410
|
|
|
|
|
|
|
warn "HFH: process ", $self->name, "\n" if $self->verbose; |
411
|
|
|
|
|
|
|
$self->clear if $self->processed; |
412
|
|
|
|
|
|
|
$self->setup_form(@_); |
413
|
|
|
|
|
|
|
$self->validate_form if $self->posted; |
414
|
|
|
|
|
|
|
$self->update_model if ( $self->validated && !$self->no_update ); |
415
|
|
|
|
|
|
|
$self->after_update_model if ( $self->validated && !$self->no_update ); |
416
|
|
|
|
|
|
|
$self->dump_fields if $self->verbose; |
417
|
|
|
|
|
|
|
$self->processed(1); |
418
|
|
|
|
|
|
|
return $self->validated; |
419
|
|
|
|
|
|
|
} |
420
|
|
|
|
|
|
|
|
421
|
|
|
|
|
|
|
sub run { |
422
|
|
|
|
|
|
|
my $self = shift; |
423
|
|
|
|
|
|
|
$self->setup_form(@_); |
424
|
|
|
|
|
|
|
$self->validate_form if $self->posted; |
425
|
|
|
|
|
|
|
$self->update_model if ( $self->validated && !$self->no_update );; |
426
|
|
|
|
|
|
|
my $result = $self->result; |
427
|
|
|
|
|
|
|
$self->clear; |
428
|
|
|
|
|
|
|
return $result; |
429
|
|
|
|
|
|
|
} |
430
|
|
|
|
|
|
|
|
431
|
|
|
|
|
|
|
sub after_update_model { |
432
|
|
|
|
|
|
|
my $self = shift; |
433
|
|
|
|
|
|
|
# This an attempt to reload the repeatable |
434
|
|
|
|
|
|
|
# relationships after the database is updated, so that we get the |
435
|
|
|
|
|
|
|
# primary keys of the repeatable elements. Otherwise, if a form |
436
|
|
|
|
|
|
|
# is re-presented, repeatable elements without primary keys may |
437
|
|
|
|
|
|
|
# be created again. There is no reliable way to connect up |
438
|
|
|
|
|
|
|
# existing repeatable elements with their db-created primary keys. |
439
|
|
|
|
|
|
|
if ( $self->has_repeatable_fields && $self->item ) { |
440
|
|
|
|
|
|
|
foreach my $field ( $self->all_repeatable_fields ) { |
441
|
|
|
|
|
|
|
next unless $field->is_active; |
442
|
|
|
|
|
|
|
# Check to see if there are any repeatable subfields with |
443
|
|
|
|
|
|
|
# null primary keys, so we can skip reloading for the case |
444
|
|
|
|
|
|
|
# where all repeatables have primary keys. |
445
|
|
|
|
|
|
|
my $needs_reload = 0; |
446
|
|
|
|
|
|
|
foreach my $sub_field ( $field->fields ) { |
447
|
|
|
|
|
|
|
if ( $sub_field->has_flag('is_compound') && $sub_field->has_primary_key ) { |
448
|
|
|
|
|
|
|
foreach my $pk_field ( @{ $sub_field->primary_key } ) { |
449
|
|
|
|
|
|
|
$needs_reload++ unless $pk_field->fif; |
450
|
|
|
|
|
|
|
} |
451
|
|
|
|
|
|
|
last if $needs_reload; |
452
|
|
|
|
|
|
|
} |
453
|
|
|
|
|
|
|
} |
454
|
|
|
|
|
|
|
next unless $needs_reload; |
455
|
|
|
|
|
|
|
my @names = split( /\./, $field->full_name ); |
456
|
|
|
|
|
|
|
my $rep_item = $self->find_sub_item( $self->item, \@names ); |
457
|
|
|
|
|
|
|
# $rep_item is a single row or an array of rows or undef |
458
|
|
|
|
|
|
|
# If we found a database item for the repeatable, replace |
459
|
|
|
|
|
|
|
# the existing result with a result derived from the item. |
460
|
|
|
|
|
|
|
if ( ref $rep_item ) { |
461
|
|
|
|
|
|
|
my $parent = $field->parent; |
462
|
|
|
|
|
|
|
my $result = $field->result; |
463
|
|
|
|
|
|
|
$field->init_state; |
464
|
|
|
|
|
|
|
my $new_result = $field->_result_from_object( $result, $rep_item ); |
465
|
|
|
|
|
|
|
# find index of existing result |
466
|
|
|
|
|
|
|
my $index = $parent->result->find_result_index( sub { $_ == $result } ); |
467
|
|
|
|
|
|
|
# replace existing result with new result |
468
|
|
|
|
|
|
|
$parent->result->set_result_at_index( $index, $new_result ); |
469
|
|
|
|
|
|
|
} |
470
|
|
|
|
|
|
|
} |
471
|
|
|
|
|
|
|
} |
472
|
|
|
|
|
|
|
} |
473
|
|
|
|
|
|
|
|
474
|
|
|
|
|
|
|
|
475
|
|
|
|
|
|
|
sub db_validate { |
476
|
|
|
|
|
|
|
my $self = shift; |
477
|
|
|
|
|
|
|
my $fif = $self->fif; |
478
|
|
|
|
|
|
|
$self->process($fif); |
479
|
|
|
|
|
|
|
return $self->validated; |
480
|
|
|
|
|
|
|
} |
481
|
|
|
|
|
|
|
|
482
|
|
|
|
|
|
|
sub clear { |
483
|
|
|
|
|
|
|
my $self = shift; |
484
|
|
|
|
|
|
|
$self->clear_data; |
485
|
|
|
|
|
|
|
$self->clear_params; |
486
|
|
|
|
|
|
|
$self->clear_posted; |
487
|
|
|
|
|
|
|
$self->clear_item; |
488
|
|
|
|
|
|
|
$self->clear_init_object; |
489
|
|
|
|
|
|
|
$self->clear_ctx; |
490
|
|
|
|
|
|
|
$self->processed(0); |
491
|
|
|
|
|
|
|
$self->did_init_obj(0); |
492
|
|
|
|
|
|
|
$self->clear_result; |
493
|
|
|
|
|
|
|
$self->clear_use_defaults_over_obj; |
494
|
|
|
|
|
|
|
$self->clear_use_init_obj_over_item; |
495
|
|
|
|
|
|
|
$self->clear_no_update; |
496
|
|
|
|
|
|
|
$self->clear_info_message; |
497
|
|
|
|
|
|
|
$self->clear_for_js; |
498
|
|
|
|
|
|
|
} |
499
|
|
|
|
|
|
|
|
500
|
|
|
|
|
|
|
sub values { shift->value } |
501
|
|
|
|
|
|
|
|
502
|
|
|
|
|
|
|
# deprecated? |
503
|
|
|
|
|
|
|
sub error_field_names { |
504
|
|
|
|
|
|
|
my $self = shift; |
505
|
|
|
|
|
|
|
my @error_fields = $self->error_fields; |
506
|
|
|
|
|
|
|
return map { $_->name } @error_fields; |
507
|
|
|
|
|
|
|
} |
508
|
|
|
|
|
|
|
|
509
|
|
|
|
|
|
|
sub errors { |
510
|
|
|
|
|
|
|
my $self = shift; |
511
|
|
|
|
|
|
|
my @error_fields = $self->error_fields; |
512
|
|
|
|
|
|
|
my @errors = $self->all_form_errors; |
513
|
|
|
|
|
|
|
push @errors, map { $_->all_errors } @error_fields; |
514
|
|
|
|
|
|
|
return @errors; |
515
|
|
|
|
|
|
|
} |
516
|
|
|
|
|
|
|
|
517
|
|
|
|
|
|
|
sub errors_by_id { |
518
|
|
|
|
|
|
|
my $self = shift; |
519
|
|
|
|
|
|
|
my %errors; |
520
|
|
|
|
|
|
|
$errors{$_->id} = [$_->all_errors] for $self->error_fields; |
521
|
|
|
|
|
|
|
return \%errors; |
522
|
|
|
|
|
|
|
} |
523
|
|
|
|
|
|
|
|
524
|
|
|
|
|
|
|
sub errors_by_name { |
525
|
|
|
|
|
|
|
my $self = shift; |
526
|
|
|
|
|
|
|
my %errors; |
527
|
|
|
|
|
|
|
$errors{$_->html_name} = [$_->all_errors] for $self->error_fields; |
528
|
|
|
|
|
|
|
return \%errors; |
529
|
|
|
|
|
|
|
} |
530
|
|
|
|
|
|
|
|
531
|
|
|
|
|
|
|
sub build_errors { |
532
|
|
|
|
|
|
|
my $self = shift; |
533
|
|
|
|
|
|
|
# this puts the errors in the result |
534
|
|
|
|
|
|
|
foreach my $err_res (@{$self->result->error_results}) { |
535
|
|
|
|
|
|
|
$self->result->_push_errors($err_res->all_errors); |
536
|
|
|
|
|
|
|
} |
537
|
|
|
|
|
|
|
} |
538
|
|
|
|
|
|
|
|
539
|
|
|
|
|
|
|
sub uuid { |
540
|
|
|
|
|
|
|
my $form = shift; |
541
|
|
|
|
|
|
|
require Data::UUID; |
542
|
|
|
|
|
|
|
my $uuid = Data::UUID->new->create_str; |
543
|
|
|
|
|
|
|
return qq[<input type="hidden" name="form_uuid" value="$uuid">]; |
544
|
|
|
|
|
|
|
} |
545
|
|
|
|
|
|
|
|
546
|
|
|
|
|
|
|
sub validate_form { |
547
|
|
|
|
|
|
|
my $self = shift; |
548
|
|
|
|
|
|
|
my $params = $self->params; |
549
|
|
|
|
|
|
|
$self->_set_dependency; # set required dependencies |
550
|
|
|
|
|
|
|
$self->_fields_validate; |
551
|
|
|
|
|
|
|
$self->validate; # empty method for users |
552
|
|
|
|
|
|
|
$self->validate_model; # model specific validation |
553
|
|
|
|
|
|
|
$self->fields_set_value; |
554
|
|
|
|
|
|
|
$self->build_errors; # move errors to result |
555
|
|
|
|
|
|
|
$self->_clear_dependency; |
556
|
|
|
|
|
|
|
$self->clear_posted; |
557
|
|
|
|
|
|
|
$self->ran_validation(1); |
558
|
|
|
|
|
|
|
$self->dump_validated if $self->verbose; |
559
|
|
|
|
|
|
|
return $self->validated; |
560
|
|
|
|
|
|
|
} |
561
|
|
|
|
|
|
|
|
562
|
|
|
|
|
|
|
sub validate { 1 } |
563
|
|
|
|
|
|
|
|
564
|
|
|
|
|
|
|
sub has_errors { |
565
|
|
|
|
|
|
|
my $self = shift; |
566
|
|
|
|
|
|
|
return $self->has_error_fields || $self->has_form_errors; |
567
|
|
|
|
|
|
|
} |
568
|
|
|
|
|
|
|
sub num_errors { |
569
|
|
|
|
|
|
|
my $self = shift; |
570
|
|
|
|
|
|
|
return $self->num_error_fields + $self->num_form_errors; |
571
|
|
|
|
|
|
|
} |
572
|
|
|
|
|
|
|
|
573
|
|
|
|
|
|
|
sub setup_form { |
574
|
|
|
|
|
|
|
my ( $self, @args ) = @_; |
575
|
|
|
|
|
|
|
if ( @args == 1 ) { |
576
|
|
|
|
|
|
|
$self->params( $args[0] ); |
577
|
|
|
|
|
|
|
} |
578
|
|
|
|
|
|
|
elsif ( @args > 1 ) { |
579
|
|
|
|
|
|
|
my $hashref = {@args}; |
580
|
|
|
|
|
|
|
while ( my ( $key, $value ) = each %{$hashref} ) { |
581
|
|
|
|
|
|
|
confess "invalid attribute '$key' passed to setup_form" |
582
|
|
|
|
|
|
|
unless $self->can($key); |
583
|
|
|
|
|
|
|
$self->$key($value); |
584
|
|
|
|
|
|
|
} |
585
|
|
|
|
|
|
|
} |
586
|
|
|
|
|
|
|
if ( $self->item_id && !$self->item ) { |
587
|
|
|
|
|
|
|
$self->item( $self->build_item ); |
588
|
|
|
|
|
|
|
} |
589
|
|
|
|
|
|
|
$self->clear_result; |
590
|
|
|
|
|
|
|
$self->set_active; |
591
|
|
|
|
|
|
|
$self->update_fields; |
592
|
|
|
|
|
|
|
# initialization of Repeatable fields and Select options |
593
|
|
|
|
|
|
|
# will be done in _result_from_object when there's an initial object |
594
|
|
|
|
|
|
|
# in _result_from_input when there are params |
595
|
|
|
|
|
|
|
# and by _result_from_fields for empty forms |
596
|
|
|
|
|
|
|
$self->posted(1) if ( $self->has_params && !$self->has_posted ); |
597
|
|
|
|
|
|
|
if ( !$self->did_init_obj ) { |
598
|
|
|
|
|
|
|
if ( my $init_object = $self->use_init_obj_over_item ? |
599
|
|
|
|
|
|
|
($self->init_object || $self->item) : ( $self->item || $self->init_object ) ) { |
600
|
|
|
|
|
|
|
$self->_result_from_object( $self->result, $init_object ); |
601
|
|
|
|
|
|
|
} |
602
|
|
|
|
|
|
|
elsif ( !$self->posted ) { |
603
|
|
|
|
|
|
|
# no initial object. empty form must be initialized |
604
|
|
|
|
|
|
|
$self->_result_from_fields( $self->result ); |
605
|
|
|
|
|
|
|
} |
606
|
|
|
|
|
|
|
} |
607
|
|
|
|
|
|
|
# if params exist and if posted flag is either not set or set to true |
608
|
|
|
|
|
|
|
my $params = clone( $self->params ); |
609
|
|
|
|
|
|
|
if ( $self->posted ) { |
610
|
|
|
|
|
|
|
$self->clear_result; |
611
|
|
|
|
|
|
|
$self->_result_from_input( $self->result, $params, 1 ); |
612
|
|
|
|
|
|
|
} |
613
|
|
|
|
|
|
|
|
614
|
|
|
|
|
|
|
} |
615
|
|
|
|
|
|
|
|
616
|
|
|
|
|
|
|
# if active => [...] is set at process time, set 'active' flag |
617
|
|
|
|
|
|
|
sub set_active { |
618
|
|
|
|
|
|
|
my $self = shift; |
619
|
|
|
|
|
|
|
if( $self->has_active ) { |
620
|
|
|
|
|
|
|
foreach my $fname (@{$self->active}) { |
621
|
|
|
|
|
|
|
my $field = $self->field($fname); |
622
|
|
|
|
|
|
|
if ( $field ) { |
623
|
|
|
|
|
|
|
$field->_active(1); |
624
|
|
|
|
|
|
|
} |
625
|
|
|
|
|
|
|
else { |
626
|
|
|
|
|
|
|
warn "field $fname not found to set active"; |
627
|
|
|
|
|
|
|
} |
628
|
|
|
|
|
|
|
} |
629
|
|
|
|
|
|
|
$self->clear_active; |
630
|
|
|
|
|
|
|
} |
631
|
|
|
|
|
|
|
if( $self->has_inactive ) { |
632
|
|
|
|
|
|
|
foreach my $fname (@{$self->inactive}) { |
633
|
|
|
|
|
|
|
my $field = $self->field($fname); |
634
|
|
|
|
|
|
|
if ( $field ) { |
635
|
|
|
|
|
|
|
$field->_active(0); |
636
|
|
|
|
|
|
|
} |
637
|
|
|
|
|
|
|
else { |
638
|
|
|
|
|
|
|
warn "field $fname not found to set inactive"; |
639
|
|
|
|
|
|
|
} |
640
|
|
|
|
|
|
|
} |
641
|
|
|
|
|
|
|
$self->clear_inactive; |
642
|
|
|
|
|
|
|
} |
643
|
|
|
|
|
|
|
} |
644
|
|
|
|
|
|
|
|
645
|
|
|
|
|
|
|
# if active => [...] is set at build time, remove 'inactive' flags |
646
|
|
|
|
|
|
|
sub build_active { |
647
|
|
|
|
|
|
|
my $self = shift; |
648
|
|
|
|
|
|
|
if( $self->has_active ) { |
649
|
|
|
|
|
|
|
foreach my $fname (@{$self->active}) { |
650
|
|
|
|
|
|
|
my $field = $self->field($fname); |
651
|
|
|
|
|
|
|
if( $field ) { |
652
|
|
|
|
|
|
|
$field->clear_inactive; |
653
|
|
|
|
|
|
|
} |
654
|
|
|
|
|
|
|
else { |
655
|
|
|
|
|
|
|
warn "field $fname not found to set active"; |
656
|
|
|
|
|
|
|
} |
657
|
|
|
|
|
|
|
} |
658
|
|
|
|
|
|
|
$self->clear_active; |
659
|
|
|
|
|
|
|
} |
660
|
|
|
|
|
|
|
if( $self->has_inactive ) { |
661
|
|
|
|
|
|
|
foreach my $fname (@{$self->inactive}) { |
662
|
|
|
|
|
|
|
my $field = $self->field($fname); |
663
|
|
|
|
|
|
|
if( $field ) { |
664
|
|
|
|
|
|
|
$field->inactive(1); |
665
|
|
|
|
|
|
|
} |
666
|
|
|
|
|
|
|
else { |
667
|
|
|
|
|
|
|
warn "field $fname not found to set inactive"; |
668
|
|
|
|
|
|
|
} |
669
|
|
|
|
|
|
|
} |
670
|
|
|
|
|
|
|
$self->clear_inactive; |
671
|
|
|
|
|
|
|
} |
672
|
|
|
|
|
|
|
} |
673
|
|
|
|
|
|
|
|
674
|
|
|
|
|
|
|
sub fif { shift->fields_fif(@_) } |
675
|
|
|
|
|
|
|
|
676
|
|
|
|
|
|
|
# this is subclassed by the model, which may |
677
|
|
|
|
|
|
|
# do a lot more than this |
678
|
|
|
|
|
|
|
sub init_value { |
679
|
|
|
|
|
|
|
my ( $self, $field, $value ) = @_; |
680
|
|
|
|
|
|
|
$field->init_value($value); |
681
|
|
|
|
|
|
|
$field->_set_value($value); |
682
|
|
|
|
|
|
|
} |
683
|
|
|
|
|
|
|
|
684
|
|
|
|
|
|
|
sub _set_dependency { |
685
|
|
|
|
|
|
|
my $self = shift; |
686
|
|
|
|
|
|
|
|
687
|
|
|
|
|
|
|
my $depends = $self->dependency || return; |
688
|
|
|
|
|
|
|
my $params = $self->params; |
689
|
|
|
|
|
|
|
for my $group (@$depends) { |
690
|
|
|
|
|
|
|
next if @$group < 2; |
691
|
|
|
|
|
|
|
# process a group of fields |
692
|
|
|
|
|
|
|
for my $name (@$group) { |
693
|
|
|
|
|
|
|
# is there a value? |
694
|
|
|
|
|
|
|
my $value = $params->{$name}; |
695
|
|
|
|
|
|
|
next unless defined $value; |
696
|
|
|
|
|
|
|
# The exception is a boolean can be zero which we count as not set. |
697
|
|
|
|
|
|
|
# This is to allow requiring a field when a boolean is true. |
698
|
|
|
|
|
|
|
my $field = $self->field($name); |
699
|
|
|
|
|
|
|
next if $self->field($name)->type eq 'Boolean' && $value == 0; |
700
|
|
|
|
|
|
|
next unless HTML::FormHandler::Field::has_some_value($value); |
701
|
|
|
|
|
|
|
# one field was found non-blank, so set all to required |
702
|
|
|
|
|
|
|
for (@$group) { |
703
|
|
|
|
|
|
|
my $field = $self->field($_); |
704
|
|
|
|
|
|
|
next unless $field && !$field->required; |
705
|
|
|
|
|
|
|
$self->add_required($field); # save for clearing later. |
706
|
|
|
|
|
|
|
$field->required(1); |
707
|
|
|
|
|
|
|
} |
708
|
|
|
|
|
|
|
last; |
709
|
|
|
|
|
|
|
} |
710
|
|
|
|
|
|
|
} |
711
|
|
|
|
|
|
|
} |
712
|
|
|
|
|
|
|
|
713
|
|
|
|
|
|
|
sub _clear_dependency { |
714
|
|
|
|
|
|
|
my $self = shift; |
715
|
|
|
|
|
|
|
|
716
|
|
|
|
|
|
|
$_->required(0) for @{$self->_required}; |
717
|
|
|
|
|
|
|
$self->clear_required; |
718
|
|
|
|
|
|
|
} |
719
|
|
|
|
|
|
|
|
720
|
|
|
|
|
|
|
sub peek { |
721
|
|
|
|
|
|
|
my $self = shift; |
722
|
|
|
|
|
|
|
my $string = "Form " . $self->name . "\n"; |
723
|
|
|
|
|
|
|
my $indent = ' '; |
724
|
|
|
|
|
|
|
foreach my $field ( $self->sorted_fields ) { |
725
|
|
|
|
|
|
|
$string .= $field->peek( $indent ); |
726
|
|
|
|
|
|
|
} |
727
|
|
|
|
|
|
|
return $string; |
728
|
|
|
|
|
|
|
} |
729
|
|
|
|
|
|
|
|
730
|
|
|
|
|
|
|
sub _munge_params { |
731
|
|
|
|
|
|
|
my ( $self, $params, $attr ) = @_; |
732
|
|
|
|
|
|
|
my $_fix_params = $self->params_class->new( @{ $self->params_args || [] } ); |
733
|
|
|
|
|
|
|
my $new_params = $_fix_params->expand_hash($params); |
734
|
|
|
|
|
|
|
if ( $self->html_prefix ) { |
735
|
|
|
|
|
|
|
$new_params = $new_params->{ $self->name }; |
736
|
|
|
|
|
|
|
} |
737
|
|
|
|
|
|
|
$new_params = {} if !defined $new_params; |
738
|
|
|
|
|
|
|
$self->{params} = $new_params; |
739
|
|
|
|
|
|
|
} |
740
|
|
|
|
|
|
|
|
741
|
|
|
|
|
|
|
sub params_to_values { |
742
|
|
|
|
|
|
|
my ( $self, $params ) = @_; |
743
|
|
|
|
|
|
|
my $_fix_params = $self->params_class->new( @{ $self->params_args || [] } ); |
744
|
|
|
|
|
|
|
my $new_params = $_fix_params->expand_hash($params); |
745
|
|
|
|
|
|
|
return $new_params; |
746
|
|
|
|
|
|
|
} |
747
|
|
|
|
|
|
|
|
748
|
|
|
|
|
|
|
sub add_form_error { |
749
|
|
|
|
|
|
|
my ( $self, @message ) = @_; |
750
|
|
|
|
|
|
|
|
751
|
|
|
|
|
|
|
unless ( defined $message[0] ) { |
752
|
|
|
|
|
|
|
@message = ('form is invalid'); |
753
|
|
|
|
|
|
|
} |
754
|
|
|
|
|
|
|
my $out; |
755
|
|
|
|
|
|
|
try { |
756
|
|
|
|
|
|
|
$out = $self->_localize(@message); |
757
|
|
|
|
|
|
|
} |
758
|
|
|
|
|
|
|
catch { |
759
|
|
|
|
|
|
|
die "Error occurred localizing error message for " . $self->name . ". $_"; |
760
|
|
|
|
|
|
|
}; |
761
|
|
|
|
|
|
|
$self->push_form_errors($out); |
762
|
|
|
|
|
|
|
return; |
763
|
|
|
|
|
|
|
} |
764
|
|
|
|
|
|
|
|
765
|
|
|
|
|
|
|
sub get_default_value { } |
766
|
|
|
|
|
|
|
sub _can_deflate { } |
767
|
|
|
|
|
|
|
|
768
|
|
|
|
|
|
|
sub update_fields { |
769
|
|
|
|
|
|
|
my $self = shift; |
770
|
|
|
|
|
|
|
if( $self->has_update_field_list ) { |
771
|
|
|
|
|
|
|
my $updates = $self->update_field_list; |
772
|
|
|
|
|
|
|
foreach my $field_name ( keys %{$updates} ) { |
773
|
|
|
|
|
|
|
$self->update_field($field_name, $updates->{$field_name} ); |
774
|
|
|
|
|
|
|
} |
775
|
|
|
|
|
|
|
$self->clear_update_field_list; |
776
|
|
|
|
|
|
|
} |
777
|
|
|
|
|
|
|
if( $self->has_defaults ) { |
778
|
|
|
|
|
|
|
my $defaults = $self->defaults; |
779
|
|
|
|
|
|
|
foreach my $field_name ( keys %{$defaults} ) { |
780
|
|
|
|
|
|
|
$self->update_field($field_name, { default => $defaults->{$field_name} } ); |
781
|
|
|
|
|
|
|
} |
782
|
|
|
|
|
|
|
$self->clear_defaults; |
783
|
|
|
|
|
|
|
} |
784
|
|
|
|
|
|
|
} |
785
|
|
|
|
|
|
|
|
786
|
|
|
|
|
|
|
sub update_field { |
787
|
|
|
|
|
|
|
my ( $self, $field_name, $updates ) = @_; |
788
|
|
|
|
|
|
|
|
789
|
|
|
|
|
|
|
my $field = $self->field($field_name); |
790
|
|
|
|
|
|
|
unless( $field ) { |
791
|
|
|
|
|
|
|
die "Field $field_name is not found and cannot be updated by update_fields"; |
792
|
|
|
|
|
|
|
} |
793
|
|
|
|
|
|
|
while ( my ( $attr_name, $attr_value ) = each %{$updates} ) { |
794
|
|
|
|
|
|
|
confess "invalid attribute '$attr_name' passed to update_field" |
795
|
|
|
|
|
|
|
unless $field->can($attr_name); |
796
|
|
|
|
|
|
|
if( $attr_name eq 'tags' ) { |
797
|
|
|
|
|
|
|
$field->set_tag(%$attr_value); |
798
|
|
|
|
|
|
|
} |
799
|
|
|
|
|
|
|
else { |
800
|
|
|
|
|
|
|
$field->$attr_name($attr_value); |
801
|
|
|
|
|
|
|
} |
802
|
|
|
|
|
|
|
} |
803
|
|
|
|
|
|
|
} |
804
|
|
|
|
|
|
|
|
805
|
|
|
|
|
|
|
|
806
|
|
|
|
|
|
|
__PACKAGE__->meta->make_immutable; |
807
|
|
|
|
|
|
|
use namespace::autoclean; |
808
|
|
|
|
|
|
|
1; |
809
|
|
|
|
|
|
|
|
810
|
|
|
|
|
|
|
__END__ |
811
|
|
|
|
|
|
|
|
812
|
|
|
|
|
|
|
=pod |
813
|
|
|
|
|
|
|
|
814
|
|
|
|
|
|
|
=encoding UTF-8 |
815
|
|
|
|
|
|
|
|
816
|
|
|
|
|
|
|
=head1 NAME |
817
|
|
|
|
|
|
|
|
818
|
|
|
|
|
|
|
HTML::FormHandler - HTML forms using Moose |
819
|
|
|
|
|
|
|
|
820
|
|
|
|
|
|
|
=head1 VERSION |
821
|
|
|
|
|
|
|
|
822
|
|
|
|
|
|
|
version 0.40057 |
823
|
|
|
|
|
|
|
|
824
|
|
|
|
|
|
|
=head1 SYNOPSIS |
825
|
|
|
|
|
|
|
|
826
|
|
|
|
|
|
|
See the manual at L<HTML::FormHandler::Manual>. |
827
|
|
|
|
|
|
|
|
828
|
|
|
|
|
|
|
use HTML::FormHandler; # or a custom form: use MyApp::Form::User; |
829
|
|
|
|
|
|
|
my $form = HTML::FormHandler->new( .... ); |
830
|
|
|
|
|
|
|
$form->process( params => $params ); |
831
|
|
|
|
|
|
|
my $rendered_form = $form->render; |
832
|
|
|
|
|
|
|
if( $form->validated ) { |
833
|
|
|
|
|
|
|
# perform validated form actions |
834
|
|
|
|
|
|
|
} |
835
|
|
|
|
|
|
|
else { |
836
|
|
|
|
|
|
|
# perform non-validated actions |
837
|
|
|
|
|
|
|
} |
838
|
|
|
|
|
|
|
|
839
|
|
|
|
|
|
|
Or, if you want to use a form 'result' (which contains only the form |
840
|
|
|
|
|
|
|
values and error messages) instead: |
841
|
|
|
|
|
|
|
|
842
|
|
|
|
|
|
|
use MyApp::Form; # or a generic form: use HTML::FormHandler; |
843
|
|
|
|
|
|
|
my $form = MyApp::Form->new( .... ); |
844
|
|
|
|
|
|
|
my $result = $form->run( params => $params ); |
845
|
|
|
|
|
|
|
if( $result->validated ) { |
846
|
|
|
|
|
|
|
# perform validated form actions |
847
|
|
|
|
|
|
|
} |
848
|
|
|
|
|
|
|
else { |
849
|
|
|
|
|
|
|
# perform non-validated actions |
850
|
|
|
|
|
|
|
$result->render; |
851
|
|
|
|
|
|
|
} |
852
|
|
|
|
|
|
|
|
853
|
|
|
|
|
|
|
An example of a custom form class: |
854
|
|
|
|
|
|
|
|
855
|
|
|
|
|
|
|
package MyApp::Form::User; |
856
|
|
|
|
|
|
|
|
857
|
|
|
|
|
|
|
use HTML::FormHandler::Moose; |
858
|
|
|
|
|
|
|
extends 'HTML::FormHandler'; |
859
|
|
|
|
|
|
|
use Moose::Util::TypeConstraints; |
860
|
|
|
|
|
|
|
|
861
|
|
|
|
|
|
|
has '+item_class' => ( default => 'User' ); |
862
|
|
|
|
|
|
|
|
863
|
|
|
|
|
|
|
has_field 'name' => ( type => 'Text' ); |
864
|
|
|
|
|
|
|
has_field 'age' => ( type => 'PosInteger', apply => [ 'MinimumAge' ] ); |
865
|
|
|
|
|
|
|
has_field 'birthdate' => ( type => 'DateTime' ); |
866
|
|
|
|
|
|
|
has_field 'birthdate.month' => ( type => 'Month' ); |
867
|
|
|
|
|
|
|
has_field 'birthdate.day' => ( type => 'MonthDay' ); |
868
|
|
|
|
|
|
|
has_field 'birthdate.year' => ( type => 'Year' ); |
869
|
|
|
|
|
|
|
has_field 'hobbies' => ( type => 'Multiple' ); |
870
|
|
|
|
|
|
|
has_field 'address' => ( type => 'Text' ); |
871
|
|
|
|
|
|
|
has_field 'city' => ( type => 'Text' ); |
872
|
|
|
|
|
|
|
has_field 'state' => ( type => 'Select' ); |
873
|
|
|
|
|
|
|
has_field 'email' => ( type => 'Email' ); |
874
|
|
|
|
|
|
|
|
875
|
|
|
|
|
|
|
has '+dependency' => ( default => sub { |
876
|
|
|
|
|
|
|
[ ['address', 'city', 'state'], ] |
877
|
|
|
|
|
|
|
} |
878
|
|
|
|
|
|
|
); |
879
|
|
|
|
|
|
|
|
880
|
|
|
|
|
|
|
subtype 'MinimumAge' |
881
|
|
|
|
|
|
|
=> as 'Int' |
882
|
|
|
|
|
|
|
=> where { $_ > 13 } |
883
|
|
|
|
|
|
|
=> message { "You are not old enough to register" }; |
884
|
|
|
|
|
|
|
|
885
|
|
|
|
|
|
|
no HTML::FormHandler::Moose; |
886
|
|
|
|
|
|
|
1; |
887
|
|
|
|
|
|
|
|
888
|
|
|
|
|
|
|
A dynamic form - one that does not use a custom form class - may be |
889
|
|
|
|
|
|
|
created using the 'field_list' attribute to set fields: |
890
|
|
|
|
|
|
|
|
891
|
|
|
|
|
|
|
my $form = HTML::FormHandler->new( |
892
|
|
|
|
|
|
|
name => 'user_form', |
893
|
|
|
|
|
|
|
item => $user, |
894
|
|
|
|
|
|
|
field_list => [ |
895
|
|
|
|
|
|
|
'username' => { |
896
|
|
|
|
|
|
|
type => 'Text', |
897
|
|
|
|
|
|
|
apply => [ { check => qr/^[0-9a-z]*\z/, |
898
|
|
|
|
|
|
|
message => 'Contains invalid characters' } ], |
899
|
|
|
|
|
|
|
}, |
900
|
|
|
|
|
|
|
'select_bar' => { |
901
|
|
|
|
|
|
|
type => 'Select', |
902
|
|
|
|
|
|
|
options => \@select_options, |
903
|
|
|
|
|
|
|
multiple => 1, |
904
|
|
|
|
|
|
|
size => 4, |
905
|
|
|
|
|
|
|
}, |
906
|
|
|
|
|
|
|
], |
907
|
|
|
|
|
|
|
); |
908
|
|
|
|
|
|
|
|
909
|
|
|
|
|
|
|
FormHandler does not provide a custom controller for Catalyst because |
910
|
|
|
|
|
|
|
it isn't necessary. Interfacing to FormHandler is only a couple of |
911
|
|
|
|
|
|
|
lines of code. See L<HTML::FormHandler::Manual::Catalyst> for more |
912
|
|
|
|
|
|
|
details, or L<Catalyst::Manual::Tutorial::09_AdvancedCRUD::09_FormHandler>. |
913
|
|
|
|
|
|
|
|
914
|
|
|
|
|
|
|
=head1 DESCRIPTION |
915
|
|
|
|
|
|
|
|
916
|
|
|
|
|
|
|
*** Although documentation in this file provides some overview, it is mainly |
917
|
|
|
|
|
|
|
intended for API documentation. See L<HTML::FormHandler::Manual::Intro> |
918
|
|
|
|
|
|
|
for an introduction, with links to other documentation. |
919
|
|
|
|
|
|
|
|
920
|
|
|
|
|
|
|
HTML::FormHandler maintains a clean separation between form construction |
921
|
|
|
|
|
|
|
and form rendering. It allows you to define your forms and fields in a |
922
|
|
|
|
|
|
|
number of flexible ways. Although it provides renderers for HTML, you |
923
|
|
|
|
|
|
|
can define custom renderers for any kind of presentation. |
924
|
|
|
|
|
|
|
|
925
|
|
|
|
|
|
|
HTML::FormHandler allows you to define form fields and validators. It can |
926
|
|
|
|
|
|
|
be used for both database and non-database forms, and will |
927
|
|
|
|
|
|
|
automatically update or create rows in a database. It can be used |
928
|
|
|
|
|
|
|
to process structured data that doesn't come from an HTML form. |
929
|
|
|
|
|
|
|
|
930
|
|
|
|
|
|
|
One of its goals is to keep the controller/application program interface as |
931
|
|
|
|
|
|
|
simple as possible, and to minimize the duplication of code. In most cases, |
932
|
|
|
|
|
|
|
interfacing your controller to your form is only a few lines of code. |
933
|
|
|
|
|
|
|
|
934
|
|
|
|
|
|
|
With FormHandler you shouldn't have to spend hours trying to figure out how to make a |
935
|
|
|
|
|
|
|
simple HTML change that would take one minute by hand. Because you _can_ do it |
936
|
|
|
|
|
|
|
by hand. Or you can automate HTML generation as much as you want, with |
937
|
|
|
|
|
|
|
template widgets or pure Perl rendering classes, and stay completely in |
938
|
|
|
|
|
|
|
control of what, where, and how much is done automatically. You can define |
939
|
|
|
|
|
|
|
custom renderers and display your rendered forms however you want. |
940
|
|
|
|
|
|
|
|
941
|
|
|
|
|
|
|
You can split the pieces of your forms up into logical parts and compose |
942
|
|
|
|
|
|
|
complete forms from FormHandler classes, roles, fields, collections of |
943
|
|
|
|
|
|
|
validations, transformations and Moose type constraints. |
944
|
|
|
|
|
|
|
You can write custom methods to process forms, add any attribute you like, |
945
|
|
|
|
|
|
|
and use Moose method modifiers. FormHandler forms are Perl classes, so there's |
946
|
|
|
|
|
|
|
a lot of flexibility in what you can do. |
947
|
|
|
|
|
|
|
|
948
|
|
|
|
|
|
|
HTML::FormHandler provides rendering through roles which are applied to |
949
|
|
|
|
|
|
|
form and field classes (although there's no reason you couldn't write |
950
|
|
|
|
|
|
|
a renderer as an external object either). There are currently two flavors: |
951
|
|
|
|
|
|
|
all-in-one solutions like L<HTML::FormHandler::Render::Simple> and |
952
|
|
|
|
|
|
|
L<HTML::FormHandler::Render::Table> that contain methods for rendering |
953
|
|
|
|
|
|
|
field widget classes, and the L<HTML::FormHandler::Widget> roles, which are |
954
|
|
|
|
|
|
|
more atomic roles which are automatically applied to fields and form. See |
955
|
|
|
|
|
|
|
L<HTML::FormHandler::Manual::Rendering> for more details. |
956
|
|
|
|
|
|
|
(And you can easily use hand-built forms - FormHandler doesn't care.) |
957
|
|
|
|
|
|
|
|
958
|
|
|
|
|
|
|
The typical application for FormHandler would be in a Catalyst, DBIx::Class, |
959
|
|
|
|
|
|
|
Template Toolkit web application, but use is not limited to that. FormHandler |
960
|
|
|
|
|
|
|
can be used in any Perl application. |
961
|
|
|
|
|
|
|
|
962
|
|
|
|
|
|
|
More Formhandler documentation and a tutorial can be found in the manual |
963
|
|
|
|
|
|
|
at L<HTML::FormHandler::Manual>. |
964
|
|
|
|
|
|
|
|
965
|
|
|
|
|
|
|
=head1 ATTRIBUTES and METHODS |
966
|
|
|
|
|
|
|
|
967
|
|
|
|
|
|
|
=head2 Creating a form with 'new' |
968
|
|
|
|
|
|
|
|
969
|
|
|
|
|
|
|
The new constructor takes name/value pairs: |
970
|
|
|
|
|
|
|
|
971
|
|
|
|
|
|
|
MyForm->new( |
972
|
|
|
|
|
|
|
item => $item, |
973
|
|
|
|
|
|
|
); |
974
|
|
|
|
|
|
|
|
975
|
|
|
|
|
|
|
No attributes are required on new. The form's fields will be built from |
976
|
|
|
|
|
|
|
the form definitions. If no initial data object or defaults have been provided, the form |
977
|
|
|
|
|
|
|
will be empty. Most attributes can be set on either 'new' or 'process'. |
978
|
|
|
|
|
|
|
The common attributes to be passed in to the constructor for a database form |
979
|
|
|
|
|
|
|
are either item_id and schema or item: |
980
|
|
|
|
|
|
|
|
981
|
|
|
|
|
|
|
item_id - database row primary key |
982
|
|
|
|
|
|
|
item - database row object |
983
|
|
|
|
|
|
|
schema - (for DBIC) the DBIx::Class schema |
984
|
|
|
|
|
|
|
|
985
|
|
|
|
|
|
|
The following are sometimes passed in, but are also often set |
986
|
|
|
|
|
|
|
in the form class: |
987
|
|
|
|
|
|
|
|
988
|
|
|
|
|
|
|
item_class - source name of row |
989
|
|
|
|
|
|
|
dependency - (see dependency) |
990
|
|
|
|
|
|
|
field_list - an array of field definitions |
991
|
|
|
|
|
|
|
init_object - a hashref or object to provide initial values |
992
|
|
|
|
|
|
|
|
993
|
|
|
|
|
|
|
Examples of creating a form object with new: |
994
|
|
|
|
|
|
|
|
995
|
|
|
|
|
|
|
my $form = MyApp::Form::User->new; |
996
|
|
|
|
|
|
|
|
997
|
|
|
|
|
|
|
# database form using a row object |
998
|
|
|
|
|
|
|
my $form = MyApp::Form::Member->new( item => $row ); |
999
|
|
|
|
|
|
|
|
1000
|
|
|
|
|
|
|
# a dynamic form (no form class has been defined) |
1001
|
|
|
|
|
|
|
my $form = HTML::FormHandler::Model::DBIC->new( |
1002
|
|
|
|
|
|
|
item_id => $id, |
1003
|
|
|
|
|
|
|
item_class => 'User', |
1004
|
|
|
|
|
|
|
schema => $schema, |
1005
|
|
|
|
|
|
|
field_list => [ |
1006
|
|
|
|
|
|
|
name => 'Text', |
1007
|
|
|
|
|
|
|
active => 'Boolean', |
1008
|
|
|
|
|
|
|
submit_btn => 'Submit', |
1009
|
|
|
|
|
|
|
], |
1010
|
|
|
|
|
|
|
); |
1011
|
|
|
|
|
|
|
|
1012
|
|
|
|
|
|
|
See the model class for more information about 'item', 'item_id', |
1013
|
|
|
|
|
|
|
'item_class', and 'schema' (for the DBIC model). |
1014
|
|
|
|
|
|
|
L<HTML::FormHandler::Model::DBIC>. |
1015
|
|
|
|
|
|
|
|
1016
|
|
|
|
|
|
|
FormHandler forms are handled in two steps: 1) create with 'new', |
1017
|
|
|
|
|
|
|
2) handle with 'process'. FormHandler doesn't |
1018
|
|
|
|
|
|
|
care whether most parameters are set on new or process or update, |
1019
|
|
|
|
|
|
|
but a 'field_list' argument must be passed in on 'new' since the |
1020
|
|
|
|
|
|
|
fields are built at construction time. |
1021
|
|
|
|
|
|
|
|
1022
|
|
|
|
|
|
|
If you want to update field attributes on the 'process' call, you can |
1023
|
|
|
|
|
|
|
use an 'update_field_list' or 'defaults' hashref attribute , or subclass |
1024
|
|
|
|
|
|
|
update_fields in your form. The 'update_field_list' hashref can be used |
1025
|
|
|
|
|
|
|
to set any field attribute. The 'defaults' hashref will update only |
1026
|
|
|
|
|
|
|
the 'default' attribute in the field. (There are a lot of ways to |
1027
|
|
|
|
|
|
|
set defaults. See L<HTML::FormHandler::Manual::Defaults>.) |
1028
|
|
|
|
|
|
|
|
1029
|
|
|
|
|
|
|
$form->process( defaults => { foo => 'foo_def', bar => 'bar_def' } ); |
1030
|
|
|
|
|
|
|
$form->process( update_field_list => { foo => { label => 'New Label' } }); |
1031
|
|
|
|
|
|
|
|
1032
|
|
|
|
|
|
|
Field results are built on the 'new' call, but will then be re-built |
1033
|
|
|
|
|
|
|
on the process call. If you always use 'process' before rendering the form, |
1034
|
|
|
|
|
|
|
accessing fields, etc, you can set the 'no_preload' flag to skip this step. |
1035
|
|
|
|
|
|
|
|
1036
|
|
|
|
|
|
|
=head2 Processing the form |
1037
|
|
|
|
|
|
|
|
1038
|
|
|
|
|
|
|
=head3 process |
1039
|
|
|
|
|
|
|
|
1040
|
|
|
|
|
|
|
Call the 'process' method on your form to perform validation and |
1041
|
|
|
|
|
|
|
update. A database form must have either an item (row object) or |
1042
|
|
|
|
|
|
|
a schema, item_id (row primary key), and item_class (usually set in the form). |
1043
|
|
|
|
|
|
|
A non-database form requires only parameters. |
1044
|
|
|
|
|
|
|
|
1045
|
|
|
|
|
|
|
$form->process( item => $book, params => $c->req->parameters ); |
1046
|
|
|
|
|
|
|
$form->process( item_id => $item_id, |
1047
|
|
|
|
|
|
|
schema => $schema, params => $c->req->parameters ); |
1048
|
|
|
|
|
|
|
$form->process( params => $c->req->parameters ); |
1049
|
|
|
|
|
|
|
|
1050
|
|
|
|
|
|
|
This process method returns the 'validated' flag (C<< $form->validated >>). |
1051
|
|
|
|
|
|
|
If it is a database form and the form validates, the database row |
1052
|
|
|
|
|
|
|
will be updated. |
1053
|
|
|
|
|
|
|
|
1054
|
|
|
|
|
|
|
After the form has been processed, you can get a parameter hashref suitable |
1055
|
|
|
|
|
|
|
for using to fill in the form from C<< $form->fif >>. |
1056
|
|
|
|
|
|
|
A hash of inflated values (that would be used to update the database for |
1057
|
|
|
|
|
|
|
a database form) can be retrieved with C<< $form->value >>. |
1058
|
|
|
|
|
|
|
|
1059
|
|
|
|
|
|
|
If you don't want to update the database on this process call, you can |
1060
|
|
|
|
|
|
|
set the 'no_update' flag: |
1061
|
|
|
|
|
|
|
|
1062
|
|
|
|
|
|
|
$form->process( item => $book, params => $params, no_update => 1 ); |
1063
|
|
|
|
|
|
|
|
1064
|
|
|
|
|
|
|
=head3 params |
1065
|
|
|
|
|
|
|
|
1066
|
|
|
|
|
|
|
Parameters are passed in when you call 'process'. |
1067
|
|
|
|
|
|
|
HFH gets data to validate and store in the database from the params hash. |
1068
|
|
|
|
|
|
|
If the params hash is empty, no validation is done, so it is not necessary |
1069
|
|
|
|
|
|
|
to check for POST before calling C<< $form->process >>. (Although see |
1070
|
|
|
|
|
|
|
the 'posted' option for complications.) |
1071
|
|
|
|
|
|
|
|
1072
|
|
|
|
|
|
|
Params can either be in the form of CGI/HTTP style params: |
1073
|
|
|
|
|
|
|
|
1074
|
|
|
|
|
|
|
{ |
1075
|
|
|
|
|
|
|
user_name => "Joe Smith", |
1076
|
|
|
|
|
|
|
occupation => "Programmer", |
1077
|
|
|
|
|
|
|
'addresses.0.street' => "999 Main Street", |
1078
|
|
|
|
|
|
|
'addresses.0.city' => "Podunk", |
1079
|
|
|
|
|
|
|
'addresses.0.country' => "UT", |
1080
|
|
|
|
|
|
|
'addresses.0.address_id' => "1", |
1081
|
|
|
|
|
|
|
'addresses.1.street' => "333 Valencia Street", |
1082
|
|
|
|
|
|
|
'addresses.1.city' => "San Francisco", |
1083
|
|
|
|
|
|
|
'addresses.1.country' => "UT", |
1084
|
|
|
|
|
|
|
'addresses.1.address_id' => "2", |
1085
|
|
|
|
|
|
|
} |
1086
|
|
|
|
|
|
|
|
1087
|
|
|
|
|
|
|
or as structured data in the form of hashes and lists: |
1088
|
|
|
|
|
|
|
|
1089
|
|
|
|
|
|
|
{ |
1090
|
|
|
|
|
|
|
addresses => [ |
1091
|
|
|
|
|
|
|
{ |
1092
|
|
|
|
|
|
|
city => 'Middle City', |
1093
|
|
|
|
|
|
|
country => 'GK', |
1094
|
|
|
|
|
|
|
address_id => 1, |
1095
|
|
|
|
|
|
|
street => '101 Main St', |
1096
|
|
|
|
|
|
|
}, |
1097
|
|
|
|
|
|
|
{ |
1098
|
|
|
|
|
|
|
city => 'DownTown', |
1099
|
|
|
|
|
|
|
country => 'UT', |
1100
|
|
|
|
|
|
|
address_id => 2, |
1101
|
|
|
|
|
|
|
street => '99 Elm St', |
1102
|
|
|
|
|
|
|
}, |
1103
|
|
|
|
|
|
|
], |
1104
|
|
|
|
|
|
|
'occupation' => 'management', |
1105
|
|
|
|
|
|
|
'user_name' => 'jdoe', |
1106
|
|
|
|
|
|
|
} |
1107
|
|
|
|
|
|
|
|
1108
|
|
|
|
|
|
|
CGI style parameters will be converted to hashes and lists for HFH to |
1109
|
|
|
|
|
|
|
operate on. |
1110
|
|
|
|
|
|
|
|
1111
|
|
|
|
|
|
|
=head3 posted |
1112
|
|
|
|
|
|
|
|
1113
|
|
|
|
|
|
|
Note that FormHandler by default uses empty params as a signal that the |
1114
|
|
|
|
|
|
|
form has not actually been posted, and so will not attempt to validate |
1115
|
|
|
|
|
|
|
a form with empty params. Most of the time this works OK, but if you |
1116
|
|
|
|
|
|
|
have a small form with only the controls that do not return a post |
1117
|
|
|
|
|
|
|
parameter if unselected (checkboxes and select lists), then the form |
1118
|
|
|
|
|
|
|
will not be validated if everything is unselected. For this case you |
1119
|
|
|
|
|
|
|
can either add a hidden field as an 'indicator', or use the 'posted' flag: |
1120
|
|
|
|
|
|
|
|
1121
|
|
|
|
|
|
|
$form->process( posted => ($c->req->method eq 'POST'), params => ... ); |
1122
|
|
|
|
|
|
|
|
1123
|
|
|
|
|
|
|
The 'posted' flag also works to prevent validation from being performed |
1124
|
|
|
|
|
|
|
if there are extra params in the params hash and it is not a 'POST' request. |
1125
|
|
|
|
|
|
|
|
1126
|
|
|
|
|
|
|
=head2 Getting data out |
1127
|
|
|
|
|
|
|
|
1128
|
|
|
|
|
|
|
=head3 fif (fill in form) |
1129
|
|
|
|
|
|
|
|
1130
|
|
|
|
|
|
|
If you don't use FormHandler rendering and want to fill your form values in |
1131
|
|
|
|
|
|
|
using some other method (such as with HTML::FillInForm or using a template) |
1132
|
|
|
|
|
|
|
this returns a hash of values that are equivalent to params which you may |
1133
|
|
|
|
|
|
|
use to fill in your form. |
1134
|
|
|
|
|
|
|
|
1135
|
|
|
|
|
|
|
The fif value for a 'title' field in a TT form: |
1136
|
|
|
|
|
|
|
|
1137
|
|
|
|
|
|
|
[% form.fif.title %] |
1138
|
|
|
|
|
|
|
|
1139
|
|
|
|
|
|
|
Or you can use the 'fif' method on individual fields: |
1140
|
|
|
|
|
|
|
|
1141
|
|
|
|
|
|
|
[% form.field('title').fif %] |
1142
|
|
|
|
|
|
|
|
1143
|
|
|
|
|
|
|
If you use FormHandler to render your forms or field you probably won't use |
1144
|
|
|
|
|
|
|
these methods. |
1145
|
|
|
|
|
|
|
|
1146
|
|
|
|
|
|
|
=head3 value |
1147
|
|
|
|
|
|
|
|
1148
|
|
|
|
|
|
|
Returns a hashref of all field values. Useful for non-database forms, or if |
1149
|
|
|
|
|
|
|
you want to update the database yourself. The 'fif' method returns |
1150
|
|
|
|
|
|
|
a hashref with the field names for the keys and the field's 'fif' for the |
1151
|
|
|
|
|
|
|
values; 'value' returns a hashref with the field accessors for the keys, and the |
1152
|
|
|
|
|
|
|
field's 'value' (possibly inflated) for the values. |
1153
|
|
|
|
|
|
|
|
1154
|
|
|
|
|
|
|
Forms containing arrays to be processed with L<HTML::FormHandler::Field::Repeatable> |
1155
|
|
|
|
|
|
|
will have parameters with dots and numbers, like 'addresses.0.city', while the |
1156
|
|
|
|
|
|
|
values hash will transform the fields with numbers to arrays. |
1157
|
|
|
|
|
|
|
|
1158
|
|
|
|
|
|
|
=head2 Accessing and setting up fields |
1159
|
|
|
|
|
|
|
|
1160
|
|
|
|
|
|
|
Fields are declared with a number of attributes which are defined in |
1161
|
|
|
|
|
|
|
L<HTML::FormHandler::Field>. If you want additional attributes you can |
1162
|
|
|
|
|
|
|
define your own field classes (or apply a role to a field class - see |
1163
|
|
|
|
|
|
|
L<HTML::FormHandler::Manual::Cookbook>). The field 'type' (used in field |
1164
|
|
|
|
|
|
|
definitions) is the short class name of the field class, used when |
1165
|
|
|
|
|
|
|
searching the 'field_name_space' for the field class. |
1166
|
|
|
|
|
|
|
|
1167
|
|
|
|
|
|
|
=head3 has_field |
1168
|
|
|
|
|
|
|
|
1169
|
|
|
|
|
|
|
The most common way of declaring fields is the 'has_field' syntax. |
1170
|
|
|
|
|
|
|
Using the 'has_field' syntax sugar requires C< use HTML::FormHandler::Moose; > |
1171
|
|
|
|
|
|
|
or C< use HTML::FormHandler::Moose::Role; > in a role. |
1172
|
|
|
|
|
|
|
See L<HTML::FormHandler::Manual::Intro> |
1173
|
|
|
|
|
|
|
|
1174
|
|
|
|
|
|
|
use HTML::FormHandler::Moose; |
1175
|
|
|
|
|
|
|
has_field 'field_name' => ( type => 'FieldClass', .... ); |
1176
|
|
|
|
|
|
|
|
1177
|
|
|
|
|
|
|
=head3 field_list |
1178
|
|
|
|
|
|
|
|
1179
|
|
|
|
|
|
|
A 'field_list' is an array of field definitions which can be used as an |
1180
|
|
|
|
|
|
|
alternative to 'has_field' in small, dynamic forms to create fields. |
1181
|
|
|
|
|
|
|
|
1182
|
|
|
|
|
|
|
field_list => [ |
1183
|
|
|
|
|
|
|
field_one => { |
1184
|
|
|
|
|
|
|
type => 'Text', |
1185
|
|
|
|
|
|
|
required => 1 |
1186
|
|
|
|
|
|
|
}, |
1187
|
|
|
|
|
|
|
field_two => 'Text, |
1188
|
|
|
|
|
|
|
] |
1189
|
|
|
|
|
|
|
|
1190
|
|
|
|
|
|
|
The field_list array takes elements which are either a field_name key |
1191
|
|
|
|
|
|
|
pointing to a 'type' string or a field_name key pointing to a |
1192
|
|
|
|
|
|
|
hashref of field attributes. You can also provide an array of |
1193
|
|
|
|
|
|
|
hashref elements with the name as an additional attribute. |
1194
|
|
|
|
|
|
|
The field list can be set inside a form class, when you want to |
1195
|
|
|
|
|
|
|
add fields to the form depending on some other state, although |
1196
|
|
|
|
|
|
|
you can also create all the fields and set some of them inactive. |
1197
|
|
|
|
|
|
|
|
1198
|
|
|
|
|
|
|
sub field_list { |
1199
|
|
|
|
|
|
|
my $self = shift; |
1200
|
|
|
|
|
|
|
my $fields = $self->schema->resultset('SomeTable')-> |
1201
|
|
|
|
|
|
|
search({user_id => $self->user_id, .... }); |
1202
|
|
|
|
|
|
|
my @field_list; |
1203
|
|
|
|
|
|
|
while ( my $field = $fields->next ) |
1204
|
|
|
|
|
|
|
{ |
1205
|
|
|
|
|
|
|
< create field list > |
1206
|
|
|
|
|
|
|
} |
1207
|
|
|
|
|
|
|
return \@field_list; |
1208
|
|
|
|
|
|
|
} |
1209
|
|
|
|
|
|
|
|
1210
|
|
|
|
|
|
|
=head3 update_field_list |
1211
|
|
|
|
|
|
|
|
1212
|
|
|
|
|
|
|
Used to dynamically set particular field attributes on the 'process' (or |
1213
|
|
|
|
|
|
|
'run') call. (Will not create fields.) |
1214
|
|
|
|
|
|
|
|
1215
|
|
|
|
|
|
|
$form->process( update_field_list => { |
1216
|
|
|
|
|
|
|
foo_date => { format => '%m/%e/%Y', date_start => '10-01-01' } }, |
1217
|
|
|
|
|
|
|
params => $params ); |
1218
|
|
|
|
|
|
|
|
1219
|
|
|
|
|
|
|
The 'update_field_list' is processed by the 'update_fields' form method, |
1220
|
|
|
|
|
|
|
which can also be used in a form to do specific field updates: |
1221
|
|
|
|
|
|
|
|
1222
|
|
|
|
|
|
|
sub update_fields { |
1223
|
|
|
|
|
|
|
my $self = shift; |
1224
|
|
|
|
|
|
|
$self->field('foo')->temp( 'foo_temp' ); |
1225
|
|
|
|
|
|
|
$self->field('bar')->default( 'foo_value' ); |
1226
|
|
|
|
|
|
|
$self->next::method(); |
1227
|
|
|
|
|
|
|
} |
1228
|
|
|
|
|
|
|
|
1229
|
|
|
|
|
|
|
(Note that you although you can set a field's 'default', you can't set a |
1230
|
|
|
|
|
|
|
field's 'value' directly here, since it will |
1231
|
|
|
|
|
|
|
be overwritten by the validation process. Set the value in a field |
1232
|
|
|
|
|
|
|
validation method.) |
1233
|
|
|
|
|
|
|
|
1234
|
|
|
|
|
|
|
=head3 update_subfields |
1235
|
|
|
|
|
|
|
|
1236
|
|
|
|
|
|
|
Yet another way to provide settings for the field, except this one is intended for |
1237
|
|
|
|
|
|
|
use in roles and compound fields, and is only executed when the form is |
1238
|
|
|
|
|
|
|
initially built. It takes the same field name keys as 'update_field_list', plus |
1239
|
|
|
|
|
|
|
'all', 'by_flag', and 'by_type'. |
1240
|
|
|
|
|
|
|
|
1241
|
|
|
|
|
|
|
sub build_update_subfields {{ |
1242
|
|
|
|
|
|
|
all => { tags => { wrapper_tag => 'p' } }, |
1243
|
|
|
|
|
|
|
foo => { element_class => 'blue' }, |
1244
|
|
|
|
|
|
|
}} |
1245
|
|
|
|
|
|
|
|
1246
|
|
|
|
|
|
|
The 'all' hash key will apply updates to all fields. (Conflicting attributes |
1247
|
|
|
|
|
|
|
in a field definition take precedence.) |
1248
|
|
|
|
|
|
|
|
1249
|
|
|
|
|
|
|
The 'by_flag' hash key will apply updates to fields with a particular flag. |
1250
|
|
|
|
|
|
|
The currently supported subkeys are 'compound', 'contains', and 'repeatable'. |
1251
|
|
|
|
|
|
|
(For repeatable instances, in addition to 'contains' you can also use the |
1252
|
|
|
|
|
|
|
'repeatable' key and the 'init_contains' attribute.) |
1253
|
|
|
|
|
|
|
This is useful for turning on the rendering |
1254
|
|
|
|
|
|
|
wrappers for compounds and repeatables, which are off by default. (The |
1255
|
|
|
|
|
|
|
repeatable instances are wrapped by default.) |
1256
|
|
|
|
|
|
|
|
1257
|
|
|
|
|
|
|
sub build_update_subfields {{ |
1258
|
|
|
|
|
|
|
by_flag => { compound => { do_wrapper => 1 } }, |
1259
|
|
|
|
|
|
|
by_type => { Select => { element_class => ['sel_elem'] } }, |
1260
|
|
|
|
|
|
|
}} |
1261
|
|
|
|
|
|
|
|
1262
|
|
|
|
|
|
|
The 'by_type' hash key will provide values to all fields of a particular |
1263
|
|
|
|
|
|
|
type. |
1264
|
|
|
|
|
|
|
|
1265
|
|
|
|
|
|
|
=head3 defaults |
1266
|
|
|
|
|
|
|
|
1267
|
|
|
|
|
|
|
This is a more specialized version of the 'update_field_list'. It can be |
1268
|
|
|
|
|
|
|
used to provide 'default' settings for fields, in a shorthand way (you don't |
1269
|
|
|
|
|
|
|
have to say 'default' for every field). |
1270
|
|
|
|
|
|
|
|
1271
|
|
|
|
|
|
|
$form->process( defaults => { foo => 'this_foo', bar => 'this_bar' }, ... ); |
1272
|
|
|
|
|
|
|
|
1273
|
|
|
|
|
|
|
=head3 active/inactive |
1274
|
|
|
|
|
|
|
|
1275
|
|
|
|
|
|
|
A field can be marked 'inactive' and set to active at new or process time |
1276
|
|
|
|
|
|
|
by specifying the field name in the 'active' array: |
1277
|
|
|
|
|
|
|
|
1278
|
|
|
|
|
|
|
has_field 'foo' => ( type => 'Text', inactive => 1 ); |
1279
|
|
|
|
|
|
|
... |
1280
|
|
|
|
|
|
|
my $form = MyApp::Form->new( active => ['foo'] ); |
1281
|
|
|
|
|
|
|
... |
1282
|
|
|
|
|
|
|
$form->process( active => ['foo'] ); |
1283
|
|
|
|
|
|
|
|
1284
|
|
|
|
|
|
|
Or a field can be a normal active field and set to inactive at new or process |
1285
|
|
|
|
|
|
|
time: |
1286
|
|
|
|
|
|
|
|
1287
|
|
|
|
|
|
|
has_field 'bar'; |
1288
|
|
|
|
|
|
|
... |
1289
|
|
|
|
|
|
|
my $form = MyApp::Form->new( inactive => ['foo'] ); |
1290
|
|
|
|
|
|
|
... |
1291
|
|
|
|
|
|
|
$form->process( inactive => ['foo'] ); |
1292
|
|
|
|
|
|
|
|
1293
|
|
|
|
|
|
|
Fields specified as active/inactive on new will have the form's inactive/active |
1294
|
|
|
|
|
|
|
arrayref cleared and the field's inactive flag set appropriately, so that |
1295
|
|
|
|
|
|
|
the state will be effective for the life of the form object. Fields specified as |
1296
|
|
|
|
|
|
|
active/inactive on 'process' will have the field's '_active' flag set for the life |
1297
|
|
|
|
|
|
|
of the request (the _active flag will be cleared when the form is cleared). |
1298
|
|
|
|
|
|
|
|
1299
|
|
|
|
|
|
|
The 'sorted_fields' method returns only active fields, sorted according to the |
1300
|
|
|
|
|
|
|
'order' attribute. The 'fields' method returns all fields. |
1301
|
|
|
|
|
|
|
|
1302
|
|
|
|
|
|
|
foreach my $field ( $self->sorted_fields ) { ... } |
1303
|
|
|
|
|
|
|
|
1304
|
|
|
|
|
|
|
You can test whether a field is active by using the field 'is_active' and 'is_inactive' |
1305
|
|
|
|
|
|
|
methods. |
1306
|
|
|
|
|
|
|
|
1307
|
|
|
|
|
|
|
=head3 field_name_space |
1308
|
|
|
|
|
|
|
|
1309
|
|
|
|
|
|
|
Use to look for field during form construction. If a field is not found |
1310
|
|
|
|
|
|
|
with the field_name_space (or HTML::FormHandler/HTML::FormHandlerX), |
1311
|
|
|
|
|
|
|
the 'type' must start with a '+' and be the complete package name. |
1312
|
|
|
|
|
|
|
|
1313
|
|
|
|
|
|
|
=head3 fields |
1314
|
|
|
|
|
|
|
|
1315
|
|
|
|
|
|
|
The array of fields, objects of L<HTML::FormHandler::Field> or its subclasses. |
1316
|
|
|
|
|
|
|
A compound field will itself have an array of fields, |
1317
|
|
|
|
|
|
|
so this is a tree structure. |
1318
|
|
|
|
|
|
|
|
1319
|
|
|
|
|
|
|
=head3 sorted_fields |
1320
|
|
|
|
|
|
|
|
1321
|
|
|
|
|
|
|
Returns those fields from the fields array which are currently active. This |
1322
|
|
|
|
|
|
|
is the method that returns the fields that are looped through when rendering. |
1323
|
|
|
|
|
|
|
|
1324
|
|
|
|
|
|
|
=head3 field($name), subfield($name) |
1325
|
|
|
|
|
|
|
|
1326
|
|
|
|
|
|
|
'field' is the method that is usually called to access a field: |
1327
|
|
|
|
|
|
|
|
1328
|
|
|
|
|
|
|
my $title = $form->field('title')->value; |
1329
|
|
|
|
|
|
|
[% f = form.field('title') %] |
1330
|
|
|
|
|
|
|
|
1331
|
|
|
|
|
|
|
my $city = $form->field('addresses.0.city')->value; |
1332
|
|
|
|
|
|
|
|
1333
|
|
|
|
|
|
|
Pass a second true value to die on errors. |
1334
|
|
|
|
|
|
|
|
1335
|
|
|
|
|
|
|
Since fields are searched for using the form as a base, if you want to find |
1336
|
|
|
|
|
|
|
a sub field in a compound field method, the 'subfield' method may be more |
1337
|
|
|
|
|
|
|
useful, since you can search starting at the current field. The 'chained' |
1338
|
|
|
|
|
|
|
method also works: |
1339
|
|
|
|
|
|
|
|
1340
|
|
|
|
|
|
|
-- in a compound field -- |
1341
|
|
|
|
|
|
|
$self->field('media.caption'); # fails |
1342
|
|
|
|
|
|
|
$self->field('media')->field('caption'); # works |
1343
|
|
|
|
|
|
|
$self->subfield('media.caption'); # works |
1344
|
|
|
|
|
|
|
|
1345
|
|
|
|
|
|
|
=head2 Constraints and validation |
1346
|
|
|
|
|
|
|
|
1347
|
|
|
|
|
|
|
Most validation is performed on a per-field basis, and there are a number |
1348
|
|
|
|
|
|
|
of different places in which validation can be performed. |
1349
|
|
|
|
|
|
|
|
1350
|
|
|
|
|
|
|
See also L<HTML::FormHandler::Manual::Validation>. |
1351
|
|
|
|
|
|
|
|
1352
|
|
|
|
|
|
|
=head3 Form class validation for individual fields |
1353
|
|
|
|
|
|
|
|
1354
|
|
|
|
|
|
|
You can define a method in your form class to perform validation on a field. |
1355
|
|
|
|
|
|
|
This method is the equivalent of the field class validate method except it is |
1356
|
|
|
|
|
|
|
in the form class, so you might use this |
1357
|
|
|
|
|
|
|
validation method if you don't want to create a field subclass. |
1358
|
|
|
|
|
|
|
|
1359
|
|
|
|
|
|
|
It has access to the form ($self) and the field. |
1360
|
|
|
|
|
|
|
This method is called after the field class 'validate' method, and is not |
1361
|
|
|
|
|
|
|
called if the value for the field is empty ('', undef). (If you want an |
1362
|
|
|
|
|
|
|
error message when the field is empty, use the 'required' flag and message |
1363
|
|
|
|
|
|
|
or the form 'validate' method.) |
1364
|
|
|
|
|
|
|
The name of this method can be set with 'set_validate' on the field. The |
1365
|
|
|
|
|
|
|
default is 'validate_' plus the field name: |
1366
|
|
|
|
|
|
|
|
1367
|
|
|
|
|
|
|
sub validate_testfield { my ( $self, $field ) = @_; ... } |
1368
|
|
|
|
|
|
|
|
1369
|
|
|
|
|
|
|
If the field name has dots they should be replaced with underscores. |
1370
|
|
|
|
|
|
|
|
1371
|
|
|
|
|
|
|
Note that you can also provide a coderef which will be a method on the field: |
1372
|
|
|
|
|
|
|
|
1373
|
|
|
|
|
|
|
has_field 'foo' => ( validate_method => \&validate_foo ); |
1374
|
|
|
|
|
|
|
|
1375
|
|
|
|
|
|
|
=head3 validate |
1376
|
|
|
|
|
|
|
|
1377
|
|
|
|
|
|
|
This is a form method that is useful for cross checking values after they have |
1378
|
|
|
|
|
|
|
been saved as their final validated value, and for performing more complex |
1379
|
|
|
|
|
|
|
dependency validation. It is called after all other field validation is done, |
1380
|
|
|
|
|
|
|
and whether or not validation has succeeded, so it has access to the |
1381
|
|
|
|
|
|
|
post-validation values of all the fields. |
1382
|
|
|
|
|
|
|
|
1383
|
|
|
|
|
|
|
This is the best place to do validation checks that depend on the values of |
1384
|
|
|
|
|
|
|
more than one field. |
1385
|
|
|
|
|
|
|
|
1386
|
|
|
|
|
|
|
=head2 Accessing errors |
1387
|
|
|
|
|
|
|
|
1388
|
|
|
|
|
|
|
Also see L<HTML::FormHandler::Manual::Errors>. |
1389
|
|
|
|
|
|
|
|
1390
|
|
|
|
|
|
|
Set an error in a field with C<< $field->add_error('some error string'); >>. |
1391
|
|
|
|
|
|
|
Set a form error not tied to a specific field with |
1392
|
|
|
|
|
|
|
C<< $self->add_form_error('another error string'); >>. |
1393
|
|
|
|
|
|
|
The 'add_error' and 'add_form_error' methods call localization. If you |
1394
|
|
|
|
|
|
|
want to skip localization for a particular error, you can use 'push_errors' |
1395
|
|
|
|
|
|
|
or 'push_form_errors' instead. |
1396
|
|
|
|
|
|
|
|
1397
|
|
|
|
|
|
|
has_errors - returns true or false |
1398
|
|
|
|
|
|
|
error_fields - returns list of fields with errors |
1399
|
|
|
|
|
|
|
errors - returns array of error messages for the entire form |
1400
|
|
|
|
|
|
|
num_errors - number of errors in form |
1401
|
|
|
|
|
|
|
|
1402
|
|
|
|
|
|
|
Each field has an array of error messages. (errors, has_errors, num_errors, |
1403
|
|
|
|
|
|
|
clear_errors) |
1404
|
|
|
|
|
|
|
|
1405
|
|
|
|
|
|
|
$form->field('title')->errors; |
1406
|
|
|
|
|
|
|
|
1407
|
|
|
|
|
|
|
Compound fields also have an array of error_fields. |
1408
|
|
|
|
|
|
|
|
1409
|
|
|
|
|
|
|
=head2 Clear form state |
1410
|
|
|
|
|
|
|
|
1411
|
|
|
|
|
|
|
The clear method is called at the beginning of 'process' if the form |
1412
|
|
|
|
|
|
|
object is reused, such as when it is persistent in a Moose attribute, |
1413
|
|
|
|
|
|
|
or in tests. If you add other attributes to your form that are set on |
1414
|
|
|
|
|
|
|
each request, you may need to clear those yourself. |
1415
|
|
|
|
|
|
|
|
1416
|
|
|
|
|
|
|
If you do not call the form's 'process' method on a persistent form, |
1417
|
|
|
|
|
|
|
such as in a REST controller's non-POST method, or if you only call |
1418
|
|
|
|
|
|
|
process when the form is posted, you will also need to call C<< $form->clear >>. |
1419
|
|
|
|
|
|
|
|
1420
|
|
|
|
|
|
|
The 'run' method which returns a result object always performs 'clear', to |
1421
|
|
|
|
|
|
|
keep the form object clean. |
1422
|
|
|
|
|
|
|
|
1423
|
|
|
|
|
|
|
=head2 Miscellaneous attributes |
1424
|
|
|
|
|
|
|
|
1425
|
|
|
|
|
|
|
=head3 name |
1426
|
|
|
|
|
|
|
|
1427
|
|
|
|
|
|
|
The form's name. Useful for multiple forms. Used for the form element 'id'. |
1428
|
|
|
|
|
|
|
When 'html_prefix' is set it is used to construct the field 'id' |
1429
|
|
|
|
|
|
|
and 'name'. The default is "form" + a one to three digit random number. |
1430
|
|
|
|
|
|
|
Because the HTML standards have flip-flopped on whether the HTML |
1431
|
|
|
|
|
|
|
form element can contain a 'name' attribute, please set a name attribute |
1432
|
|
|
|
|
|
|
using 'form_element_attr'. |
1433
|
|
|
|
|
|
|
|
1434
|
|
|
|
|
|
|
=head3 init_object |
1435
|
|
|
|
|
|
|
|
1436
|
|
|
|
|
|
|
An 'init_object' may be used instead of the 'item' to pre-populate the values |
1437
|
|
|
|
|
|
|
in the form. This can be useful when populating a form from default values |
1438
|
|
|
|
|
|
|
stored in a similar but different object than the one the form is creating. |
1439
|
|
|
|
|
|
|
The 'init_object' should be either a hash or the same type of object that |
1440
|
|
|
|
|
|
|
the model uses (a DBIx::Class row for the DBIC model). It can be set in a |
1441
|
|
|
|
|
|
|
variety of ways: |
1442
|
|
|
|
|
|
|
|
1443
|
|
|
|
|
|
|
my $form = MyApp::Form->new( init_object => { .... } ); |
1444
|
|
|
|
|
|
|
$form->process( init_object => {...}, ... ); |
1445
|
|
|
|
|
|
|
has '+init_object' => ( default => sub { { .... } } ); |
1446
|
|
|
|
|
|
|
sub init_object { my $self = shift; .... } |
1447
|
|
|
|
|
|
|
|
1448
|
|
|
|
|
|
|
The method version is useful if the organization of data in your form does |
1449
|
|
|
|
|
|
|
not map to an existing or database object in an automatic way, and you need |
1450
|
|
|
|
|
|
|
to create a different type of object for initialization. (You might also |
1451
|
|
|
|
|
|
|
want to do 'update_model' yourself.) |
1452
|
|
|
|
|
|
|
|
1453
|
|
|
|
|
|
|
Also see the 'use_init_obj_over_item' and the 'use_init_obj_when_no_accessor_in_item' |
1454
|
|
|
|
|
|
|
flags, if you want to provide both an item and an init_object, and use the |
1455
|
|
|
|
|
|
|
values from the init_object. |
1456
|
|
|
|
|
|
|
|
1457
|
|
|
|
|
|
|
The 'use_init_obj_when_no_accessor_in_item' flag is particularly useful |
1458
|
|
|
|
|
|
|
when some of the fields in your form come from the database and some |
1459
|
|
|
|
|
|
|
are process or environment type flags that are not in the database. You |
1460
|
|
|
|
|
|
|
can provide defaults from both a database row and an 'init_object. |
1461
|
|
|
|
|
|
|
|
1462
|
|
|
|
|
|
|
=head3 ctx |
1463
|
|
|
|
|
|
|
|
1464
|
|
|
|
|
|
|
Place to store application context for your use in your form's methods. |
1465
|
|
|
|
|
|
|
|
1466
|
|
|
|
|
|
|
=head3 language_handle |
1467
|
|
|
|
|
|
|
|
1468
|
|
|
|
|
|
|
See 'language_handle' and '_build_language_handle' in |
1469
|
|
|
|
|
|
|
L<HTML::FormHandler::TraitFor::I18N>. |
1470
|
|
|
|
|
|
|
|
1471
|
|
|
|
|
|
|
=head3 dependency |
1472
|
|
|
|
|
|
|
|
1473
|
|
|
|
|
|
|
Arrayref of arrayrefs of fields. If one of a group of fields has a |
1474
|
|
|
|
|
|
|
value, then all of the group are set to 'required'. |
1475
|
|
|
|
|
|
|
|
1476
|
|
|
|
|
|
|
has '+dependency' => ( default => sub { [ |
1477
|
|
|
|
|
|
|
['street', 'city', 'state', 'zip' ],] } |
1478
|
|
|
|
|
|
|
); |
1479
|
|
|
|
|
|
|
|
1480
|
|
|
|
|
|
|
=head2 Flags |
1481
|
|
|
|
|
|
|
|
1482
|
|
|
|
|
|
|
=head3 validated, is_valid |
1483
|
|
|
|
|
|
|
|
1484
|
|
|
|
|
|
|
Flag that indicates if form has been validated. You might want to use |
1485
|
|
|
|
|
|
|
this flag if you're doing something in between process and returning, |
1486
|
|
|
|
|
|
|
such as setting a stash key. ('is_valid' is a synonym for this flag) |
1487
|
|
|
|
|
|
|
|
1488
|
|
|
|
|
|
|
$form->process( ... ); |
1489
|
|
|
|
|
|
|
$c->stash->{...} = ...; |
1490
|
|
|
|
|
|
|
return unless $form->validated; |
1491
|
|
|
|
|
|
|
|
1492
|
|
|
|
|
|
|
=head3 ran_validation |
1493
|
|
|
|
|
|
|
|
1494
|
|
|
|
|
|
|
Flag to indicate that validation has been run. This flag will be |
1495
|
|
|
|
|
|
|
false when the form is initially loaded and displayed, since |
1496
|
|
|
|
|
|
|
validation is not run until FormHandler has params to validate. |
1497
|
|
|
|
|
|
|
|
1498
|
|
|
|
|
|
|
=head3 verbose, dump, peek |
1499
|
|
|
|
|
|
|
|
1500
|
|
|
|
|
|
|
Flag to dump diagnostic information. See 'dump_fields' and |
1501
|
|
|
|
|
|
|
'dump_validated'. 'Peek' can be useful in diagnosing bugs. |
1502
|
|
|
|
|
|
|
It will dump a brief listing of the fields and results. |
1503
|
|
|
|
|
|
|
|
1504
|
|
|
|
|
|
|
$form->process( ... ); |
1505
|
|
|
|
|
|
|
$form->peek; |
1506
|
|
|
|
|
|
|
|
1507
|
|
|
|
|
|
|
=head3 html_prefix |
1508
|
|
|
|
|
|
|
|
1509
|
|
|
|
|
|
|
Flag to indicate that the form name is used as a prefix for fields |
1510
|
|
|
|
|
|
|
in an HTML form. Useful for multiple forms |
1511
|
|
|
|
|
|
|
on the same HTML page. The prefix is stripped off of the fields |
1512
|
|
|
|
|
|
|
before creating the internal field name, and added back in when |
1513
|
|
|
|
|
|
|
returning a parameter hash from the 'fif' method. For example, |
1514
|
|
|
|
|
|
|
the field name in the HTML form could be "book.borrower", and |
1515
|
|
|
|
|
|
|
the field name in the FormHandler form (and the database column) |
1516
|
|
|
|
|
|
|
would be just "borrower". |
1517
|
|
|
|
|
|
|
|
1518
|
|
|
|
|
|
|
has '+name' => ( default => 'book' ); |
1519
|
|
|
|
|
|
|
has '+html_prefix' => ( default => 1 ); |
1520
|
|
|
|
|
|
|
|
1521
|
|
|
|
|
|
|
Also see the Field attribute "html_name", a convenience function which |
1522
|
|
|
|
|
|
|
will return the form name + "." + field full_name |
1523
|
|
|
|
|
|
|
|
1524
|
|
|
|
|
|
|
=head3 is_html5 |
1525
|
|
|
|
|
|
|
|
1526
|
|
|
|
|
|
|
Flag to indicate the fields will render using specialized attributes for html5. |
1527
|
|
|
|
|
|
|
Set to 0 by default. |
1528
|
|
|
|
|
|
|
|
1529
|
|
|
|
|
|
|
=head3 use_defaults_over_obj |
1530
|
|
|
|
|
|
|
|
1531
|
|
|
|
|
|
|
The 'normal' precedence is that if there is an accessor in the item/init_object |
1532
|
|
|
|
|
|
|
that value is used and not the 'default'. This flag makes the defaults of higher |
1533
|
|
|
|
|
|
|
precedence. Mainly useful if providing an empty row on create. |
1534
|
|
|
|
|
|
|
|
1535
|
|
|
|
|
|
|
=head3 use_init_obj_over_item |
1536
|
|
|
|
|
|
|
|
1537
|
|
|
|
|
|
|
If you are providing both an item and an init_object, and want the init_object |
1538
|
|
|
|
|
|
|
to be used for defaults instead of the item. |
1539
|
|
|
|
|
|
|
|
1540
|
|
|
|
|
|
|
=head2 For use in HTML |
1541
|
|
|
|
|
|
|
|
1542
|
|
|
|
|
|
|
form_element_attr - hashref for setting arbitrary HTML attributes |
1543
|
|
|
|
|
|
|
set in form with: sub build_form_element_attr {...} |
1544
|
|
|
|
|
|
|
form_element_class - arrayref for setting form tag class |
1545
|
|
|
|
|
|
|
form_wrapper_attr - hashref for form wrapper element attributes |
1546
|
|
|
|
|
|
|
set in form with: sub build_form_wrapper_attr {...} |
1547
|
|
|
|
|
|
|
form_wrapper_class - arrayref for setting wrapper class |
1548
|
|
|
|
|
|
|
do_form_wrapper - flag to wrap the form |
1549
|
|
|
|
|
|
|
http_method - For storing 'post' or 'get' |
1550
|
|
|
|
|
|
|
action - Store the form 'action' on submission. No default value. |
1551
|
|
|
|
|
|
|
uuid - generates a string containing an HTML field with UUID |
1552
|
|
|
|
|
|
|
form_tags - hashref of tags for use in rendering code |
1553
|
|
|
|
|
|
|
widget_tags - rendering tags to be transferred to fields |
1554
|
|
|
|
|
|
|
|
1555
|
|
|
|
|
|
|
Discouraged (use form_element_attr instead): |
1556
|
|
|
|
|
|
|
|
1557
|
|
|
|
|
|
|
style - adds a 'style' attribute to the form tag |
1558
|
|
|
|
|
|
|
enctype - Request enctype |
1559
|
|
|
|
|
|
|
|
1560
|
|
|
|
|
|
|
Note that the form tag contains an 'id' attribute which is set to the |
1561
|
|
|
|
|
|
|
form name. The standards have been flip-flopping over whether a 'name' |
1562
|
|
|
|
|
|
|
attribute is valid. It can be set with 'form_element_attr'. |
1563
|
|
|
|
|
|
|
|
1564
|
|
|
|
|
|
|
The rendering of the HTML attributes is done using the 'process_attrs' |
1565
|
|
|
|
|
|
|
function and the 'element_attributes' or 'wrapper_attributes' method, |
1566
|
|
|
|
|
|
|
which adds other attributes in for backward compatibility, and calls |
1567
|
|
|
|
|
|
|
the 'html_attributes' hook. |
1568
|
|
|
|
|
|
|
|
1569
|
|
|
|
|
|
|
For HTML attributes, there is a form method hook, 'html_attributes', |
1570
|
|
|
|
|
|
|
which can be used to customize/modify/localize form & field HTML attributes. |
1571
|
|
|
|
|
|
|
Types: element, wrapper, label, form_element, form_wrapper, checkbox_label |
1572
|
|
|
|
|
|
|
|
1573
|
|
|
|
|
|
|
sub html_attributes { |
1574
|
|
|
|
|
|
|
my ( $self, $obj, $type, $attrs, $result ) = @_; |
1575
|
|
|
|
|
|
|
|
1576
|
|
|
|
|
|
|
# obj is either form or field |
1577
|
|
|
|
|
|
|
$attr->{class} = 'label' if $type eq 'label'; |
1578
|
|
|
|
|
|
|
$attr->{placeholder} = $self->_localize($attr->{placeholder}) |
1579
|
|
|
|
|
|
|
if exists $attr->{placeholder}; |
1580
|
|
|
|
|
|
|
return $attr; |
1581
|
|
|
|
|
|
|
} |
1582
|
|
|
|
|
|
|
|
1583
|
|
|
|
|
|
|
Also see the documentation in L<HTML::FormHandler::Field> and in |
1584
|
|
|
|
|
|
|
L<HTML::FormHandler::Manual::Rendering>. |
1585
|
|
|
|
|
|
|
|
1586
|
|
|
|
|
|
|
=head1 SUPPORT |
1587
|
|
|
|
|
|
|
|
1588
|
|
|
|
|
|
|
IRC: |
1589
|
|
|
|
|
|
|
|
1590
|
|
|
|
|
|
|
Join #formhandler on irc.perl.org |
1591
|
|
|
|
|
|
|
|
1592
|
|
|
|
|
|
|
Mailing list: |
1593
|
|
|
|
|
|
|
|
1594
|
|
|
|
|
|
|
http://groups.google.com/group/formhandler |
1595
|
|
|
|
|
|
|
|
1596
|
|
|
|
|
|
|
Code repository: |
1597
|
|
|
|
|
|
|
|
1598
|
|
|
|
|
|
|
http://github.com/gshank/html-formhandler/tree/master |
1599
|
|
|
|
|
|
|
|
1600
|
|
|
|
|
|
|
Bug tracker: |
1601
|
|
|
|
|
|
|
|
1602
|
|
|
|
|
|
|
https://rt.cpan.org/Dist/Display.html?Name=HTML-FormHandler |
1603
|
|
|
|
|
|
|
|
1604
|
|
|
|
|
|
|
=head1 SEE ALSO |
1605
|
|
|
|
|
|
|
|
1606
|
|
|
|
|
|
|
L<HTML::FormHandler::Manual> |
1607
|
|
|
|
|
|
|
|
1608
|
|
|
|
|
|
|
L<HTML::FormHandler::Manual::Tutorial> |
1609
|
|
|
|
|
|
|
|
1610
|
|
|
|
|
|
|
L<HTML::FormHandler::Manual::Intro> |
1611
|
|
|
|
|
|
|
|
1612
|
|
|
|
|
|
|
L<HTML::FormHandler::Manual::Templates> |
1613
|
|
|
|
|
|
|
|
1614
|
|
|
|
|
|
|
L<HTML::FormHandler::Manual::Cookbook> |
1615
|
|
|
|
|
|
|
|
1616
|
|
|
|
|
|
|
L<HTML::FormHandler::Manual::Rendering> |
1617
|
|
|
|
|
|
|
|
1618
|
|
|
|
|
|
|
L<HTML::FormHandler::Manual::Reference> |
1619
|
|
|
|
|
|
|
|
1620
|
|
|
|
|
|
|
L<HTML::FormHandler::Field> |
1621
|
|
|
|
|
|
|
|
1622
|
|
|
|
|
|
|
L<HTML::FormHandler::Model::DBIC> |
1623
|
|
|
|
|
|
|
|
1624
|
|
|
|
|
|
|
L<HTML::FormHandler::Render::Simple> |
1625
|
|
|
|
|
|
|
|
1626
|
|
|
|
|
|
|
L<HTML::FormHandler::Render::Table> |
1627
|
|
|
|
|
|
|
|
1628
|
|
|
|
|
|
|
L<HTML::FormHandler::Moose> |
1629
|
|
|
|
|
|
|
|
1630
|
|
|
|
|
|
|
=head1 CONTRIBUTORS |
1631
|
|
|
|
|
|
|
|
1632
|
|
|
|
|
|
|
gshank: Gerda Shank E<lt>gshank@cpan.orgE<gt> |
1633
|
|
|
|
|
|
|
|
1634
|
|
|
|
|
|
|
zby: Zbigniew Lukasiak E<lt>zby@cpan.orgE<gt> |
1635
|
|
|
|
|
|
|
|
1636
|
|
|
|
|
|
|
t0m: Tomas Doran E<lt>bobtfish@bobtfish.netE<gt> |
1637
|
|
|
|
|
|
|
|
1638
|
|
|
|
|
|
|
augensalat: Bernhard Graf E<lt>augensalat@gmail.comE<gt> |
1639
|
|
|
|
|
|
|
|
1640
|
|
|
|
|
|
|
cubuanic: Oleg Kostyuk E<lt>cub.uanic@gmail.comE<gt> |
1641
|
|
|
|
|
|
|
|
1642
|
|
|
|
|
|
|
rafl: Florian Ragwitz E<lt>rafl@debian.orgE<gt> |
1643
|
|
|
|
|
|
|
|
1644
|
|
|
|
|
|
|
mazpe: Lester Ariel Mesa |
1645
|
|
|
|
|
|
|
|
1646
|
|
|
|
|
|
|
dew: Dan Thomas |
1647
|
|
|
|
|
|
|
|
1648
|
|
|
|
|
|
|
koki: Klaus Ita |
1649
|
|
|
|
|
|
|
|
1650
|
|
|
|
|
|
|
jnapiorkowski: John Napiorkowski |
1651
|
|
|
|
|
|
|
|
1652
|
|
|
|
|
|
|
lestrrat: Daisuke Maki |
1653
|
|
|
|
|
|
|
|
1654
|
|
|
|
|
|
|
hobbs: Andrew Rodland |
1655
|
|
|
|
|
|
|
|
1656
|
|
|
|
|
|
|
Andy Clayton |
1657
|
|
|
|
|
|
|
|
1658
|
|
|
|
|
|
|
boghead: Bryan Beeley |
1659
|
|
|
|
|
|
|
|
1660
|
|
|
|
|
|
|
Csaba Hetenyi |
1661
|
|
|
|
|
|
|
|
1662
|
|
|
|
|
|
|
Eisuke Oishi |
1663
|
|
|
|
|
|
|
|
1664
|
|
|
|
|
|
|
Lian Wan Situ |
1665
|
|
|
|
|
|
|
|
1666
|
|
|
|
|
|
|
Murray |
1667
|
|
|
|
|
|
|
|
1668
|
|
|
|
|
|
|
Nick Logan |
1669
|
|
|
|
|
|
|
|
1670
|
|
|
|
|
|
|
Vladimir Timofeev |
1671
|
|
|
|
|
|
|
|
1672
|
|
|
|
|
|
|
diegok: Diego Kuperman |
1673
|
|
|
|
|
|
|
|
1674
|
|
|
|
|
|
|
ijw: Ian Wells |
1675
|
|
|
|
|
|
|
|
1676
|
|
|
|
|
|
|
amiri: Amiri Barksdale |
1677
|
|
|
|
|
|
|
|
1678
|
|
|
|
|
|
|
ozum: Ozum Eldogan |
1679
|
|
|
|
|
|
|
|
1680
|
|
|
|
|
|
|
lukast: Lukas Thiemeier |
1681
|
|
|
|
|
|
|
|
1682
|
|
|
|
|
|
|
Initially based on the source code of L<Form::Processor> by Bill Moseley |
1683
|
|
|
|
|
|
|
|
1684
|
|
|
|
|
|
|
=head1 AUTHOR |
1685
|
|
|
|
|
|
|
|
1686
|
|
|
|
|
|
|
FormHandler Contributors - see HTML::FormHandler |
1687
|
|
|
|
|
|
|
|
1688
|
|
|
|
|
|
|
=head1 COPYRIGHT AND LICENSE |
1689
|
|
|
|
|
|
|
|
1690
|
|
|
|
|
|
|
This software is copyright (c) 2014 by Gerda Shank. |
1691
|
|
|
|
|
|
|
|
1692
|
|
|
|
|
|
|
This is free software; you can redistribute it and/or modify it under |
1693
|
|
|
|
|
|
|
the same terms as the Perl 5 programming language system itself. |
1694
|
|
|
|
|
|
|
|
1695
|
|
|
|
|
|
|
=cut |