line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Data::MuForm::Field; |
2
|
|
|
|
|
|
|
# ABSTRACT: Base field package |
3
|
92
|
|
|
92
|
|
45466
|
use Moo; |
|
92
|
|
|
|
|
117
|
|
|
92
|
|
|
|
|
401
|
|
4
|
92
|
|
|
92
|
|
21516
|
use Types::Standard -types; |
|
92
|
|
|
|
|
418198
|
|
|
92
|
|
|
|
|
810
|
|
5
|
92
|
|
|
92
|
|
250654
|
use Try::Tiny; |
|
92
|
|
|
|
|
19012
|
|
|
92
|
|
|
|
|
4791
|
|
6
|
92
|
|
|
92
|
|
373
|
use Scalar::Util ('blessed', 'weaken'); |
|
92
|
|
|
|
|
111
|
|
|
92
|
|
|
|
|
3650
|
|
7
|
92
|
|
|
92
|
|
9025
|
use Data::Clone ('data_clone'); |
|
92
|
|
|
|
|
23398
|
|
|
92
|
|
|
|
|
3255
|
|
8
|
92
|
|
|
92
|
|
8657
|
use Data::MuForm::Localizer; |
|
92
|
|
|
|
|
150
|
|
|
92
|
|
|
|
|
1807
|
|
9
|
92
|
|
|
92
|
|
8590
|
use Data::MuForm::Merge ('merge'); |
|
92
|
|
|
|
|
135
|
|
|
92
|
|
|
|
|
243461
|
|
10
|
|
|
|
|
|
|
with 'Data::MuForm::Common'; |
11
|
|
|
|
|
|
|
|
12
|
|
|
|
|
|
|
has 'name' => ( is => 'rw', required => 1 ); |
13
|
|
|
|
|
|
|
has 'id' => ( is => 'rw', lazy => 1, builder => 'build_id' ); |
14
|
|
|
|
|
|
|
sub build_id { |
15
|
78
|
|
|
78
|
1
|
5639
|
my $self = shift; |
16
|
78
|
100
|
33
|
|
|
200
|
if ( my $meth = $self->get_method('build_id') ) { |
|
|
50
|
|
|
|
|
|
17
|
3
|
|
|
|
|
10
|
return $meth->($self, @_); |
18
|
|
|
|
|
|
|
} |
19
|
|
|
|
|
|
|
elsif ( $self->form && $self->form->can('build_field_id') ) { |
20
|
0
|
|
|
|
|
0
|
return $self->form->build_field_id($self); |
21
|
|
|
|
|
|
|
} |
22
|
75
|
|
|
|
|
2726
|
return $self->prefixed_name; |
23
|
|
|
|
|
|
|
} |
24
|
|
|
|
|
|
|
has 'prefixed_name' => ( is => 'rw', lazy => 1, builder => 'build_prefixed_name'); |
25
|
|
|
|
|
|
|
sub build_prefixed_name { |
26
|
76
|
|
|
76
|
0
|
5087
|
my $self = shift; |
27
|
76
|
50
|
33
|
|
|
1126
|
my $prefix = ( $self->form && $self->form->field_prefix ) ? $self->field_prefix. "." : ''; |
28
|
76
|
|
|
|
|
1925
|
return $prefix . $self->full_name; |
29
|
|
|
|
|
|
|
} |
30
|
|
|
|
|
|
|
has 'form' => ( is => 'rw', weak_ref => 1, predicate => 'has_form' ); |
31
|
|
|
|
|
|
|
has 'type' => ( is => 'ro', required => 1, default => 'Text' ); |
32
|
|
|
|
|
|
|
has 'default' => ( is => 'rw' ); |
33
|
|
|
|
|
|
|
has 'input' => ( is => 'rw', predicate => 'has_input', clearer => 'clear_input' ); |
34
|
|
|
|
|
|
|
has 'input_without_param' => ( is => 'rw', predicate => 'has_input_without_param' ); |
35
|
|
|
|
|
|
|
has 'value' => ( is => 'rw', predicate => 'has_value', clearer => 'clear_value' ); |
36
|
|
|
|
|
|
|
has 'init_value' => ( is => 'rw', predicate => 'has_init_value', clearer => 'clear_init_value' ); |
37
|
|
|
|
|
|
|
has 'no_value_if_empty' => ( is => 'rw' ); |
38
|
|
|
|
|
|
|
has 'input_param' => ( is => 'rw' ); |
39
|
|
|
|
|
|
|
has 'filled_from' => ( is => 'rw', clearer => 'clear_filled_from' ); |
40
|
|
|
|
|
|
|
has 'password' => ( is => 'rw', default => 0 ); |
41
|
|
|
|
|
|
|
has 'accessor' => ( is => 'rw', lazy => 1, builder => 'build_accessor' ); |
42
|
|
|
|
|
|
|
sub build_accessor { |
43
|
443
|
|
|
443
|
0
|
19494
|
my $self = shift; |
44
|
443
|
|
|
|
|
823
|
my $accessor = $self->name; |
45
|
443
|
50
|
|
|
|
878
|
$accessor =~ s/^(.*)\.//g if ( $accessor =~ /\./ ); |
46
|
443
|
|
|
|
|
2118
|
return $accessor; |
47
|
|
|
|
|
|
|
} |
48
|
|
|
|
|
|
|
has 'custom' => ( is => 'rw' ); |
49
|
|
|
|
|
|
|
has 'parent' => ( is => 'rw', predicate => 'has_parent', weak_ref => 1 ); |
50
|
|
|
|
|
|
|
has 'source' => ( is => 'rw' ); |
51
|
|
|
|
|
|
|
has 'errors' => ( is => 'rw', isa => ArrayRef, default => sub {[]} ); |
52
|
663
|
|
|
663
|
0
|
11335
|
sub has_errors { my $self = shift; return scalar @{$self->errors}; } |
|
663
|
|
|
|
|
507
|
|
|
663
|
|
|
|
|
10716
|
|
53
|
18
|
|
|
18
|
0
|
545
|
sub all_errors { my $self = shift; return @{$self->errors}; } |
|
18
|
|
|
|
|
12
|
|
|
18
|
|
|
|
|
247
|
|
54
|
750
|
|
|
750
|
0
|
4048
|
sub clear_errors { $_[0]->{errors} = [] } |
55
|
|
|
|
343
|
0
|
|
sub clear_error_fields { } |
56
|
|
|
|
|
|
|
|
57
|
|
|
|
|
|
|
# this is a permanent setting of active |
58
|
|
|
|
|
|
|
has 'active' => ( is => 'rw', default => 1 ); |
59
|
|
|
|
|
|
|
# this is a temporary active set on the process call, cleared on clear_data |
60
|
|
|
|
|
|
|
has '_active' => ( is => 'rw', predicate => '_has_active', clearer => '_clear_active' ); |
61
|
1
|
|
|
1
|
0
|
11
|
sub clear_inactive { $_[0]->active(1) } |
62
|
0
|
0
|
|
0
|
1
|
0
|
sub inactive { return ( shift->active ? 0 : 1 ) } |
63
|
|
|
|
|
|
|
sub is_active { |
64
|
4945
|
|
|
4945
|
1
|
3503
|
my $self = shift; |
65
|
4945
|
100
|
|
|
|
7780
|
return $self->_active if $self->_has_active; |
66
|
4933
|
|
|
|
|
14299
|
return $self->active; |
67
|
|
|
|
|
|
|
} |
68
|
|
|
|
418
|
0
|
|
sub multiple { } |
69
|
2
|
|
|
2
|
1
|
15
|
sub is_inactive { ! $_[0]->is_active } |
70
|
|
|
|
|
|
|
has 'disabled' => ( is => 'rw', default => 0 ); |
71
|
|
|
|
|
|
|
has 'no_update' => ( is => 'rw', default => 0 ); |
72
|
|
|
|
|
|
|
has 'writeonly' => ( is => 'rw', default => 0 ); |
73
|
|
|
|
|
|
|
has 'is_contains' => ( is => 'rw' ); |
74
|
|
|
|
|
|
|
has 'apply' => ( is => 'rw', default => sub {[]} ); # for field defnitions |
75
|
0
|
|
|
0
|
0
|
0
|
sub has_apply { return scalar @{$_[0]->{apply}} } |
|
0
|
|
|
|
|
0
|
|
76
|
|
|
|
|
|
|
has 'base_apply' => ( is => 'rw', builder => 'build_base_apply' ); # for field classes |
77
|
634
|
|
|
634
|
0
|
12084
|
sub build_base_apply {[]} |
78
|
0
|
|
|
0
|
0
|
0
|
sub has_base_apply { return scalar @{$_[0]->{base_apply}} } |
|
0
|
|
|
|
|
0
|
|
79
|
|
|
|
|
|
|
has 'trim' => ( is => 'rw', default => sub { *default_trim } ); |
80
|
|
|
|
|
|
|
sub default_trim { |
81
|
525
|
|
|
525
|
0
|
581
|
my $value = shift; |
82
|
525
|
100
|
|
|
|
769
|
return unless defined $value; |
83
|
523
|
100
|
|
|
|
1139
|
my @values = ref $value eq 'ARRAY' ? @$value : ($value); |
84
|
523
|
|
|
|
|
719
|
for (@values) { |
85
|
561
|
100
|
100
|
|
|
1849
|
next if ref $_ or !defined; |
86
|
478
|
|
|
|
|
823
|
s/^\s+//; |
87
|
478
|
|
|
|
|
925
|
s/\s+$//; |
88
|
|
|
|
|
|
|
} |
89
|
523
|
100
|
|
|
|
1778
|
return ref $value eq 'ARRAY' ? \@values : $values[0]; |
90
|
|
|
|
|
|
|
} |
91
|
|
|
|
2098
|
0
|
|
sub has_fields { } # compound fields will override |
92
|
|
|
|
|
|
|
has 'methods' => ( is => 'rw', isa => HashRef, builder => 'build_methods', trigger => 1 ); |
93
|
637
|
|
|
637
|
0
|
18090
|
sub build_methods {{}} |
94
|
|
|
|
|
|
|
sub _trigger_methods { |
95
|
6
|
|
|
6
|
|
174
|
my ( $self, $new_methods ) = @_; |
96
|
6
|
|
|
|
|
20
|
my $base_methods = $self->build_methods; |
97
|
6
|
|
|
|
|
26
|
my $methods = merge($new_methods, $base_methods); |
98
|
6
|
|
|
|
|
99
|
$self->{methods} = $methods; |
99
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
} |
101
|
|
|
|
|
|
|
sub get_method { |
102
|
1527
|
|
|
1527
|
0
|
1523
|
my ( $self, $meth_name ) = @_; |
103
|
1527
|
|
|
|
|
5745
|
return $self->{methods}->{$meth_name}; |
104
|
|
|
|
|
|
|
} |
105
|
|
|
|
|
|
|
|
106
|
|
|
|
|
|
|
has 'validate_when_empty' => ( is => 'rw' ); |
107
|
|
|
|
|
|
|
has 'not_nullable' => ( is => 'rw' ); |
108
|
|
|
|
1089
|
0
|
|
sub is_repeatable {} |
109
|
|
|
|
3
|
0
|
|
sub is_compound {} |
110
|
128
|
|
|
128
|
0
|
1221
|
sub is_form {0} |
111
|
289
|
|
|
289
|
0
|
756
|
sub no_fif {0} |
112
|
|
|
|
|
|
|
|
113
|
|
|
|
|
|
|
around BUILDARGS => sub { |
114
|
|
|
|
|
|
|
my ( $orig, $class, %field_attr ) = @_; |
115
|
|
|
|
|
|
|
|
116
|
|
|
|
|
|
|
munge_field_attr(\%field_attr); |
117
|
|
|
|
|
|
|
|
118
|
|
|
|
|
|
|
return $class->$orig(%field_attr); |
119
|
|
|
|
|
|
|
}; |
120
|
|
|
|
|
|
|
|
121
|
|
|
|
|
|
|
|
122
|
|
|
|
|
|
|
sub BUILD { |
123
|
636
|
|
|
636
|
0
|
6704
|
my $self = shift; |
124
|
|
|
|
|
|
|
|
125
|
636
|
100
|
|
|
|
8643
|
if ( $self->form ) { |
126
|
|
|
|
|
|
|
# To avoid memory cycles it needs to be weakened when |
127
|
|
|
|
|
|
|
# it's set through a form. |
128
|
588
|
|
|
|
|
26472
|
weaken($self->{localizer}); |
129
|
588
|
|
|
|
|
1160
|
weaken($self->{renderer}); |
130
|
|
|
|
|
|
|
} |
131
|
|
|
|
|
|
|
else { |
132
|
|
|
|
|
|
|
# Vivify. This would generally only happen in a standalone field, in tests. |
133
|
48
|
|
|
|
|
5066
|
$self->localizer; |
134
|
48
|
|
|
|
|
12269
|
$self->renderer; |
135
|
|
|
|
|
|
|
} |
136
|
|
|
|
|
|
|
|
137
|
636
|
|
|
|
|
2298
|
$self->_install_methods; |
138
|
|
|
|
|
|
|
} |
139
|
|
|
|
|
|
|
|
140
|
|
|
|
|
|
|
sub _install_methods { |
141
|
636
|
|
|
636
|
|
672
|
my $self = shift; |
142
|
|
|
|
|
|
|
|
143
|
636
|
100
|
|
|
|
10432
|
if ( $self->form ) { |
144
|
588
|
|
|
|
|
3957
|
my $suffix = $self->convert_full_name($self->full_name); |
145
|
588
|
|
|
|
|
1065
|
foreach my $prefix ( 'validate', 'default' ) { |
146
|
1176
|
100
|
|
|
|
21375
|
next if exists $self->methods->{$prefix}; |
147
|
1175
|
|
|
|
|
43522
|
my $meth_name = "${prefix}_$suffix"; |
148
|
1175
|
100
|
|
|
|
14605
|
if ( my $meth = $self->form->can($meth_name) ) { |
149
|
|
|
|
|
|
|
my $wrap_sub = sub { |
150
|
26
|
|
|
26
|
|
36
|
my $self = shift; |
151
|
26
|
|
|
|
|
452
|
return $self->form->$meth($self); |
152
|
19
|
|
|
|
|
169
|
}; |
153
|
19
|
|
|
|
|
128
|
$self->{methods}->{$prefix} = $wrap_sub; |
154
|
|
|
|
|
|
|
} |
155
|
|
|
|
|
|
|
} |
156
|
|
|
|
|
|
|
} |
157
|
|
|
|
|
|
|
} |
158
|
|
|
|
|
|
|
|
159
|
|
|
|
|
|
|
|
160
|
|
|
|
|
|
|
sub fif { |
161
|
423
|
|
|
423
|
1
|
5382
|
my $self = shift; |
162
|
423
|
50
|
|
|
|
552
|
return unless $self->is_active; |
163
|
423
|
50
|
|
|
|
909
|
return '' if $self->password; |
164
|
423
|
100
|
|
|
|
1489
|
return $self->input if $self->has_input; |
165
|
204
|
100
|
|
|
|
422
|
if ( $self->has_value ) { |
166
|
122
|
|
|
|
|
258
|
my $value = $self->value; |
167
|
122
|
100
|
|
|
|
309
|
$value = $self->transform_value_to_fif->($self, $value) if $self->has_transform_value_to_fif; |
168
|
122
|
|
|
|
|
273
|
return $value; |
169
|
|
|
|
|
|
|
} |
170
|
82
|
|
|
|
|
370
|
return ''; |
171
|
|
|
|
|
|
|
} |
172
|
|
|
|
|
|
|
|
173
|
|
|
|
|
|
|
|
174
|
|
|
|
|
|
|
sub full_name { |
175
|
2019
|
|
|
2019
|
1
|
4383
|
my $field = shift; |
176
|
|
|
|
|
|
|
|
177
|
2019
|
|
|
|
|
3680
|
my $name = $field->name; |
178
|
2019
|
|
|
|
|
2205
|
my $parent_name; |
179
|
|
|
|
|
|
|
# field should always have a parent unless it's a standalone field test |
180
|
2019
|
100
|
|
|
|
25641
|
if ( $field->parent ) { |
181
|
2004
|
|
|
|
|
57631
|
$parent_name = $field->parent->full_name; |
182
|
|
|
|
|
|
|
} |
183
|
2019
|
100
|
100
|
|
|
14518
|
return $name unless defined $parent_name && length $parent_name; |
184
|
550
|
|
|
|
|
1957
|
return $parent_name . '.' . $name; |
185
|
|
|
|
|
|
|
} |
186
|
|
|
|
|
|
|
|
187
|
|
|
|
|
|
|
sub full_accessor { |
188
|
0
|
|
|
0
|
1
|
0
|
my $field = shift; |
189
|
|
|
|
|
|
|
|
190
|
0
|
|
|
|
|
0
|
my $parent = $field->parent; |
191
|
0
|
0
|
|
|
|
0
|
if( $field->is_contains ) { |
192
|
0
|
0
|
|
|
|
0
|
return '' unless $parent; |
193
|
0
|
|
|
|
|
0
|
return $parent->full_accessor; |
194
|
|
|
|
|
|
|
} |
195
|
0
|
|
|
|
|
0
|
my $accessor = $field->accessor; |
196
|
0
|
|
|
|
|
0
|
my $parent_accessor; |
197
|
0
|
0
|
|
|
|
0
|
if ( $parent ) { |
198
|
0
|
|
|
|
|
0
|
$parent_accessor = $parent->full_accessor; |
199
|
|
|
|
|
|
|
} |
200
|
0
|
0
|
0
|
|
|
0
|
return $accessor unless defined $parent_accessor && length $parent_accessor; |
201
|
0
|
|
|
|
|
0
|
return $parent_accessor . '.' . $accessor; |
202
|
|
|
|
|
|
|
} |
203
|
|
|
|
|
|
|
|
204
|
|
|
|
|
|
|
|
205
|
|
|
|
|
|
|
#==================== |
206
|
|
|
|
|
|
|
# Localization |
207
|
|
|
|
|
|
|
#==================== |
208
|
|
|
|
|
|
|
|
209
|
|
|
|
|
|
|
sub localize { |
210
|
95
|
|
|
95
|
0
|
274
|
my ( $self, @message ) = @_; |
211
|
95
|
|
|
|
|
1432
|
return $self->localizer->loc_($message[0]); |
212
|
|
|
|
|
|
|
} |
213
|
|
|
|
|
|
|
|
214
|
|
|
|
|
|
|
has 'language' => ( is => 'rw', lazy => 1, builder => 'build_language' ); |
215
|
33
|
|
|
33
|
0
|
5649
|
sub build_language { 'en' } |
216
|
|
|
|
|
|
|
has 'localizer' => ( |
217
|
|
|
|
|
|
|
is => 'rw', lazy => 1, builder => 'build_localizer', |
218
|
|
|
|
|
|
|
); |
219
|
|
|
|
|
|
|
sub build_localizer { |
220
|
33
|
|
|
33
|
0
|
5162
|
my $self = shift; |
221
|
33
|
|
|
|
|
318
|
return Data::MuForm::Localizer->new( |
222
|
|
|
|
|
|
|
language => $self->language, |
223
|
|
|
|
|
|
|
); |
224
|
|
|
|
|
|
|
} |
225
|
|
|
|
|
|
|
|
226
|
|
|
|
|
|
|
#==================== |
227
|
|
|
|
|
|
|
# Rendering |
228
|
|
|
|
|
|
|
#==================== |
229
|
|
|
|
|
|
|
has 'label' => ( is => 'rw', lazy => 1, builder => 'build_label' ); |
230
|
|
|
|
|
|
|
sub build_label { |
231
|
97
|
|
|
97
|
1
|
8644
|
my $self = shift; |
232
|
97
|
100
|
|
|
|
242
|
if ( my $meth = $self->get_method('build_label' ) ) { |
233
|
1
|
|
|
|
|
4
|
return $meth->($self); |
234
|
|
|
|
|
|
|
} |
235
|
96
|
|
|
|
|
229
|
my $label = $self->name; |
236
|
96
|
|
|
|
|
142
|
$label =~ s/_/ /g; |
237
|
96
|
|
|
|
|
186
|
$label = ucfirst($label); |
238
|
96
|
|
|
|
|
515
|
return $label; |
239
|
|
|
|
|
|
|
} |
240
|
|
|
|
|
|
|
sub loc_label { |
241
|
95
|
|
|
95
|
0
|
1287
|
my $self = shift; |
242
|
95
|
|
|
|
|
1314
|
return $self->localize($self->label); |
243
|
|
|
|
|
|
|
} |
244
|
|
|
|
|
|
|
has 'form_element' => ( is => 'rw', lazy => 1, builder => 'build_form_element' ); |
245
|
61
|
|
|
61
|
0
|
3668
|
sub build_form_element { 'input' } |
246
|
|
|
|
|
|
|
has 'input_type' => ( is => 'rw', lazy => 1, builder => 'build_input_type' ); |
247
|
20
|
|
|
20
|
0
|
2400
|
sub build_input_type { 'text' } |
248
|
|
|
|
|
|
|
|
249
|
|
|
|
|
|
|
# could have everything in one big "pass to the renderer" hash? |
250
|
|
|
|
|
|
|
has 'layout' => ( is => 'rw' ); |
251
|
|
|
|
|
|
|
has 'layout_group' => ( is => 'rw' ); |
252
|
|
|
|
|
|
|
has 'order' => ( is => 'rw', default => 0 ); |
253
|
|
|
|
|
|
|
has 'html5_type_attr' => ( is => 'rw' ); |
254
|
|
|
|
|
|
|
|
255
|
|
|
|
|
|
|
sub base_render_args { |
256
|
83
|
|
|
83
|
0
|
811
|
my $self = shift; |
257
|
83
|
|
50
|
|
|
1256
|
my $args = { |
258
|
|
|
|
|
|
|
name => $self->prefixed_name, |
259
|
|
|
|
|
|
|
field_name => $self->name, |
260
|
|
|
|
|
|
|
type => $self->type, |
261
|
|
|
|
|
|
|
form_element => $self->form_element, |
262
|
|
|
|
|
|
|
input_type => $self->input_type, |
263
|
|
|
|
|
|
|
id => $self->id, |
264
|
|
|
|
|
|
|
label => $self->loc_label, |
265
|
|
|
|
|
|
|
required => $self->required, |
266
|
|
|
|
|
|
|
errors => $self->errors || [], |
267
|
|
|
|
|
|
|
fif => $self->fif, |
268
|
|
|
|
|
|
|
layout_type => 'standard', |
269
|
|
|
|
|
|
|
is_contains => $self->is_contains, |
270
|
|
|
|
|
|
|
}; |
271
|
83
|
|
|
|
|
230
|
return $args; |
272
|
|
|
|
|
|
|
} |
273
|
|
|
|
|
|
|
|
274
|
|
|
|
|
|
|
has 'render_args' => ( is => 'rw', lazy => 1, isa => HashRef, builder => 'build_render_args' ); |
275
|
58
|
|
|
58
|
0
|
7385
|
sub build_render_args {{}} |
276
|
|
|
|
|
|
|
# this is really just here for testing fields. If you want to test a custom |
277
|
|
|
|
|
|
|
# renderer in a field, pass it in. |
278
|
|
|
|
|
|
|
has 'renderer' => ( |
279
|
|
|
|
|
|
|
is => 'rw', lazy => 1, |
280
|
|
|
|
|
|
|
builder => 'build_renderer', |
281
|
|
|
|
|
|
|
); |
282
|
|
|
|
|
|
|
sub build_renderer { |
283
|
33
|
|
|
33
|
0
|
5235
|
my $self = shift; |
284
|
33
|
|
|
|
|
8132
|
require Data::MuForm::Renderer::Base; |
285
|
33
|
|
|
|
|
743
|
return Data::MuForm::Renderer::Base->new( localizer => $self->localizer ); |
286
|
|
|
|
|
|
|
} |
287
|
|
|
|
|
|
|
|
288
|
|
|
|
|
|
|
sub get_render_args { |
289
|
83
|
|
|
83
|
0
|
150
|
my ( $self, %args ) = @_; |
290
|
83
|
|
|
|
|
1348
|
my $render_args = merge( $self->render_args, $self->base_render_args ); |
291
|
83
|
|
|
|
|
257
|
$render_args = merge( \%args, $render_args ); |
292
|
83
|
|
|
|
|
245
|
return $render_args; |
293
|
|
|
|
|
|
|
} |
294
|
|
|
|
|
|
|
|
295
|
|
|
|
|
|
|
sub render { |
296
|
57
|
|
|
57
|
0
|
244
|
my ( $self, $rargs ) = @_; |
297
|
57
|
|
|
|
|
172
|
munge_render_field_attr($rargs); |
298
|
57
|
|
|
|
|
185
|
my $render_args = $self->get_render_args(%$rargs); |
299
|
57
|
|
|
|
|
1013
|
return $self->renderer->render_field($render_args); |
300
|
|
|
|
|
|
|
} |
301
|
|
|
|
|
|
|
|
302
|
|
|
|
|
|
|
sub render_element { |
303
|
9
|
|
|
9
|
0
|
106
|
my ( $self, $rargs ) = @_; |
304
|
9
|
|
|
|
|
21
|
my $args = { element_attr => $rargs }; |
305
|
9
|
|
|
|
|
14
|
my $do_errors = delete $rargs->{do_errors}; |
306
|
9
|
50
|
|
|
|
30
|
$args->{do_errors} = defined $do_errors ? $do_errors : 1; |
307
|
9
|
|
|
|
|
44
|
my $render_args = $self->get_render_args(%$args); |
308
|
9
|
|
|
|
|
170
|
return $self->renderer->render_element($render_args); |
309
|
|
|
|
|
|
|
} |
310
|
|
|
|
|
|
|
|
311
|
|
|
|
|
|
|
sub render_errors { |
312
|
1
|
|
|
1
|
0
|
10
|
my ( $self, $rargs ) = @_; |
313
|
1
|
|
|
|
|
3
|
my $render_args = $self->get_render_args( error_attr => $rargs ); |
314
|
1
|
|
|
|
|
19
|
return $self->renderer->render_errors($render_args); |
315
|
|
|
|
|
|
|
} |
316
|
|
|
|
|
|
|
|
317
|
|
|
|
|
|
|
sub render_label { |
318
|
1
|
|
|
1
|
0
|
10
|
my ( $self, $rargs, @args ) = @_; |
319
|
1
|
|
|
|
|
4
|
my $render_args = $self->get_render_args( label_attr => $rargs ); |
320
|
1
|
50
|
|
|
|
19
|
$self->form->render_hook($render_args) if $self->form; |
321
|
1
|
|
|
|
|
17
|
return $self->renderer->render_label($render_args, @args); |
322
|
|
|
|
|
|
|
} |
323
|
|
|
|
|
|
|
|
324
|
|
|
|
|
|
|
|
325
|
|
|
|
|
|
|
#=================== |
326
|
|
|
|
|
|
|
# Errors |
327
|
|
|
|
|
|
|
#=================== |
328
|
|
|
|
|
|
|
|
329
|
|
|
|
|
|
|
# handles message with and without variables |
330
|
|
|
|
|
|
|
sub add_error { |
331
|
109
|
|
|
109
|
1
|
560
|
my ( $self, @message ) = @_; |
332
|
109
|
|
|
|
|
97
|
my $out; |
333
|
109
|
100
|
|
|
|
293
|
if ( $message[0] !~ /{/ ) { |
334
|
72
|
|
|
|
|
1228
|
$out = $self->localizer->loc_($message[0]); |
335
|
|
|
|
|
|
|
} |
336
|
|
|
|
|
|
|
else { |
337
|
37
|
|
|
|
|
562
|
$out = $self->localizer->loc_x(@message); |
338
|
|
|
|
|
|
|
} |
339
|
109
|
|
|
|
|
600
|
return $self->push_error($out); |
340
|
|
|
|
|
|
|
} |
341
|
|
|
|
|
|
|
|
342
|
|
|
|
|
|
|
sub add_error_px { |
343
|
0
|
|
|
0
|
0
|
0
|
my ( $self, @message ) = @_; |
344
|
0
|
|
|
|
|
0
|
my $out = $self->localizer->loc_px(@message); |
345
|
0
|
|
|
|
|
0
|
return $self->push_error($out);; |
346
|
|
|
|
|
|
|
} |
347
|
|
|
|
|
|
|
|
348
|
|
|
|
|
|
|
sub add_error_nx { |
349
|
1
|
|
|
1
|
0
|
2
|
my ( $self, @message ) = @_; |
350
|
1
|
|
|
|
|
21
|
my $out = $self->localizer->loc_nx(@message); |
351
|
1
|
|
|
|
|
20
|
return $self->push_error($out); |
352
|
|
|
|
|
|
|
} |
353
|
|
|
|
|
|
|
|
354
|
|
|
|
|
|
|
sub add_error_npx { |
355
|
0
|
|
|
0
|
0
|
0
|
my ( $self, @message ) = @_; |
356
|
0
|
|
|
|
|
0
|
my $out = $self->localizer->loc_npx(@message); |
357
|
0
|
|
|
|
|
0
|
return $self->push_error($out);; |
358
|
|
|
|
|
|
|
} |
359
|
|
|
|
|
|
|
|
360
|
|
|
|
|
|
|
|
361
|
|
|
|
|
|
|
|
362
|
|
|
|
|
|
|
sub push_error { |
363
|
110
|
|
|
110
|
1
|
130
|
my $self = shift; |
364
|
110
|
|
|
|
|
106
|
push @{$self->{errors}}, @_; |
|
110
|
|
|
|
|
277
|
|
365
|
110
|
100
|
|
|
|
1872
|
if ( $self->parent ) { |
366
|
65
|
|
|
|
|
1166
|
$self->parent->propagate_error($self); |
367
|
|
|
|
|
|
|
} |
368
|
|
|
|
|
|
|
} |
369
|
|
|
|
|
|
|
|
370
|
7
|
|
|
7
|
0
|
3720
|
sub clear { shift->clear_data } |
371
|
|
|
|
|
|
|
|
372
|
|
|
|
|
|
|
#=================== |
373
|
|
|
|
|
|
|
# Transforms |
374
|
|
|
|
|
|
|
#=================== |
375
|
|
|
|
|
|
|
|
376
|
|
|
|
|
|
|
# these are all coderefs |
377
|
|
|
|
|
|
|
has 'transform_param_to_input' => ( is => 'rw', predicate => 'has_transform_param_to_input' ); |
378
|
|
|
|
|
|
|
has 'transform_input_to_value' => ( is => 'rw', predicate => 'has_transform_input_to_value' ); |
379
|
|
|
|
|
|
|
has 'transform_default_to_value' => ( is => 'rw', predicate => 'has_transform_default_to_value' ); |
380
|
|
|
|
|
|
|
has 'transform_value_after_validate' => ( is => 'rw', predicate => 'has_transform_value_after_validate' ); |
381
|
|
|
|
|
|
|
has 'transform_value_to_fif' => ( is => 'rw', predicate => 'has_transform_value_to_fif' ); |
382
|
|
|
|
|
|
|
|
383
|
|
|
|
|
|
|
#==================================================================== |
384
|
|
|
|
|
|
|
# Validation |
385
|
|
|
|
|
|
|
#==================================================================== |
386
|
|
|
|
|
|
|
|
387
|
|
|
|
|
|
|
has 'required' => ( is => 'rw', default => 0 ); |
388
|
|
|
|
|
|
|
has 'required_when' => ( is => 'rw', isa => HashRef, predicate => 'has_required_when' ); |
389
|
|
|
|
|
|
|
has 'unique' => ( is => 'rw', predicate => 'has_unique' ); |
390
|
1
|
50
|
|
1
|
0
|
10
|
sub validated { !$_[0]->has_errors && $_[0]->has_input } |
391
|
|
|
|
198
|
0
|
|
sub normalize_input { } # intended for field classes, to make sure input is in correct form, mostly multiple or not |
392
|
|
|
|
|
|
|
|
393
|
|
|
|
|
|
|
sub input_defined { |
394
|
585
|
|
|
585
|
0
|
619
|
my ($self) = @_; |
395
|
585
|
50
|
|
|
|
991
|
return unless $self->has_input; |
396
|
585
|
|
|
|
|
985
|
return has_some_value( $self->input ); |
397
|
|
|
|
|
|
|
} |
398
|
|
|
|
|
|
|
|
399
|
|
|
|
|
|
|
sub has_some_value { |
400
|
682
|
|
|
682
|
0
|
636
|
my $x = shift; |
401
|
|
|
|
|
|
|
|
402
|
682
|
100
|
|
|
|
977
|
return unless defined $x; |
403
|
678
|
100
|
|
|
|
3083
|
return $x =~ /\S/ if !ref $x; |
404
|
94
|
100
|
|
|
|
265
|
if ( ref $x eq 'ARRAY' ) { |
405
|
23
|
|
|
|
|
42
|
for my $elem (@$x) { |
406
|
24
|
100
|
|
|
|
50
|
return 1 if has_some_value($elem); |
407
|
|
|
|
|
|
|
} |
408
|
3
|
|
|
|
|
11
|
return 0; |
409
|
|
|
|
|
|
|
} |
410
|
71
|
50
|
|
|
|
135
|
if ( ref $x eq 'HASH' ) { |
411
|
71
|
|
|
|
|
148
|
for my $key ( keys %$x ) { |
412
|
73
|
100
|
|
|
|
139
|
return 1 if has_some_value( $x->{$key} ); |
413
|
|
|
|
|
|
|
} |
414
|
7
|
|
|
|
|
23
|
return 0; |
415
|
|
|
|
|
|
|
} |
416
|
0
|
0
|
|
|
|
0
|
return 1 if blessed($x); # true if blessed, otherwise false |
417
|
0
|
0
|
|
|
|
0
|
return 1 if ref( $x ); |
418
|
0
|
|
|
|
|
0
|
return; |
419
|
|
|
|
|
|
|
} |
420
|
|
|
|
|
|
|
|
421
|
|
|
|
|
|
|
|
422
|
|
|
|
|
|
|
|
423
|
|
|
|
0
|
0
|
|
sub base_validate { } |
424
|
442
|
|
|
442
|
1
|
3179
|
sub validate {1} |
425
|
|
|
|
|
|
|
|
426
|
|
|
|
|
|
|
sub field_validate { |
427
|
610
|
|
|
610
|
0
|
41129
|
my $self = shift; |
428
|
|
|
|
|
|
|
|
429
|
610
|
50
|
66
|
|
|
1119
|
return if ( $self->has_fields && $self->skip_fields_without_input && ! $self->has_input ); |
|
|
|
33
|
|
|
|
|
430
|
|
|
|
|
|
|
|
431
|
610
|
|
|
|
|
1394
|
$self->normalize_input; |
432
|
|
|
|
|
|
|
|
433
|
610
|
|
|
|
|
984
|
my $continue_validation = 1; |
434
|
610
|
100
|
66
|
|
|
3968
|
if ( ( $self->required || |
|
|
100
|
100
|
|
|
|
|
|
|
100
|
100
|
|
|
|
|
|
|
100
|
|
|
|
|
|
435
|
|
|
|
|
|
|
( $self->has_required_when && $self->match_when($self->required_when) ) ) && |
436
|
|
|
|
|
|
|
( ! $self->has_input || ! $self->input_defined )) { |
437
|
24
|
|
|
|
|
123
|
$self->add_error( $self->get_message('required'), field_label => $self->label ); |
438
|
24
|
100
|
|
|
|
994
|
if( $self->has_input ) { |
439
|
16
|
50
|
|
|
|
165
|
$self->not_nullable ? $self->value($self->input) : $self->value(undef); |
440
|
|
|
|
|
|
|
} |
441
|
|
|
|
|
|
|
|
442
|
24
|
|
|
|
|
33
|
$continue_validation = 0; |
443
|
|
|
|
|
|
|
} |
444
|
|
|
|
|
|
|
elsif ( $self->is_repeatable ) { } |
445
|
|
|
|
|
|
|
elsif ( !$self->has_input ) { |
446
|
39
|
|
|
|
|
46
|
$continue_validation = 0; |
447
|
|
|
|
|
|
|
} |
448
|
|
|
|
|
|
|
elsif ( !$self->input_defined ) { |
449
|
19
|
100
|
100
|
|
|
207
|
if ( $self->not_nullable ) { |
|
|
100
|
|
|
|
|
|
450
|
3
|
|
|
|
|
28
|
$self->value($self->input); |
451
|
|
|
|
|
|
|
# handles the case where a compound field value needs to have empty subfields |
452
|
3
|
50
|
|
|
|
19
|
$continue_validation = 0 unless $self->is_compound; |
453
|
|
|
|
|
|
|
} |
454
|
|
|
|
|
|
|
elsif ( $self->no_value_if_empty || $self->is_contains ) { |
455
|
2
|
|
|
|
|
3
|
$continue_validation = 0; |
456
|
|
|
|
|
|
|
} |
457
|
|
|
|
|
|
|
else { |
458
|
14
|
|
|
|
|
90
|
$self->value(undef); |
459
|
14
|
|
|
|
|
23
|
$continue_validation = 0; |
460
|
|
|
|
|
|
|
} |
461
|
|
|
|
|
|
|
} |
462
|
610
|
50
|
66
|
|
|
1422
|
return if ( !$continue_validation && !$self->validate_when_empty ); |
463
|
|
|
|
|
|
|
|
464
|
|
|
|
|
|
|
|
465
|
528
|
100
|
|
|
|
765
|
if ( $self->has_fields ) { |
466
|
75
|
|
|
|
|
339
|
$self->fields_validate; |
467
|
|
|
|
|
|
|
} |
468
|
|
|
|
|
|
|
else { |
469
|
453
|
|
|
|
|
640
|
my $input = $self->input; |
470
|
453
|
100
|
|
|
|
1102
|
$input = $self->transform_input_to_value->($self, $input) if $self->has_transform_input_to_value; |
471
|
453
|
|
|
|
|
1241
|
$self->value($input); |
472
|
|
|
|
|
|
|
} |
473
|
|
|
|
|
|
|
|
474
|
528
|
100
|
|
|
|
2432
|
$self->value( $self->trim->($self->value) ) if $self->trim; |
475
|
|
|
|
|
|
|
|
476
|
528
|
|
|
|
|
1744
|
$self->validate($self->value); # this is field class validation. Do it before the other validations. |
477
|
|
|
|
|
|
|
|
478
|
528
|
|
|
|
|
2746
|
$self->apply_actions; # this could be either from the field definitions or from a custom field |
479
|
|
|
|
|
|
|
|
480
|
|
|
|
|
|
|
# this is validate_<field name> or methods->{validate => ...} validation |
481
|
528
|
100
|
|
|
|
1330
|
if ( my $meth = $self->get_method('validate') ) { |
482
|
19
|
|
|
|
|
30
|
$meth->($self); |
483
|
|
|
|
|
|
|
} |
484
|
|
|
|
|
|
|
|
485
|
528
|
100
|
|
|
|
1515
|
if ( $self->has_transform_value_after_validate ) { |
486
|
6
|
|
|
|
|
12
|
my $value = $self->value; |
487
|
6
|
|
|
|
|
24
|
$value = $self->transform_value_after_validate->($self, $value); |
488
|
6
|
|
|
|
|
35
|
$self->value($value); |
489
|
|
|
|
|
|
|
} |
490
|
|
|
|
|
|
|
|
491
|
528
|
|
|
|
|
996
|
return ! $self->has_errors; |
492
|
|
|
|
|
|
|
} |
493
|
|
|
|
|
|
|
|
494
|
|
|
|
|
|
|
sub transform_and_set_input { |
495
|
416
|
|
|
416
|
0
|
396
|
my ( $self, $input ) = @_; |
496
|
416
|
100
|
|
|
|
1016
|
$input = $self->transform_param_to_input->($self, $input) if $self->has_transform_param_to_input; |
497
|
416
|
|
|
|
|
867
|
$self->input($input); |
498
|
|
|
|
|
|
|
} |
499
|
|
|
|
|
|
|
|
500
|
|
|
|
|
|
|
|
501
|
|
|
|
|
|
|
sub apply_actions { |
502
|
528
|
|
|
528
|
0
|
494
|
my $self = shift; |
503
|
|
|
|
|
|
|
|
504
|
528
|
|
|
|
|
389
|
my $error_message; |
505
|
|
|
|
|
|
|
local $SIG{__WARN__} = sub { |
506
|
2
|
|
|
2
|
|
15
|
my $error = shift; |
507
|
2
|
|
|
|
|
3
|
$error_message = $error; |
508
|
2
|
|
|
|
|
14
|
return 1; |
509
|
528
|
|
|
|
|
2491
|
}; |
510
|
|
|
|
|
|
|
|
511
|
|
|
|
|
|
|
my $is_type = sub { |
512
|
229
|
100
|
|
229
|
|
750
|
my $class = blessed shift or return; |
513
|
183
|
|
33
|
|
|
584
|
return $class eq 'MooseX::Types::TypeDecorator' || $class->isa('Type::Tiny'); |
514
|
528
|
|
|
|
|
1109
|
}; |
515
|
|
|
|
|
|
|
|
516
|
528
|
|
|
|
|
455
|
my @actions; |
517
|
528
|
|
|
|
|
452
|
push @actions, @{ $self->base_apply }, @{ $self->apply }; |
|
528
|
|
|
|
|
1198
|
|
|
528
|
|
|
|
|
1068
|
|
518
|
528
|
|
|
|
|
2211
|
for my $action ( @actions ) { |
519
|
134
|
|
|
|
|
460
|
$error_message = undef; |
520
|
|
|
|
|
|
|
# the first time through value == input |
521
|
134
|
|
|
|
|
157
|
my $value = $self->value; |
522
|
134
|
|
|
|
|
101
|
my $new_value = $value; |
523
|
|
|
|
|
|
|
# Moose constraints |
524
|
134
|
100
|
66
|
|
|
349
|
if ( !ref $action || $is_type->($action) ) { |
525
|
88
|
|
|
|
|
886
|
$action = { type => $action }; |
526
|
|
|
|
|
|
|
} |
527
|
134
|
100
|
|
|
|
296
|
if ( my $when = $action->{when} ) { |
528
|
6
|
100
|
|
|
|
15
|
next unless $self->match_when($when); |
529
|
|
|
|
|
|
|
} |
530
|
131
|
100
|
|
|
|
262
|
if ( exists $action->{type} ) { |
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
531
|
95
|
|
|
|
|
69
|
my $tobj; |
532
|
95
|
50
|
|
|
|
140
|
if ( $is_type->($action->{type}) ) { |
533
|
95
|
|
|
|
|
571
|
$tobj = $action->{type}; |
534
|
|
|
|
|
|
|
} |
535
|
|
|
|
|
|
|
else { |
536
|
0
|
|
|
|
|
0
|
my $type = $action->{type}; |
537
|
0
|
0
|
|
|
|
0
|
$tobj = Moose::Util::TypeConstraints::find_type_constraint($type) or |
538
|
|
|
|
|
|
|
die "Cannot find type constraint $type"; |
539
|
|
|
|
|
|
|
} |
540
|
95
|
100
|
100
|
|
|
214
|
if ( $tobj->has_coercion && $tobj->validate($value) ) { |
541
|
14
|
|
|
|
|
486
|
eval { $new_value = $tobj->coerce($value) }; |
|
14
|
|
|
|
|
36
|
|
542
|
14
|
50
|
|
|
|
39
|
if ($@) { |
543
|
0
|
0
|
|
|
|
0
|
if ( $tobj->has_message ) { |
544
|
0
|
|
|
|
|
0
|
$error_message = $tobj->message->($value); |
545
|
|
|
|
|
|
|
} |
546
|
|
|
|
|
|
|
else { |
547
|
0
|
|
|
|
|
0
|
$error_message = $@; |
548
|
|
|
|
|
|
|
} |
549
|
|
|
|
|
|
|
} |
550
|
|
|
|
|
|
|
else { |
551
|
14
|
|
|
|
|
35
|
$self->value($new_value); |
552
|
|
|
|
|
|
|
} |
553
|
|
|
|
|
|
|
|
554
|
|
|
|
|
|
|
} |
555
|
95
|
|
66
|
|
|
928
|
$error_message ||= $tobj->validate($new_value); |
556
|
|
|
|
|
|
|
} |
557
|
|
|
|
|
|
|
# now maybe: http://search.cpan.org/~rgarcia/perl-5.10.0/pod/perlsyn.pod#Smart_matching_in_detail |
558
|
|
|
|
|
|
|
# actions in a hashref |
559
|
|
|
|
|
|
|
elsif ( ref $action->{check} eq 'CODE' ) { |
560
|
11
|
100
|
|
|
|
29
|
if ( !$action->{check}->($value, $self) ) { |
561
|
3
|
|
|
|
|
21
|
$error_message = $self->get_message('wrong_value'); |
562
|
|
|
|
|
|
|
} |
563
|
|
|
|
|
|
|
} |
564
|
|
|
|
|
|
|
elsif ( ref $action->{check} eq 'Regexp' ) { |
565
|
6
|
100
|
|
|
|
29
|
if ( $value !~ $action->{check} ) { |
566
|
5
|
|
|
|
|
23
|
$error_message = [$self->get_message('no_match'), 'value', $value]; |
567
|
|
|
|
|
|
|
} |
568
|
|
|
|
|
|
|
} |
569
|
|
|
|
|
|
|
elsif ( ref $action->{check} eq 'ARRAY' ) { |
570
|
5
|
100
|
|
|
|
7
|
if ( !grep { $value eq $_ } @{ $action->{check} } ) { |
|
5
|
|
|
|
|
10
|
|
|
5
|
|
|
|
|
11
|
|
571
|
4
|
|
|
|
|
10
|
$error_message = [$self->get_message('not_allowed'), 'value', $value]; |
572
|
|
|
|
|
|
|
} |
573
|
|
|
|
|
|
|
} |
574
|
|
|
|
|
|
|
elsif ( ref $action->{transform} eq 'CODE' ) { |
575
|
14
|
|
|
|
|
16
|
$new_value = eval { |
576
|
92
|
|
|
92
|
|
512
|
no warnings 'all'; |
|
92
|
|
|
|
|
198
|
|
|
92
|
|
|
|
|
89587
|
|
577
|
14
|
|
|
|
|
29
|
$action->{transform}->($value, $self); |
578
|
|
|
|
|
|
|
}; |
579
|
14
|
50
|
|
|
|
37
|
if ($@) { |
580
|
0
|
|
0
|
|
|
0
|
$error_message = $@ || $self->get_message('error_occurred'); |
581
|
|
|
|
|
|
|
} |
582
|
|
|
|
|
|
|
else { |
583
|
14
|
|
|
|
|
23
|
$self->value($new_value); |
584
|
|
|
|
|
|
|
} |
585
|
|
|
|
|
|
|
} |
586
|
131
|
100
|
|
|
|
2640
|
if ( defined $error_message ) { |
587
|
50
|
100
|
|
|
|
139
|
my @message = ref $error_message eq 'ARRAY' ? @$error_message : ($error_message); |
588
|
50
|
100
|
|
|
|
92
|
if ( defined $action->{message} ) { |
589
|
13
|
|
|
|
|
16
|
my $act_msg = $action->{message}; |
590
|
13
|
100
|
|
|
|
29
|
if ( ref $act_msg eq 'CODE' ) { |
591
|
3
|
|
|
|
|
10
|
$act_msg = $act_msg->($value, $self, $error_message); |
592
|
|
|
|
|
|
|
} |
593
|
13
|
100
|
|
|
|
55
|
if ( ref $act_msg eq 'ARRAY' ) { |
|
|
50
|
|
|
|
|
|
594
|
3
|
|
|
|
|
3
|
@message = @{$act_msg}; |
|
3
|
|
|
|
|
8
|
|
595
|
|
|
|
|
|
|
} |
596
|
|
|
|
|
|
|
elsif ( ref \$act_msg eq 'SCALAR' ) { |
597
|
10
|
|
|
|
|
18
|
@message = ($act_msg); |
598
|
|
|
|
|
|
|
} |
599
|
|
|
|
|
|
|
} |
600
|
50
|
|
|
|
|
126
|
$self->add_error(@message); |
601
|
|
|
|
|
|
|
} |
602
|
|
|
|
|
|
|
} |
603
|
|
|
|
|
|
|
} |
604
|
|
|
|
|
|
|
|
605
|
|
|
|
|
|
|
sub match_when { |
606
|
12
|
|
|
12
|
0
|
460
|
my ( $self, $when ) = @_; |
607
|
|
|
|
|
|
|
|
608
|
12
|
|
|
|
|
12
|
my $matched = 0; |
609
|
12
|
|
|
|
|
24
|
foreach my $key ( keys %$when ) { |
610
|
12
|
|
|
|
|
16
|
my $check_against = $when->{$key}; |
611
|
12
|
|
|
|
|
21
|
my $from_form = ( $key =~ /^\+/ ); |
612
|
12
|
|
|
|
|
16
|
$key =~ s/^\+//; |
613
|
12
|
100
|
|
|
|
222
|
my $field = $from_form ? $self->form->field($key) : $self->parent->subfield( $key ); |
614
|
12
|
50
|
|
|
|
65
|
unless ( $field ) { |
615
|
0
|
|
|
|
|
0
|
warn "field '$key' not found processing 'when' for '" . $self->full_name . "'"; |
616
|
0
|
|
|
|
|
0
|
next; |
617
|
|
|
|
|
|
|
} |
618
|
12
|
50
|
|
|
|
33
|
my $field_fif = defined $field->fif ? $field->fif : ''; |
619
|
12
|
100
|
|
|
|
45
|
if ( ref $check_against eq 'CODE' ) { |
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
620
|
4
|
100
|
|
|
|
15
|
$matched++ |
621
|
|
|
|
|
|
|
if $check_against->($field_fif, $self); |
622
|
|
|
|
|
|
|
} |
623
|
|
|
|
|
|
|
elsif ( ref $check_against eq 'ARRAY' ) { |
624
|
2
|
|
|
|
|
4
|
foreach my $value ( @$check_against ) { |
625
|
6
|
100
|
|
|
|
12
|
$matched++ if ( $value eq $field_fif ); |
626
|
|
|
|
|
|
|
} |
627
|
|
|
|
|
|
|
} |
628
|
|
|
|
|
|
|
elsif ( $check_against eq $field_fif ) { |
629
|
3
|
|
|
|
|
5
|
$matched++; |
630
|
|
|
|
|
|
|
} |
631
|
|
|
|
|
|
|
else { |
632
|
3
|
|
|
|
|
2
|
$matched = 0; |
633
|
3
|
|
|
|
|
6
|
last; |
634
|
|
|
|
|
|
|
} |
635
|
|
|
|
|
|
|
} |
636
|
12
|
|
|
|
|
70
|
return $matched; |
637
|
|
|
|
|
|
|
} |
638
|
|
|
|
|
|
|
|
639
|
|
|
|
|
|
|
#==================================================================== |
640
|
|
|
|
|
|
|
# Filling |
641
|
|
|
|
|
|
|
#==================================================================== |
642
|
|
|
|
|
|
|
|
643
|
|
|
|
|
|
|
sub fill_from_params { |
644
|
410
|
|
|
410
|
0
|
722
|
my ( $self, $input, $exists ) = @_; |
645
|
|
|
|
|
|
|
|
646
|
410
|
|
|
|
|
813
|
$self->filled_from('params'); |
647
|
410
|
100
|
|
|
|
762
|
if ( $exists ) { |
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
648
|
341
|
|
|
|
|
655
|
$self->transform_and_set_input($input); |
649
|
|
|
|
|
|
|
} |
650
|
|
|
|
|
|
|
elsif ( $self->disabled ) { |
651
|
|
|
|
|
|
|
} |
652
|
|
|
|
|
|
|
elsif ( $self->has_input_without_param ) { |
653
|
20
|
|
|
|
|
150
|
$self->transform_and_set_input($self->input_without_param); |
654
|
|
|
|
|
|
|
} |
655
|
410
|
|
|
|
|
593
|
return; |
656
|
|
|
|
|
|
|
} |
657
|
|
|
|
|
|
|
|
658
|
|
|
|
|
|
|
sub fill_from_object { |
659
|
210
|
|
|
210
|
0
|
313
|
my ( $self, $value ) = @_; |
660
|
|
|
|
|
|
|
|
661
|
210
|
|
|
|
|
408
|
$self->filled_from('object'); |
662
|
210
|
|
|
|
|
518
|
$self->value($value); |
663
|
|
|
|
|
|
|
|
664
|
210
|
50
|
|
|
|
3023
|
if ( $self->form ) { |
665
|
210
|
|
|
|
|
3206
|
$self->form->init_value( $self, $value ); |
666
|
|
|
|
|
|
|
} |
667
|
|
|
|
|
|
|
else { |
668
|
0
|
|
|
|
|
0
|
$self->init_value($value); |
669
|
|
|
|
|
|
|
#$result->_set_value($value); |
670
|
|
|
|
|
|
|
} |
671
|
210
|
50
|
|
|
|
1143
|
$self->value(undef) if $self->writeonly; |
672
|
|
|
|
|
|
|
|
673
|
210
|
|
|
|
|
336
|
return; |
674
|
|
|
|
|
|
|
} |
675
|
|
|
|
|
|
|
|
676
|
|
|
|
|
|
|
sub fill_from_fields { |
677
|
588
|
|
|
588
|
0
|
1126
|
my ( $self ) = @_; |
678
|
|
|
|
|
|
|
|
679
|
588
|
100
|
|
|
|
2664
|
if ( my @values = $self->get_default_value ) { |
680
|
36
|
100
|
|
|
|
144
|
if ( $self->has_transform_default_to_value ) { |
681
|
2
|
|
|
|
|
7
|
@values = $self->transform_default_to_value->($self, @values); |
682
|
|
|
|
|
|
|
} |
683
|
36
|
50
|
|
|
|
84
|
my $value = @values > 1 ? \@values : shift @values; |
684
|
36
|
50
|
|
|
|
59
|
if ( defined $value ) { |
685
|
36
|
|
|
|
|
86
|
$self->init_value($value); |
686
|
36
|
|
|
|
|
136
|
$self->value($value); |
687
|
|
|
|
|
|
|
} |
688
|
|
|
|
|
|
|
} |
689
|
588
|
|
|
|
|
740
|
return; |
690
|
|
|
|
|
|
|
} |
691
|
|
|
|
|
|
|
|
692
|
|
|
|
|
|
|
|
693
|
|
|
|
|
|
|
sub clear_data { |
694
|
294
|
|
|
294
|
0
|
273
|
my $self = shift; |
695
|
294
|
|
|
|
|
3577
|
$self->clear_input; |
696
|
294
|
|
|
|
|
14398
|
$self->clear_value; |
697
|
294
|
|
|
|
|
13048
|
$self->clear_errors; |
698
|
294
|
|
|
|
|
3389
|
$self->_clear_active; |
699
|
294
|
|
|
|
|
12998
|
$self->clear_filled_from; |
700
|
|
|
|
|
|
|
} |
701
|
|
|
|
|
|
|
|
702
|
|
|
|
|
|
|
sub get_default_value { |
703
|
716
|
|
|
716
|
0
|
578
|
my $self = shift; |
704
|
716
|
100
|
|
|
|
1328
|
if ( my $meth = $self->get_method('default') ) { |
|
|
100
|
|
|
|
|
|
705
|
10
|
|
|
|
|
28
|
return $meth->($self); |
706
|
|
|
|
|
|
|
} |
707
|
|
|
|
|
|
|
elsif ( defined $self->default ) { |
708
|
37
|
|
|
|
|
114
|
return $self->default; |
709
|
|
|
|
|
|
|
} |
710
|
669
|
|
|
|
|
1435
|
return; |
711
|
|
|
|
|
|
|
} |
712
|
|
|
|
|
|
|
|
713
|
|
|
|
|
|
|
|
714
|
|
|
|
|
|
|
#==================================================================== |
715
|
|
|
|
|
|
|
# Messages |
716
|
|
|
|
|
|
|
#==================================================================== |
717
|
|
|
|
|
|
|
|
718
|
|
|
|
|
|
|
has 'messages' => ( is => 'rw', isa => HashRef, default => sub {{}} ); |
719
|
4
|
|
|
4
|
|
9
|
sub _get_field_message { my ($self, $msg) = @_; return $self->{messages}->{$msg}; } |
|
4
|
|
|
|
|
71
|
|
720
|
66
|
|
|
66
|
|
76
|
sub _has_field_message { my ($self, $msg) = @_; exists $self->{messages}->{$msg}; } |
|
66
|
|
|
|
|
207
|
|
721
|
0
|
|
|
0
|
0
|
0
|
sub set_message { my ($self, $msg, $value) = @_; $self->{messages}->{$msg} = $value; } |
|
0
|
|
|
|
|
0
|
|
722
|
|
|
|
|
|
|
|
723
|
|
|
|
|
|
|
|
724
|
|
|
|
|
|
|
our $class_messages = { |
725
|
|
|
|
|
|
|
'field_invalid' => 'field is invalid', |
726
|
|
|
|
|
|
|
'range_too_low' => 'Value must be greater than or equal to [_1]', |
727
|
|
|
|
|
|
|
'range_too_high' => 'Value must be less than or equal to [_1]', |
728
|
|
|
|
|
|
|
'range_incorrect' => 'Value must be between {start} and {end}', |
729
|
|
|
|
|
|
|
'wrong_value' => 'Wrong value', |
730
|
|
|
|
|
|
|
'no_match' => '[_1] does not match', |
731
|
|
|
|
|
|
|
'not_allowed' => '[_1] not allowed', |
732
|
|
|
|
|
|
|
'error_occurred' => 'error occurred', |
733
|
|
|
|
|
|
|
'required' => "'{field_label}' field is required", |
734
|
|
|
|
|
|
|
'unique' => 'Duplicate value for [_1]', # this is used in the DBIC model |
735
|
|
|
|
|
|
|
}; |
736
|
|
|
|
|
|
|
|
737
|
|
|
|
|
|
|
sub get_class_messages { |
738
|
61
|
|
|
61
|
0
|
1242
|
my $self = shift; |
739
|
61
|
|
|
|
|
417
|
my $messages = { %$class_messages }; |
740
|
61
|
|
|
|
|
532
|
return $messages; |
741
|
|
|
|
|
|
|
} |
742
|
|
|
|
|
|
|
|
743
|
|
|
|
|
|
|
sub get_message { |
744
|
66
|
|
|
66
|
0
|
107
|
my ( $self, $msg ) = @_; |
745
|
|
|
|
|
|
|
|
746
|
|
|
|
|
|
|
# first look in messages set on individual field |
747
|
66
|
100
|
|
|
|
218
|
return $self->_get_field_message($msg) |
748
|
|
|
|
|
|
|
if $self->_has_field_message($msg); |
749
|
|
|
|
|
|
|
# then look at form messages |
750
|
62
|
100
|
100
|
|
|
936
|
return $self->form->_get_form_message($msg) |
751
|
|
|
|
|
|
|
if $self->has_form && $self->form->_has_form_message($msg); |
752
|
|
|
|
|
|
|
# then look for messages up through inherited field classes |
753
|
61
|
|
|
|
|
8489
|
return $self->get_class_messages->{$msg}; |
754
|
|
|
|
|
|
|
} |
755
|
|
|
|
|
|
|
sub all_messages { |
756
|
0
|
|
|
0
|
0
|
0
|
my $self = shift; |
757
|
0
|
0
|
|
|
|
0
|
my $form_messages = $self->has_form ? $self->form->messages : {}; |
758
|
0
|
|
0
|
|
|
0
|
my $field_messages = $self->messages || {}; |
759
|
0
|
|
0
|
|
|
0
|
my $lclass_messages = $self->my_class_messages || {}; |
760
|
0
|
|
|
|
|
0
|
return {%{$lclass_messages}, %{$form_messages}, %{$field_messages}}; |
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
761
|
|
|
|
|
|
|
} |
762
|
|
|
|
|
|
|
|
763
|
|
|
|
|
|
|
sub clone { |
764
|
4892
|
|
|
4892
|
0
|
3520
|
my $self = shift; |
765
|
4892
|
|
|
|
|
89579
|
return data_clone($self); |
766
|
|
|
|
|
|
|
} |
767
|
|
|
|
|
|
|
|
768
|
|
|
|
|
|
|
sub get_result { |
769
|
2
|
|
|
2
|
0
|
3
|
my $self = shift; |
770
|
2
|
|
|
|
|
7
|
my $result = { |
771
|
|
|
|
|
|
|
name => $self->name, |
772
|
|
|
|
|
|
|
full_name => $self->full_name, |
773
|
|
|
|
|
|
|
id => $self->id, |
774
|
|
|
|
|
|
|
label => $self->label, |
775
|
|
|
|
|
|
|
render_args => $self->render_args, |
776
|
|
|
|
|
|
|
fif => $self->fif, |
777
|
|
|
|
|
|
|
}; |
778
|
2
|
50
|
|
|
|
6
|
$result->{errors} = $self->errors if $self->has_errors; |
779
|
2
|
|
|
|
|
411
|
return $result; |
780
|
|
|
|
|
|
|
} |
781
|
|
|
|
|
|
|
|
782
|
|
|
|
|
|
|
sub convert_full_name { |
783
|
632
|
|
|
632
|
0
|
769
|
my ( $self, $full_name ) = @_; |
784
|
632
|
|
|
|
|
901
|
$full_name =~ s/\.\d+\./_/g; |
785
|
632
|
|
|
|
|
935
|
$full_name =~ s/\./_/g; |
786
|
632
|
|
|
|
|
954
|
return $full_name; |
787
|
|
|
|
|
|
|
} |
788
|
|
|
|
|
|
|
|
789
|
|
|
|
|
|
|
|
790
|
|
|
|
|
|
|
1; |
791
|
|
|
|
|
|
|
|
792
|
|
|
|
|
|
|
__END__ |
793
|
|
|
|
|
|
|
|
794
|
|
|
|
|
|
|
=pod |
795
|
|
|
|
|
|
|
|
796
|
|
|
|
|
|
|
=encoding UTF-8 |
797
|
|
|
|
|
|
|
|
798
|
|
|
|
|
|
|
=head1 NAME |
799
|
|
|
|
|
|
|
|
800
|
|
|
|
|
|
|
Data::MuForm::Field - Base field package |
801
|
|
|
|
|
|
|
|
802
|
|
|
|
|
|
|
=head1 VERSION |
803
|
|
|
|
|
|
|
|
804
|
|
|
|
|
|
|
version 0.03 |
805
|
|
|
|
|
|
|
|
806
|
|
|
|
|
|
|
=head1 SYNOPSIS |
807
|
|
|
|
|
|
|
|
808
|
|
|
|
|
|
|
Instances of Field subclasses are generally built by L<Data::MuForm> |
809
|
|
|
|
|
|
|
from 'has_field' declarations or the field_list. |
810
|
|
|
|
|
|
|
|
811
|
|
|
|
|
|
|
has_field 'my_field' => ( type => 'Integer' ); |
812
|
|
|
|
|
|
|
field_list => [ |
813
|
|
|
|
|
|
|
my_field => { type => 'Integer' } |
814
|
|
|
|
|
|
|
] |
815
|
|
|
|
|
|
|
|
816
|
|
|
|
|
|
|
Fields can also be added with add_field: |
817
|
|
|
|
|
|
|
|
818
|
|
|
|
|
|
|
$form->add_field( name => 'my_field', type => 'Integer' ); |
819
|
|
|
|
|
|
|
|
820
|
|
|
|
|
|
|
You can create custom field classes: |
821
|
|
|
|
|
|
|
|
822
|
|
|
|
|
|
|
package MyApp::Field::MyText; |
823
|
|
|
|
|
|
|
use Moo; |
824
|
|
|
|
|
|
|
use Data::MuForm::Meta; |
825
|
|
|
|
|
|
|
extends 'Data::MuForm::Field::Text'; |
826
|
|
|
|
|
|
|
|
827
|
|
|
|
|
|
|
has 'my_attribute' => ( is => 'rw' ); |
828
|
|
|
|
|
|
|
|
829
|
|
|
|
|
|
|
sub validate { <perform validation> } |
830
|
|
|
|
|
|
|
|
831
|
|
|
|
|
|
|
1; |
832
|
|
|
|
|
|
|
|
833
|
|
|
|
|
|
|
=head1 DESCRIPTION |
834
|
|
|
|
|
|
|
|
835
|
|
|
|
|
|
|
This is the base class for form fields. The 'type' of a field class |
836
|
|
|
|
|
|
|
is used in the MuForm field_list or has_field to identify which field class to |
837
|
|
|
|
|
|
|
load from the 'field_namespace' (or directly, when prefixed with '+'). |
838
|
|
|
|
|
|
|
If the type is not specified, it defaults to Text. |
839
|
|
|
|
|
|
|
|
840
|
|
|
|
|
|
|
See L<Data::MuForm::Manual::Fields> for a list of the fields and brief |
841
|
|
|
|
|
|
|
descriptions of their structure. |
842
|
|
|
|
|
|
|
|
843
|
|
|
|
|
|
|
=head1 NAME |
844
|
|
|
|
|
|
|
|
845
|
|
|
|
|
|
|
Data::MuForm::Field |
846
|
|
|
|
|
|
|
|
847
|
|
|
|
|
|
|
=head1 ATTRIBUTES |
848
|
|
|
|
|
|
|
|
849
|
|
|
|
|
|
|
=head2 Names, types, accessor |
850
|
|
|
|
|
|
|
|
851
|
|
|
|
|
|
|
=over |
852
|
|
|
|
|
|
|
|
853
|
|
|
|
|
|
|
=item name |
854
|
|
|
|
|
|
|
|
855
|
|
|
|
|
|
|
The name of the field. Used in the HTML form. Often a db accessor. |
856
|
|
|
|
|
|
|
The only required attribute. |
857
|
|
|
|
|
|
|
|
858
|
|
|
|
|
|
|
=item type |
859
|
|
|
|
|
|
|
|
860
|
|
|
|
|
|
|
The class or type of the field. The 'type' of L<Data::MuForm::Field::Currency> |
861
|
|
|
|
|
|
|
is 'Currency'. Classes that you define yourself are prefixed with '+'. |
862
|
|
|
|
|
|
|
|
863
|
|
|
|
|
|
|
=item id |
864
|
|
|
|
|
|
|
|
865
|
|
|
|
|
|
|
The id to use when rendering. |
866
|
|
|
|
|
|
|
|
867
|
|
|
|
|
|
|
=item accessor |
868
|
|
|
|
|
|
|
|
869
|
|
|
|
|
|
|
If the name of your field is different than your database accessor, use |
870
|
|
|
|
|
|
|
this attribute to provide the accessor. |
871
|
|
|
|
|
|
|
|
872
|
|
|
|
|
|
|
=item full_name |
873
|
|
|
|
|
|
|
|
874
|
|
|
|
|
|
|
The name of the field with all parents: |
875
|
|
|
|
|
|
|
|
876
|
|
|
|
|
|
|
'event.start_date.month' |
877
|
|
|
|
|
|
|
|
878
|
|
|
|
|
|
|
=item full_accessor |
879
|
|
|
|
|
|
|
|
880
|
|
|
|
|
|
|
The field accessor with all parents. |
881
|
|
|
|
|
|
|
|
882
|
|
|
|
|
|
|
=item prefixed_name |
883
|
|
|
|
|
|
|
|
884
|
|
|
|
|
|
|
The full_name plus the prefix provided in 'field_prefix'. Useful for multiple |
885
|
|
|
|
|
|
|
forms on the same page. |
886
|
|
|
|
|
|
|
|
887
|
|
|
|
|
|
|
=item input_param |
888
|
|
|
|
|
|
|
|
889
|
|
|
|
|
|
|
By default we expect an input parameter based on the field name. This allows |
890
|
|
|
|
|
|
|
you to look for a different input parameter. |
891
|
|
|
|
|
|
|
|
892
|
|
|
|
|
|
|
=back |
893
|
|
|
|
|
|
|
|
894
|
|
|
|
|
|
|
=head2 Field data |
895
|
|
|
|
|
|
|
|
896
|
|
|
|
|
|
|
=over |
897
|
|
|
|
|
|
|
|
898
|
|
|
|
|
|
|
=item active, inactive, is_active, is_inactive |
899
|
|
|
|
|
|
|
|
900
|
|
|
|
|
|
|
Determines which fields will be processed and rendered. |
901
|
|
|
|
|
|
|
|
902
|
|
|
|
|
|
|
Can be changed on a process call, and cleared afterward: |
903
|
|
|
|
|
|
|
|
904
|
|
|
|
|
|
|
$form->process( active => [ 'foo', 'bar' ], params => $params ); |
905
|
|
|
|
|
|
|
|
906
|
|
|
|
|
|
|
You can use the is_inactive and is_active methods to check whether this particular |
907
|
|
|
|
|
|
|
field is active. May be necessary to use in templates if you're changing the |
908
|
|
|
|
|
|
|
active/inactive of some fields. |
909
|
|
|
|
|
|
|
|
910
|
|
|
|
|
|
|
if( $form->field('foo')->is_active ) { ... } |
911
|
|
|
|
|
|
|
|
912
|
|
|
|
|
|
|
=item input |
913
|
|
|
|
|
|
|
|
914
|
|
|
|
|
|
|
The input string from the parameters passed in. This is not usually set by |
915
|
|
|
|
|
|
|
the user. |
916
|
|
|
|
|
|
|
|
917
|
|
|
|
|
|
|
=item value |
918
|
|
|
|
|
|
|
|
919
|
|
|
|
|
|
|
The value as it would come from or go into the database, after being |
920
|
|
|
|
|
|
|
acted on by transforms and validation code. Used to construct the |
921
|
|
|
|
|
|
|
C<< $form->values >> hash. Before validation is performed, the input is |
922
|
|
|
|
|
|
|
copied to the 'value', and validation and constraints should act on 'value'. |
923
|
|
|
|
|
|
|
After validation, C<< $form->value >> will get a hashref of the values. |
924
|
|
|
|
|
|
|
|
925
|
|
|
|
|
|
|
See also L<Data::MuForm::Manual::Transforms>. |
926
|
|
|
|
|
|
|
|
927
|
|
|
|
|
|
|
=item fif |
928
|
|
|
|
|
|
|
|
929
|
|
|
|
|
|
|
Values used to fill in the form. Read only. |
930
|
|
|
|
|
|
|
|
931
|
|
|
|
|
|
|
[% form.field('title').fif %] |
932
|
|
|
|
|
|
|
|
933
|
|
|
|
|
|
|
=item init_value |
934
|
|
|
|
|
|
|
|
935
|
|
|
|
|
|
|
Initial value populated by fill_from_object. You can tell if a field |
936
|
|
|
|
|
|
|
has changed by comparing 'init_value' and 'value'. You wouldn't normally |
937
|
|
|
|
|
|
|
change this. |
938
|
|
|
|
|
|
|
|
939
|
|
|
|
|
|
|
=item input_without_param |
940
|
|
|
|
|
|
|
|
941
|
|
|
|
|
|
|
Input for this field if there is no param. Set by default for Checkbox, |
942
|
|
|
|
|
|
|
and Select, since an unchecked checkbox or unselected pulldown |
943
|
|
|
|
|
|
|
does not return a parameter. |
944
|
|
|
|
|
|
|
|
945
|
|
|
|
|
|
|
=back |
946
|
|
|
|
|
|
|
|
947
|
|
|
|
|
|
|
=head2 Form, parent, etc |
948
|
|
|
|
|
|
|
|
949
|
|
|
|
|
|
|
=over |
950
|
|
|
|
|
|
|
|
951
|
|
|
|
|
|
|
=item form |
952
|
|
|
|
|
|
|
|
953
|
|
|
|
|
|
|
A reference to the containing form. |
954
|
|
|
|
|
|
|
|
955
|
|
|
|
|
|
|
=item parent |
956
|
|
|
|
|
|
|
|
957
|
|
|
|
|
|
|
A reference to the parent of this field. Compound fields are the |
958
|
|
|
|
|
|
|
parents for the fields they contain. |
959
|
|
|
|
|
|
|
|
960
|
|
|
|
|
|
|
=item localizer |
961
|
|
|
|
|
|
|
|
962
|
|
|
|
|
|
|
Set from the form when fields are created. |
963
|
|
|
|
|
|
|
|
964
|
|
|
|
|
|
|
=item renderer |
965
|
|
|
|
|
|
|
|
966
|
|
|
|
|
|
|
Set from the form when fields are created. |
967
|
|
|
|
|
|
|
|
968
|
|
|
|
|
|
|
=back |
969
|
|
|
|
|
|
|
|
970
|
|
|
|
|
|
|
=head2 Errors |
971
|
|
|
|
|
|
|
|
972
|
|
|
|
|
|
|
=over |
973
|
|
|
|
|
|
|
|
974
|
|
|
|
|
|
|
=item errors |
975
|
|
|
|
|
|
|
|
976
|
|
|
|
|
|
|
Returns the error list (arrayref) for the field. Also provides |
977
|
|
|
|
|
|
|
'all_errors', 'num_errors', 'has_errors', 'push_error' and 'clear_errors'. |
978
|
|
|
|
|
|
|
Use 'add_error' to add an error to the array if you |
979
|
|
|
|
|
|
|
want to localize the error message, or 'push_error' to skip |
980
|
|
|
|
|
|
|
the localization. |
981
|
|
|
|
|
|
|
|
982
|
|
|
|
|
|
|
=item add_error |
983
|
|
|
|
|
|
|
|
984
|
|
|
|
|
|
|
Add an error to the list of errors. Error message will be localized |
985
|
|
|
|
|
|
|
using 'localize' method, and the Localizer (default is |
986
|
|
|
|
|
|
|
Data::MuForm::Localizer, which use a gettext style .po file). |
987
|
|
|
|
|
|
|
|
988
|
|
|
|
|
|
|
return $field->add_error( 'bad data' ) if $bad; |
989
|
|
|
|
|
|
|
|
990
|
|
|
|
|
|
|
=item push_error |
991
|
|
|
|
|
|
|
|
992
|
|
|
|
|
|
|
Adds an error to the list of errors without localization. |
993
|
|
|
|
|
|
|
|
994
|
|
|
|
|
|
|
=item error_fields |
995
|
|
|
|
|
|
|
|
996
|
|
|
|
|
|
|
The form and Compound fields will have an array of errors from the subfields. |
997
|
|
|
|
|
|
|
|
998
|
|
|
|
|
|
|
=back |
999
|
|
|
|
|
|
|
|
1000
|
|
|
|
|
|
|
=head2 methods |
1001
|
|
|
|
|
|
|
|
1002
|
|
|
|
|
|
|
A 'methods' hashref allows setting various coderefs, 'build_id', 'build_label', |
1003
|
|
|
|
|
|
|
'build_options', 'validate', 'default'. |
1004
|
|
|
|
|
|
|
|
1005
|
|
|
|
|
|
|
methods => { build_id => \&my_build_id } - coderef for constructing the id |
1006
|
|
|
|
|
|
|
methods => { build_label => \&my_build_label } - coderef for constructing the label |
1007
|
|
|
|
|
|
|
|
1008
|
|
|
|
|
|
|
=over |
1009
|
|
|
|
|
|
|
|
1010
|
|
|
|
|
|
|
=item build_id |
1011
|
|
|
|
|
|
|
|
1012
|
|
|
|
|
|
|
A coderef to build the field's id. If one doesn't exist, will use a form 'build_field_id' |
1013
|
|
|
|
|
|
|
method. Fallback is to use the field's full name. |
1014
|
|
|
|
|
|
|
|
1015
|
|
|
|
|
|
|
=item build_label |
1016
|
|
|
|
|
|
|
|
1017
|
|
|
|
|
|
|
=item build_options |
1018
|
|
|
|
|
|
|
|
1019
|
|
|
|
|
|
|
=item validate |
1020
|
|
|
|
|
|
|
|
1021
|
|
|
|
|
|
|
=item default |
1022
|
|
|
|
|
|
|
|
1023
|
|
|
|
|
|
|
=back |
1024
|
|
|
|
|
|
|
|
1025
|
|
|
|
|
|
|
=head2 render_args |
1026
|
|
|
|
|
|
|
|
1027
|
|
|
|
|
|
|
The 'render_args' hashref contains keys which are used in rendering, with shortcuts |
1028
|
|
|
|
|
|
|
for easier specification in a field definition. |
1029
|
|
|
|
|
|
|
|
1030
|
|
|
|
|
|
|
element_attr - ea |
1031
|
|
|
|
|
|
|
label_attr - la |
1032
|
|
|
|
|
|
|
wrapper_attr - wa |
1033
|
|
|
|
|
|
|
error_attr - era |
1034
|
|
|
|
|
|
|
element_wrapper_attr - ewa |
1035
|
|
|
|
|
|
|
|
1036
|
|
|
|
|
|
|
has_field 'foo' => ( render_args => { element_attr => { readonly => 1, my_attr => 'abc' }} ); |
1037
|
|
|
|
|
|
|
has_field 'foo' => ( 'ra.ea' => { readonly => 1, my_attr => 'abc' } ); |
1038
|
|
|
|
|
|
|
has_field 'foo' => ( 'ra'.wa.class' => ['mb10', 'wr66'] ); |
1039
|
|
|
|
|
|
|
|
1040
|
|
|
|
|
|
|
Note the the 'name', 'id', and 'value' of fields is set by field attributes. Though |
1041
|
|
|
|
|
|
|
it is possible to override the id in render_args, it then won't be available for |
1042
|
|
|
|
|
|
|
other code such as 'errors_by_id'. There is some behavior associated with the 'disabled' |
1043
|
|
|
|
|
|
|
flag too. |
1044
|
|
|
|
|
|
|
|
1045
|
|
|
|
|
|
|
label - Text label for this field. Defaults to ucfirst field name. |
1046
|
|
|
|
|
|
|
id - Used in 'id="<id>"' in HTML |
1047
|
|
|
|
|
|
|
disabled - Boolean to set field disabled |
1048
|
|
|
|
|
|
|
|
1049
|
|
|
|
|
|
|
The order attribute may be used to set the order in which fields are rendered. |
1050
|
|
|
|
|
|
|
|
1051
|
|
|
|
|
|
|
order - Used for sorting errors and fields. Built automatically, |
1052
|
|
|
|
|
|
|
but may also be explicitly set. Auto sequence is by 5: 5, 10, 15, etc |
1053
|
|
|
|
|
|
|
|
1054
|
|
|
|
|
|
|
=head2 Flags |
1055
|
|
|
|
|
|
|
|
1056
|
|
|
|
|
|
|
=over |
1057
|
|
|
|
|
|
|
|
1058
|
|
|
|
|
|
|
=item password |
1059
|
|
|
|
|
|
|
|
1060
|
|
|
|
|
|
|
Prevents the entered value from being displayed in the form |
1061
|
|
|
|
|
|
|
|
1062
|
|
|
|
|
|
|
=item writeonly |
1063
|
|
|
|
|
|
|
|
1064
|
|
|
|
|
|
|
The initial value is not taken from the database |
1065
|
|
|
|
|
|
|
|
1066
|
|
|
|
|
|
|
=item no_update |
1067
|
|
|
|
|
|
|
|
1068
|
|
|
|
|
|
|
Do not include this field in C<< $form->values >>, and so it won't be updated in the database. |
1069
|
|
|
|
|
|
|
|
1070
|
|
|
|
|
|
|
=item not_nullable |
1071
|
|
|
|
|
|
|
|
1072
|
|
|
|
|
|
|
Fields that contain 'empty' values such as '' are changed to undef in the validation process. |
1073
|
|
|
|
|
|
|
If this flag is set, the value is not changed to undef. If your database column requires |
1074
|
|
|
|
|
|
|
an empty string instead of a null value (such as a NOT NULL column), set this attribute. |
1075
|
|
|
|
|
|
|
|
1076
|
|
|
|
|
|
|
has_field 'description' => ( |
1077
|
|
|
|
|
|
|
type => 'TextArea', |
1078
|
|
|
|
|
|
|
not_nullable => 1, |
1079
|
|
|
|
|
|
|
); |
1080
|
|
|
|
|
|
|
|
1081
|
|
|
|
|
|
|
This attribute is also used when you want an empty array to stay an empty array and not |
1082
|
|
|
|
|
|
|
be set to undef. |
1083
|
|
|
|
|
|
|
|
1084
|
|
|
|
|
|
|
It's also used when you have a compound field and you want the 'value' returned |
1085
|
|
|
|
|
|
|
to contain subfields with undef, instead of the whole field to be undef. |
1086
|
|
|
|
|
|
|
|
1087
|
|
|
|
|
|
|
=back |
1088
|
|
|
|
|
|
|
|
1089
|
|
|
|
|
|
|
=head2 Defaults |
1090
|
|
|
|
|
|
|
|
1091
|
|
|
|
|
|
|
See also the documentation on L<Data::MuForm::Manual::Defaults>. |
1092
|
|
|
|
|
|
|
|
1093
|
|
|
|
|
|
|
=over |
1094
|
|
|
|
|
|
|
|
1095
|
|
|
|
|
|
|
=item default method |
1096
|
|
|
|
|
|
|
|
1097
|
|
|
|
|
|
|
Note: do *not* set defaults by setting the 'checked' or 'selected' attributes |
1098
|
|
|
|
|
|
|
in options. The code will be unaware that defaults have been set. |
1099
|
|
|
|
|
|
|
|
1100
|
|
|
|
|
|
|
has_field 'foo' => ( methods => { default => \&my_default } ); |
1101
|
|
|
|
|
|
|
sub my_default { } |
1102
|
|
|
|
|
|
|
OR |
1103
|
|
|
|
|
|
|
has_field 'foo'; |
1104
|
|
|
|
|
|
|
sub default_foo { } |
1105
|
|
|
|
|
|
|
|
1106
|
|
|
|
|
|
|
Supply a coderef (which will be a method on the field). |
1107
|
|
|
|
|
|
|
If not specified and a form method with a name of |
1108
|
|
|
|
|
|
|
C<< default_<field_name> >> exists, it will be used. |
1109
|
|
|
|
|
|
|
|
1110
|
|
|
|
|
|
|
=item default |
1111
|
|
|
|
|
|
|
|
1112
|
|
|
|
|
|
|
Provide an initial value in the field declaration: |
1113
|
|
|
|
|
|
|
|
1114
|
|
|
|
|
|
|
has_field 'bax' => ( default => 'Default bax' ); |
1115
|
|
|
|
|
|
|
|
1116
|
|
|
|
|
|
|
=back |
1117
|
|
|
|
|
|
|
|
1118
|
|
|
|
|
|
|
=head1 Constraints and Validations |
1119
|
|
|
|
|
|
|
|
1120
|
|
|
|
|
|
|
See also L<Data::MuForm::Manual::Validation>. |
1121
|
|
|
|
|
|
|
|
1122
|
|
|
|
|
|
|
=head2 Constraints set in attributes |
1123
|
|
|
|
|
|
|
|
1124
|
|
|
|
|
|
|
=over |
1125
|
|
|
|
|
|
|
|
1126
|
|
|
|
|
|
|
=item required |
1127
|
|
|
|
|
|
|
|
1128
|
|
|
|
|
|
|
Flag indicating whether this field must have a value |
1129
|
|
|
|
|
|
|
|
1130
|
|
|
|
|
|
|
=item unique |
1131
|
|
|
|
|
|
|
|
1132
|
|
|
|
|
|
|
For DB field - check for uniqueness. Action is performed by |
1133
|
|
|
|
|
|
|
the DB model. |
1134
|
|
|
|
|
|
|
|
1135
|
|
|
|
|
|
|
=item apply |
1136
|
|
|
|
|
|
|
|
1137
|
|
|
|
|
|
|
Use the 'apply' keyword to specify an ArrayRef of constraints and coercions to |
1138
|
|
|
|
|
|
|
be executed on the field at field_validate time. |
1139
|
|
|
|
|
|
|
|
1140
|
|
|
|
|
|
|
has_field 'test' => ( |
1141
|
|
|
|
|
|
|
apply => [ TinyType, |
1142
|
|
|
|
|
|
|
{ check => sub {...}, message => { } }, |
1143
|
|
|
|
|
|
|
{ transform => sub { ... lc(shift) ... } } |
1144
|
|
|
|
|
|
|
], |
1145
|
|
|
|
|
|
|
); |
1146
|
|
|
|
|
|
|
|
1147
|
|
|
|
|
|
|
=back |
1148
|
|
|
|
|
|
|
|
1149
|
|
|
|
|
|
|
=head2 messages |
1150
|
|
|
|
|
|
|
|
1151
|
|
|
|
|
|
|
has_field 'foo' => ( messages => { required => '...', unique => '...' } ); |
1152
|
|
|
|
|
|
|
or |
1153
|
|
|
|
|
|
|
has_field 'foo' => ( 'msg.required' => '...' ); |
1154
|
|
|
|
|
|
|
|
1155
|
|
|
|
|
|
|
Set messages created by MuForm by setting in the 'messages' |
1156
|
|
|
|
|
|
|
hashref or with the 'msg.<msg_name>' shortcut. Some field subclasses have additional |
1157
|
|
|
|
|
|
|
settable messages. |
1158
|
|
|
|
|
|
|
|
1159
|
|
|
|
|
|
|
required: Error message text added to errors if required field is not present. |
1160
|
|
|
|
|
|
|
The default is "Field <field label> is required". |
1161
|
|
|
|
|
|
|
|
1162
|
|
|
|
|
|
|
=head2 Transforms |
1163
|
|
|
|
|
|
|
|
1164
|
|
|
|
|
|
|
There are a number of methods to provide finely tuned transformation of the |
1165
|
|
|
|
|
|
|
input or value. |
1166
|
|
|
|
|
|
|
|
1167
|
|
|
|
|
|
|
See also L<Data::MuForm::Manual::Transforms>. |
1168
|
|
|
|
|
|
|
|
1169
|
|
|
|
|
|
|
=over 4 |
1170
|
|
|
|
|
|
|
|
1171
|
|
|
|
|
|
|
=item transform_input_to_value |
1172
|
|
|
|
|
|
|
|
1173
|
|
|
|
|
|
|
In FH was 'inflate_method'. |
1174
|
|
|
|
|
|
|
|
1175
|
|
|
|
|
|
|
Transforms the string that was submitted in params (and copied to 'input') when |
1176
|
|
|
|
|
|
|
it's stored in the 'value' attribute during validation. |
1177
|
|
|
|
|
|
|
|
1178
|
|
|
|
|
|
|
=item transform_value_to_fif |
1179
|
|
|
|
|
|
|
|
1180
|
|
|
|
|
|
|
In FH was 'deflate_method'. |
1181
|
|
|
|
|
|
|
|
1182
|
|
|
|
|
|
|
When you get 'fif' for the field and the 'value' is used (as opposed to input) |
1183
|
|
|
|
|
|
|
transforms the value to a string suitable for filling in a form field. |
1184
|
|
|
|
|
|
|
|
1185
|
|
|
|
|
|
|
=item transform_default_to_value |
1186
|
|
|
|
|
|
|
|
1187
|
|
|
|
|
|
|
In FH was inflate_default_method. |
1188
|
|
|
|
|
|
|
|
1189
|
|
|
|
|
|
|
Transform the 'default' provided by an 'model' or 'init_values' or 'default' when it's stored |
1190
|
|
|
|
|
|
|
in the 'value'. |
1191
|
|
|
|
|
|
|
|
1192
|
|
|
|
|
|
|
=item transform_value_after_validate |
1193
|
|
|
|
|
|
|
|
1194
|
|
|
|
|
|
|
In FH was 'deflate_value_method'; |
1195
|
|
|
|
|
|
|
|
1196
|
|
|
|
|
|
|
Transform the value after validation has been performs, in order to return |
1197
|
|
|
|
|
|
|
a different form in C<< $form->value >>. |
1198
|
|
|
|
|
|
|
|
1199
|
|
|
|
|
|
|
=item transform_param_to_input |
1200
|
|
|
|
|
|
|
|
1201
|
|
|
|
|
|
|
Transform the param when it's stored in 'input'. Will change what the user sees |
1202
|
|
|
|
|
|
|
in a re-presented form. |
1203
|
|
|
|
|
|
|
|
1204
|
|
|
|
|
|
|
=item trim |
1205
|
|
|
|
|
|
|
|
1206
|
|
|
|
|
|
|
A transform to trim the field. The default 'trim' sub |
1207
|
|
|
|
|
|
|
strips beginning and trailing spaces. |
1208
|
|
|
|
|
|
|
Set this attribute to null to skip trimming, or supply a different |
1209
|
|
|
|
|
|
|
sub. |
1210
|
|
|
|
|
|
|
|
1211
|
|
|
|
|
|
|
trim => sub { |
1212
|
|
|
|
|
|
|
my $string = shift; |
1213
|
|
|
|
|
|
|
<do something> |
1214
|
|
|
|
|
|
|
return $string; |
1215
|
|
|
|
|
|
|
} |
1216
|
|
|
|
|
|
|
|
1217
|
|
|
|
|
|
|
Trimming is performed before any other defined actions. |
1218
|
|
|
|
|
|
|
|
1219
|
|
|
|
|
|
|
=back |
1220
|
|
|
|
|
|
|
|
1221
|
|
|
|
|
|
|
=head1 Processing and validating the field |
1222
|
|
|
|
|
|
|
|
1223
|
|
|
|
|
|
|
See also L<Data::MuForm::Manual::Validation>. |
1224
|
|
|
|
|
|
|
|
1225
|
|
|
|
|
|
|
=head2 Validate method |
1226
|
|
|
|
|
|
|
|
1227
|
|
|
|
|
|
|
has_field 'foo' => ( methods => { validate => \&foo_validation } ); |
1228
|
|
|
|
|
|
|
sub foo_validation { } |
1229
|
|
|
|
|
|
|
OR |
1230
|
|
|
|
|
|
|
has_field 'foo'; |
1231
|
|
|
|
|
|
|
sub validate_foo { } |
1232
|
|
|
|
|
|
|
|
1233
|
|
|
|
|
|
|
Supply a coderef (which will be a method on the field). |
1234
|
|
|
|
|
|
|
If not specified and a form method with a name of |
1235
|
|
|
|
|
|
|
C<< validate_<field_name> >> exists, it will be used instead. |
1236
|
|
|
|
|
|
|
|
1237
|
|
|
|
|
|
|
Periods in field names will be replaced by underscores, so that the field |
1238
|
|
|
|
|
|
|
'addresses.city' will use the 'validate_addresses_city' method for validation. |
1239
|
|
|
|
|
|
|
|
1240
|
|
|
|
|
|
|
=head2 apply actions |
1241
|
|
|
|
|
|
|
|
1242
|
|
|
|
|
|
|
Use Type::Tiny types; |
1243
|
|
|
|
|
|
|
|
1244
|
|
|
|
|
|
|
use Types::Standard ('PosInteger'); |
1245
|
|
|
|
|
|
|
has_field 'foo' => ( apply => [ PosInteger ] ); |
1246
|
|
|
|
|
|
|
|
1247
|
|
|
|
|
|
|
=head2 validate |
1248
|
|
|
|
|
|
|
|
1249
|
|
|
|
|
|
|
This field method can be used in addition to or instead of 'apply' actions |
1250
|
|
|
|
|
|
|
in custom field classes. |
1251
|
|
|
|
|
|
|
It should validate the field data and set error messages on |
1252
|
|
|
|
|
|
|
errors with C<< $field->add_error >>. |
1253
|
|
|
|
|
|
|
|
1254
|
|
|
|
|
|
|
sub validate { |
1255
|
|
|
|
|
|
|
my $field = shift; |
1256
|
|
|
|
|
|
|
my $value = $field->value; |
1257
|
|
|
|
|
|
|
return $field->add_error( ... ) if ( ... ); |
1258
|
|
|
|
|
|
|
} |
1259
|
|
|
|
|
|
|
|
1260
|
|
|
|
|
|
|
=head1 AUTHOR |
1261
|
|
|
|
|
|
|
|
1262
|
|
|
|
|
|
|
Gerda Shank |
1263
|
|
|
|
|
|
|
|
1264
|
|
|
|
|
|
|
=head1 COPYRIGHT AND LICENSE |
1265
|
|
|
|
|
|
|
|
1266
|
|
|
|
|
|
|
This software is copyright (c) 2017 by Gerda Shank. |
1267
|
|
|
|
|
|
|
|
1268
|
|
|
|
|
|
|
This is free software; you can redistribute it and/or modify it under |
1269
|
|
|
|
|
|
|
the same terms as the Perl 5 programming language system itself. |
1270
|
|
|
|
|
|
|
|
1271
|
|
|
|
|
|
|
=cut |