line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Perl::ToPerl6::TransformerParameter::Behavior::Enumeration; |
2
|
|
|
|
|
|
|
|
3
|
23
|
|
|
23
|
|
410
|
use 5.006001; |
|
23
|
|
|
|
|
66
|
|
4
|
23
|
|
|
23
|
|
100
|
use strict; |
|
23
|
|
|
|
|
37
|
|
|
23
|
|
|
|
|
474
|
|
5
|
23
|
|
|
23
|
|
89
|
use warnings; |
|
23
|
|
|
|
|
37
|
|
|
23
|
|
|
|
|
693
|
|
6
|
|
|
|
|
|
|
|
7
|
|
|
|
|
|
|
use Perl::ToPerl6::Exception::Fatal::TransformerDefinition |
8
|
23
|
|
|
23
|
|
99
|
qw{ &throw_transformer_definition }; |
|
23
|
|
|
|
|
32
|
|
|
23
|
|
|
|
|
2418
|
|
9
|
23
|
|
|
23
|
|
123
|
use Perl::ToPerl6::Utils qw{ :characters &words_from_string &hashify }; |
|
23
|
|
|
|
|
44
|
|
|
23
|
|
|
|
|
1188
|
|
10
|
|
|
|
|
|
|
|
11
|
23
|
|
|
23
|
|
4445
|
use base qw{ Perl::ToPerl6::TransformerParameter::Behavior }; |
|
23
|
|
|
|
|
33
|
|
|
23
|
|
|
|
|
13064
|
|
12
|
|
|
|
|
|
|
|
13
|
|
|
|
|
|
|
our $VERSION = '0.03'; |
14
|
|
|
|
|
|
|
|
15
|
|
|
|
|
|
|
#----------------------------------------------------------------------------- |
16
|
|
|
|
|
|
|
|
17
|
|
|
|
|
|
|
sub initialize_parameter { |
18
|
8
|
|
|
8
|
1
|
9
|
my ($self, $parameter, $specification) = @_; |
19
|
|
|
|
|
|
|
|
20
|
|
|
|
|
|
|
my $valid_values = $specification->{enumeration_values} |
21
|
8
|
100
|
|
|
|
20
|
or throw_transformer_definition( |
22
|
|
|
|
|
|
|
'No enumeration_values given for ' |
23
|
|
|
|
|
|
|
. $parameter->get_name() |
24
|
|
|
|
|
|
|
. $PERIOD); |
25
|
7
|
100
|
|
|
|
15
|
ref $valid_values eq 'ARRAY' |
26
|
|
|
|
|
|
|
or throw_transformer_definition( |
27
|
|
|
|
|
|
|
'The value given for enumeration_values for ' |
28
|
|
|
|
|
|
|
. $parameter->get_name() |
29
|
|
|
|
|
|
|
. ' is not an array reference.'); |
30
|
6
|
100
|
|
|
|
5
|
scalar @{$valid_values} > 1 |
|
6
|
|
|
|
|
16
|
|
31
|
|
|
|
|
|
|
or throw_transformer_definition( |
32
|
|
|
|
|
|
|
'There were not at least two valid values given for' |
33
|
|
|
|
|
|
|
. ' enumeration_values for ' |
34
|
|
|
|
|
|
|
. $parameter->get_name() |
35
|
|
|
|
|
|
|
. $PERIOD); |
36
|
|
|
|
|
|
|
|
37
|
|
|
|
|
|
|
# Unfortunately, this has to be a reference, rather than a regular hash, |
38
|
|
|
|
|
|
|
# due to a problem in Devel::Cycle |
39
|
|
|
|
|
|
|
# (http://rt.cpan.org/Ticket/Display.html?id=25360) which causes |
40
|
|
|
|
|
|
|
# t/92_memory_leaks.t to fall over. |
41
|
4
|
|
|
|
|
4
|
my $value_lookup = { hashify( @{$valid_values} ) }; |
|
4
|
|
|
|
|
13
|
|
42
|
4
|
|
|
|
|
11
|
$parameter->_get_behavior_values()->{enumeration_values} = $value_lookup; |
43
|
|
|
|
|
|
|
|
44
|
|
|
|
|
|
|
my $allow_multiple_values = |
45
|
4
|
|
|
|
|
6
|
$specification->{enumeration_allow_multiple_values}; |
46
|
|
|
|
|
|
|
|
47
|
4
|
100
|
|
|
|
7
|
if ($allow_multiple_values) { |
48
|
|
|
|
|
|
|
$parameter->_set_parser( |
49
|
|
|
|
|
|
|
sub { |
50
|
|
|
|
|
|
|
# Normally bad thing, obscuring a variable in a outer scope |
51
|
|
|
|
|
|
|
# with a variable with the same name is being done here in |
52
|
|
|
|
|
|
|
# order to remain consistent with the parser function interface. |
53
|
7
|
|
|
7
|
|
9
|
my ($transformer, $parameter, $config_string) = @_; |
54
|
|
|
|
|
|
|
|
55
|
7
|
|
|
|
|
6
|
my @potential_values; |
56
|
7
|
|
|
|
|
13
|
my $value_string = $parameter->get_default_string(); |
57
|
|
|
|
|
|
|
|
58
|
7
|
100
|
|
|
|
14
|
if (defined $config_string) { |
59
|
5
|
|
|
|
|
5
|
$value_string = $config_string; |
60
|
|
|
|
|
|
|
} |
61
|
|
|
|
|
|
|
|
62
|
7
|
100
|
|
|
|
11
|
if ( defined $value_string ) { |
63
|
6
|
|
|
|
|
14
|
@potential_values = words_from_string($value_string); |
64
|
|
|
|
|
|
|
|
65
|
|
|
|
|
|
|
my @bad_values = |
66
|
6
|
|
|
|
|
7
|
grep { not exists $value_lookup->{$_} } @potential_values; |
|
9
|
|
|
|
|
19
|
|
67
|
6
|
100
|
|
|
|
10
|
if (@bad_values) { |
68
|
|
|
|
|
|
|
$transformer->throw_parameter_value_exception( |
69
|
|
|
|
|
|
|
$parameter->get_name(), |
70
|
|
|
|
|
|
|
$value_string, |
71
|
|
|
|
|
|
|
undef, |
72
|
|
|
|
|
|
|
q{contains invalid values: } |
73
|
|
|
|
|
|
|
. join (q{, }, @bad_values) |
74
|
|
|
|
|
|
|
. q{. Allowed values are: } |
75
|
1
|
|
|
|
|
3
|
. join (q{, }, sort keys %{$value_lookup}) |
|
1
|
|
|
|
|
8
|
|
76
|
|
|
|
|
|
|
. qq{.\n}, |
77
|
|
|
|
|
|
|
); |
78
|
|
|
|
|
|
|
} |
79
|
|
|
|
|
|
|
} |
80
|
|
|
|
|
|
|
|
81
|
6
|
|
|
|
|
13
|
my %actual_values = hashify(@potential_values); |
82
|
|
|
|
|
|
|
|
83
|
6
|
|
|
|
|
13
|
$transformer->__set_parameter_value($parameter, \%actual_values); |
84
|
|
|
|
|
|
|
|
85
|
6
|
|
|
|
|
12
|
return; |
86
|
|
|
|
|
|
|
} |
87
|
2
|
|
|
|
|
11
|
); |
88
|
|
|
|
|
|
|
} else { |
89
|
|
|
|
|
|
|
$parameter->_set_parser( |
90
|
|
|
|
|
|
|
sub { |
91
|
|
|
|
|
|
|
# Normally bad thing, obscuring a variable in a outer scope |
92
|
|
|
|
|
|
|
# with a variable with the same name is being done here in |
93
|
|
|
|
|
|
|
# order to remain consistent with the parser function interface. |
94
|
5
|
|
|
5
|
|
4
|
my ($transformer, $parameter, $config_string) = @_; |
95
|
|
|
|
|
|
|
|
96
|
5
|
|
|
|
|
11
|
my $value_string = $parameter->get_default_string(); |
97
|
|
|
|
|
|
|
|
98
|
5
|
100
|
|
|
|
13
|
if (defined $config_string) { |
99
|
3
|
|
|
|
|
4
|
$value_string = $config_string; |
100
|
|
|
|
|
|
|
} |
101
|
|
|
|
|
|
|
|
102
|
5
|
100
|
66
|
|
|
31
|
if ( |
|
|
|
100
|
|
|
|
|
103
|
|
|
|
|
|
|
defined $value_string |
104
|
|
|
|
|
|
|
and $EMPTY ne $value_string |
105
|
|
|
|
|
|
|
and not defined $value_lookup->{$value_string} |
106
|
|
|
|
|
|
|
) { |
107
|
|
|
|
|
|
|
$transformer->throw_parameter_value_exception( |
108
|
|
|
|
|
|
|
$parameter->get_name(), |
109
|
|
|
|
|
|
|
$value_string, |
110
|
|
|
|
|
|
|
undef, |
111
|
|
|
|
|
|
|
q{is not one of the allowed values: } |
112
|
1
|
|
|
|
|
3
|
. join (q{, }, sort keys %{$value_lookup}) |
|
1
|
|
|
|
|
9
|
|
113
|
|
|
|
|
|
|
. qq{.\n}, |
114
|
|
|
|
|
|
|
); |
115
|
|
|
|
|
|
|
} |
116
|
|
|
|
|
|
|
|
117
|
4
|
|
|
|
|
10
|
$transformer->__set_parameter_value($parameter, $value_string); |
118
|
|
|
|
|
|
|
|
119
|
4
|
|
|
|
|
7
|
return; |
120
|
|
|
|
|
|
|
} |
121
|
2
|
|
|
|
|
12
|
); |
122
|
|
|
|
|
|
|
} |
123
|
|
|
|
|
|
|
|
124
|
4
|
|
|
|
|
6
|
return; |
125
|
|
|
|
|
|
|
} |
126
|
|
|
|
|
|
|
|
127
|
|
|
|
|
|
|
#----------------------------------------------------------------------------- |
128
|
|
|
|
|
|
|
|
129
|
|
|
|
|
|
|
sub generate_parameter_description { |
130
|
0
|
|
|
0
|
1
|
|
my ($self, $parameter) = @_; |
131
|
|
|
|
|
|
|
|
132
|
0
|
|
|
|
|
|
my $description = $parameter->_get_description_with_trailing_period(); |
133
|
0
|
0
|
|
|
|
|
if ( $description ) { |
134
|
0
|
|
|
|
|
|
$description .= qq{\n}; |
135
|
|
|
|
|
|
|
} |
136
|
|
|
|
|
|
|
|
137
|
0
|
|
|
|
|
|
my %values = %{$parameter->_get_behavior_values()->{enumeration_values}}; |
|
0
|
|
|
|
|
|
|
138
|
|
|
|
|
|
|
return |
139
|
0
|
|
|
|
|
|
$description |
140
|
|
|
|
|
|
|
. 'Valid values: ' |
141
|
|
|
|
|
|
|
. join (', ', sort keys %values) |
142
|
|
|
|
|
|
|
. $PERIOD; |
143
|
|
|
|
|
|
|
} |
144
|
|
|
|
|
|
|
|
145
|
|
|
|
|
|
|
#----------------------------------------------------------------------------- |
146
|
|
|
|
|
|
|
|
147
|
|
|
|
|
|
|
1; |
148
|
|
|
|
|
|
|
|
149
|
|
|
|
|
|
|
__END__ |
150
|
|
|
|
|
|
|
|
151
|
|
|
|
|
|
|
#----------------------------------------------------------------------------- |
152
|
|
|
|
|
|
|
|
153
|
|
|
|
|
|
|
=pod |
154
|
|
|
|
|
|
|
|
155
|
|
|
|
|
|
|
=for stopwords |
156
|
|
|
|
|
|
|
|
157
|
|
|
|
|
|
|
=head1 NAME |
158
|
|
|
|
|
|
|
|
159
|
|
|
|
|
|
|
Perl::ToPerl6::TransformerParameter::Behavior::Enumeration - Actions appropriate for an enumerated value. |
160
|
|
|
|
|
|
|
|
161
|
|
|
|
|
|
|
|
162
|
|
|
|
|
|
|
=head1 DESCRIPTION |
163
|
|
|
|
|
|
|
|
164
|
|
|
|
|
|
|
Provides a standard set of functionality for an enumerated |
165
|
|
|
|
|
|
|
L<Perl::ToPerl6::TransformerParameter|Perl::ToPerl6::TransformerParameter> so that |
166
|
|
|
|
|
|
|
the developer of a transformer does not have to provide it her/himself. |
167
|
|
|
|
|
|
|
|
168
|
|
|
|
|
|
|
NOTE: Do not instantiate this class. Use the singleton instance held |
169
|
|
|
|
|
|
|
onto by |
170
|
|
|
|
|
|
|
L<Perl::ToPerl6::TransformerParameter|Perl::ToPerl6::TransformerParameter>. |
171
|
|
|
|
|
|
|
|
172
|
|
|
|
|
|
|
|
173
|
|
|
|
|
|
|
=head1 INTERFACE SUPPORT |
174
|
|
|
|
|
|
|
|
175
|
|
|
|
|
|
|
This is considered to be a non-public class. Its interface is subject |
176
|
|
|
|
|
|
|
to change without notice. |
177
|
|
|
|
|
|
|
|
178
|
|
|
|
|
|
|
|
179
|
|
|
|
|
|
|
=head1 METHODS |
180
|
|
|
|
|
|
|
|
181
|
|
|
|
|
|
|
=over |
182
|
|
|
|
|
|
|
|
183
|
|
|
|
|
|
|
=item C<initialize_parameter( $parameter, $specification )> |
184
|
|
|
|
|
|
|
|
185
|
|
|
|
|
|
|
Plug in the functionality this behavior provides into the parameter, |
186
|
|
|
|
|
|
|
based upon the configuration provided by the specification. |
187
|
|
|
|
|
|
|
|
188
|
|
|
|
|
|
|
This behavior looks for two configuration items: |
189
|
|
|
|
|
|
|
|
190
|
|
|
|
|
|
|
=over |
191
|
|
|
|
|
|
|
|
192
|
|
|
|
|
|
|
=item enumeration_values |
193
|
|
|
|
|
|
|
|
194
|
|
|
|
|
|
|
Mandatory. The set of valid values for the parameter, as an array |
195
|
|
|
|
|
|
|
reference. |
196
|
|
|
|
|
|
|
|
197
|
|
|
|
|
|
|
|
198
|
|
|
|
|
|
|
=item enumeration_allow_multiple_values |
199
|
|
|
|
|
|
|
|
200
|
|
|
|
|
|
|
Optional, defaults to false. Should the parameter support a single |
201
|
|
|
|
|
|
|
value or accept multiple? |
202
|
|
|
|
|
|
|
|
203
|
|
|
|
|
|
|
|
204
|
|
|
|
|
|
|
=back |
205
|
|
|
|
|
|
|
|
206
|
|
|
|
|
|
|
|
207
|
|
|
|
|
|
|
=item C<generate_parameter_description( $parameter )> |
208
|
|
|
|
|
|
|
|
209
|
|
|
|
|
|
|
Create a description of the parameter, based upon the description on |
210
|
|
|
|
|
|
|
the parameter itself, but enhancing it with information from this |
211
|
|
|
|
|
|
|
behavior. |
212
|
|
|
|
|
|
|
|
213
|
|
|
|
|
|
|
In this specific case, the universe of values is added at the end. |
214
|
|
|
|
|
|
|
|
215
|
|
|
|
|
|
|
|
216
|
|
|
|
|
|
|
=back |
217
|
|
|
|
|
|
|
|
218
|
|
|
|
|
|
|
|
219
|
|
|
|
|
|
|
=head1 AUTHOR |
220
|
|
|
|
|
|
|
|
221
|
|
|
|
|
|
|
Elliot Shank <perl@galumph.com> |
222
|
|
|
|
|
|
|
|
223
|
|
|
|
|
|
|
|
224
|
|
|
|
|
|
|
=head1 COPYRIGHT |
225
|
|
|
|
|
|
|
|
226
|
|
|
|
|
|
|
Copyright (c) 2006-2011 Elliot Shank. |
227
|
|
|
|
|
|
|
|
228
|
|
|
|
|
|
|
This program is free software; you can redistribute it and/or modify |
229
|
|
|
|
|
|
|
it under the same terms as Perl itself. The full text of this license |
230
|
|
|
|
|
|
|
can be found in the LICENSE file included with this module. |
231
|
|
|
|
|
|
|
|
232
|
|
|
|
|
|
|
=cut |
233
|
|
|
|
|
|
|
|
234
|
|
|
|
|
|
|
# Local Variables: |
235
|
|
|
|
|
|
|
# mode: cperl |
236
|
|
|
|
|
|
|
# cperl-indent-level: 4 |
237
|
|
|
|
|
|
|
# fill-column: 78 |
238
|
|
|
|
|
|
|
# indent-tabs-mode: nil |
239
|
|
|
|
|
|
|
# c-indentation-style: bsd |
240
|
|
|
|
|
|
|
# End: |
241
|
|
|
|
|
|
|
# ex: set ts=8 sts=4 sw=4 tw=78 ft=perl expandtab shiftround : |