line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package HTML::FormHandler::Widget::Field::Select; |
2
|
|
|
|
|
|
|
# ABSTRACT: select field rendering widget |
3
|
|
|
|
|
|
|
$HTML::FormHandler::Widget::Field::Select::VERSION = '0.40068'; |
4
|
|
|
|
|
|
|
|
5
|
31
|
|
|
31
|
|
24002
|
use Moose::Role; |
|
31
|
|
|
|
|
92
|
|
|
31
|
|
|
|
|
328
|
|
6
|
31
|
|
|
31
|
|
164152
|
use namespace::autoclean; |
|
31
|
|
|
|
|
95
|
|
|
31
|
|
|
|
|
330
|
|
7
|
31
|
|
|
31
|
|
2475
|
use HTML::FormHandler::Render::Util ('process_attrs'); |
|
31
|
|
|
|
|
84
|
|
|
31
|
|
|
|
|
317
|
|
8
|
|
|
|
|
|
|
|
9
|
|
|
|
|
|
|
sub render { |
10
|
36
|
|
|
36
|
0
|
124
|
my ( $self, $result ) = @_; |
11
|
36
|
|
66
|
|
|
544
|
$result ||= $self->result; |
12
|
36
|
50
|
|
|
|
124
|
die "No result for form field '" . $self->full_name . "'. Field may be inactive." unless $result; |
13
|
36
|
|
|
|
|
173
|
my $output = $self->render_element( $result ); |
14
|
36
|
|
|
|
|
205
|
return $self->wrap_field( $result, $output ); |
15
|
|
|
|
|
|
|
} |
16
|
|
|
|
|
|
|
|
17
|
|
|
|
|
|
|
sub render_element { |
18
|
37
|
|
|
37
|
0
|
109
|
my ( $self, $result ) = @_; |
19
|
37
|
|
33
|
|
|
124
|
$result ||= $self->result; |
20
|
|
|
|
|
|
|
|
21
|
|
|
|
|
|
|
# create select element |
22
|
37
|
|
|
|
|
159
|
my $output = $self->render_select_start( $result ); |
23
|
|
|
|
|
|
|
|
24
|
|
|
|
|
|
|
# create empty select |
25
|
37
|
100
|
|
|
|
1280
|
if( defined $self->empty_select ) { |
26
|
3
|
|
|
|
|
12
|
$output .= $self->render_empty_select; |
27
|
|
|
|
|
|
|
} |
28
|
|
|
|
|
|
|
|
29
|
|
|
|
|
|
|
# loop through options |
30
|
37
|
|
|
|
|
87
|
foreach my $option ( @{ $self->{options} } ) { |
|
37
|
|
|
|
|
159
|
|
31
|
129
|
100
|
|
|
|
410
|
if ( my $label = $option->{group} ) { |
32
|
3
|
50
|
|
|
|
106
|
$label = $self->_localize( $label ) if $self->localize_labels; |
33
|
3
|
|
|
|
|
8
|
$output .= qq{\n<optgroup label="$label">}; |
34
|
3
|
|
|
|
|
7
|
foreach my $group_opt ( @{ $option->{options} } ) { |
|
3
|
|
|
|
|
6
|
|
35
|
9
|
|
|
|
|
28
|
$output .= $self->render_option( $group_opt, $result ); |
36
|
|
|
|
|
|
|
} |
37
|
3
|
|
|
|
|
8
|
$output .= qq{\n</optgroup>}; |
38
|
|
|
|
|
|
|
} |
39
|
|
|
|
|
|
|
else { |
40
|
126
|
|
|
|
|
382
|
$output .= $self->render_option( $option, $result ); |
41
|
|
|
|
|
|
|
} |
42
|
|
|
|
|
|
|
} |
43
|
37
|
|
|
|
|
1413
|
$self->reset_options_index; |
44
|
|
|
|
|
|
|
|
45
|
37
|
|
|
|
|
88
|
$output .= '</select>'; |
46
|
37
|
|
|
|
|
115
|
return $output; |
47
|
|
|
|
|
|
|
} |
48
|
|
|
|
|
|
|
|
49
|
|
|
|
|
|
|
sub render_select_start { |
50
|
37
|
|
|
37
|
0
|
98
|
my ( $self, $result ) = @_; |
51
|
37
|
|
33
|
|
|
114
|
$result ||= $self->result; |
52
|
|
|
|
|
|
|
|
53
|
37
|
|
|
|
|
1072
|
my $id = $self->id; |
54
|
37
|
|
|
|
|
945
|
my $output = '<select name="' . $self->html_name . qq{" id="$id"}; |
55
|
37
|
100
|
|
|
|
1155
|
$output .= ' multiple="multiple"' if $self->multiple; |
56
|
37
|
100
|
|
|
|
1131
|
$output .= ' size="' . $self->size . '"' if defined $self->size; |
57
|
37
|
|
|
|
|
233
|
$output .= process_attrs($self->element_attributes($result)); |
58
|
37
|
|
|
|
|
122
|
$output .= '>'; |
59
|
37
|
|
|
|
|
113
|
return $output; |
60
|
|
|
|
|
|
|
} |
61
|
|
|
|
|
|
|
|
62
|
|
|
|
|
|
|
sub render_empty_select { |
63
|
3
|
|
|
3
|
0
|
8
|
my $self = shift; |
64
|
|
|
|
|
|
|
|
65
|
3
|
|
|
|
|
80
|
my $label = $self->_localize($self->empty_select); |
66
|
3
|
|
|
|
|
85
|
my $id = $self->id . "." . $self->options_index; |
67
|
3
|
|
|
|
|
14
|
my $output .= qq{\n<option value="" id="$id">$label</option>}; |
68
|
3
|
|
|
|
|
118
|
$self->inc_options_index; |
69
|
3
|
|
|
|
|
9
|
return $output; |
70
|
|
|
|
|
|
|
} |
71
|
|
|
|
|
|
|
|
72
|
|
|
|
|
|
|
sub render_option { |
73
|
135
|
|
|
135
|
0
|
301
|
my ( $self, $option, $result ) = @_; |
74
|
135
|
|
33
|
|
|
389
|
$result ||= $self->result; |
75
|
|
|
|
|
|
|
|
76
|
|
|
|
|
|
|
# current values |
77
|
135
|
|
|
|
|
520
|
my $fif = $result->fif; |
78
|
135
|
|
|
|
|
284
|
my %fif_lookup; |
79
|
135
|
100
|
|
|
|
3707
|
@fif_lookup{@$fif} = () if $self->multiple; |
80
|
|
|
|
|
|
|
|
81
|
|
|
|
|
|
|
# not sure why the value of an option would be undef, but just in case, |
82
|
|
|
|
|
|
|
# set to empty string because of 'eq' below |
83
|
135
|
50
|
|
|
|
467
|
my $value = defined $option->{value} ? $option->{value} : ''; |
84
|
135
|
|
|
|
|
3298
|
my $id = $self->id . '.' . $self->options_index; |
85
|
135
|
|
|
|
|
4366
|
my $output .= qq{\n<option value="} . $self->html_filter($value) . '"'; |
86
|
135
|
|
|
|
|
344
|
$output .= qq{ id="$id"}; |
87
|
|
|
|
|
|
|
|
88
|
|
|
|
|
|
|
# handle option attributes |
89
|
135
|
|
50
|
|
|
652
|
my $attrs = $option->{attributes} || {}; |
90
|
135
|
0
|
33
|
|
|
406
|
if( defined $option->{disabled} && $option->{disabled} ) { |
91
|
0
|
|
|
|
|
0
|
$attrs->{disabled} = 'disabled'; |
92
|
|
|
|
|
|
|
} |
93
|
135
|
100
|
100
|
|
|
3828
|
if ( defined $fif && |
|
|
|
66
|
|
|
|
|
94
|
|
|
|
|
|
|
( ( $self->multiple && exists $fif_lookup{$value} ) || |
95
|
|
|
|
|
|
|
( $fif eq $value ) ) ) { |
96
|
30
|
|
|
|
|
98
|
$attrs->{selected} = 'selected'; |
97
|
|
|
|
|
|
|
} |
98
|
135
|
|
|
|
|
491
|
$output .= process_attrs($attrs); |
99
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
# handle label |
101
|
135
|
|
|
|
|
333
|
my $label = $option->{label}; |
102
|
135
|
50
|
|
|
|
3991
|
$label = $self->_localize($label) if $self->localize_labels; |
103
|
135
|
|
|
|
|
4539
|
$output .= '>' . ( $self->html_filter($label) ) . '</option>'; |
104
|
135
|
|
|
|
|
4764
|
$self->inc_options_index; |
105
|
135
|
|
|
|
|
615
|
return $output; |
106
|
|
|
|
|
|
|
} |
107
|
|
|
|
|
|
|
|
108
|
|
|
|
|
|
|
1; |
109
|
|
|
|
|
|
|
|
110
|
|
|
|
|
|
|
__END__ |
111
|
|
|
|
|
|
|
|
112
|
|
|
|
|
|
|
=pod |
113
|
|
|
|
|
|
|
|
114
|
|
|
|
|
|
|
=encoding UTF-8 |
115
|
|
|
|
|
|
|
|
116
|
|
|
|
|
|
|
=head1 NAME |
117
|
|
|
|
|
|
|
|
118
|
|
|
|
|
|
|
HTML::FormHandler::Widget::Field::Select - select field rendering widget |
119
|
|
|
|
|
|
|
|
120
|
|
|
|
|
|
|
=head1 VERSION |
121
|
|
|
|
|
|
|
|
122
|
|
|
|
|
|
|
version 0.40068 |
123
|
|
|
|
|
|
|
|
124
|
|
|
|
|
|
|
=head1 DESCRIPTION |
125
|
|
|
|
|
|
|
|
126
|
|
|
|
|
|
|
Renders single and multiple selects. Options hashrefs must |
127
|
|
|
|
|
|
|
have 'value' and 'label' keys, and may have an 'attributes' key. |
128
|
|
|
|
|
|
|
|
129
|
|
|
|
|
|
|
See L<HTML::FormHandler::Field::Select> for documentation on |
130
|
|
|
|
|
|
|
select fields and options. |
131
|
|
|
|
|
|
|
|
132
|
|
|
|
|
|
|
=head1 NAME |
133
|
|
|
|
|
|
|
|
134
|
|
|
|
|
|
|
HTML::FormHandler::Widget::Field::Select |
135
|
|
|
|
|
|
|
|
136
|
|
|
|
|
|
|
=head1 AUTHOR |
137
|
|
|
|
|
|
|
|
138
|
|
|
|
|
|
|
FormHandler Contributors - see HTML::FormHandler |
139
|
|
|
|
|
|
|
|
140
|
|
|
|
|
|
|
=head1 COPYRIGHT AND LICENSE |
141
|
|
|
|
|
|
|
|
142
|
|
|
|
|
|
|
This software is copyright (c) 2017 by Gerda Shank. |
143
|
|
|
|
|
|
|
|
144
|
|
|
|
|
|
|
This is free software; you can redistribute it and/or modify it under |
145
|
|
|
|
|
|
|
the same terms as the Perl 5 programming language system itself. |
146
|
|
|
|
|
|
|
|
147
|
|
|
|
|
|
|
=cut |