|
0
|
1 package CPT::ParameterCollection;
|
|
|
2 use Carp;
|
|
|
3 use Moose;
|
|
|
4 use strict;
|
|
|
5 use warnings;
|
|
|
6 use autodie;
|
|
|
7 use Data::Dumper;
|
|
|
8
|
|
|
9 # A collection of parameters
|
|
|
10
|
|
|
11 has 'params' => ( is => 'rw', isa => 'ArrayRef', default => sub{[]});
|
|
|
12
|
|
|
13
|
|
|
14 sub validate {
|
|
|
15 my ( $self, $getopt_obj) = @_;
|
|
|
16 my $issue_count = 0;
|
|
|
17 for my $item ( @{ $self->params() } ) {
|
|
|
18 my $type = ref($item);
|
|
|
19 # We now check that getopt has supplied a value (we don't want to validate values that were NOT supplied. That'd be dumb)
|
|
|
20 # If it's defined AND it doesn't validate, then we add an error on the stack for that.
|
|
|
21 if(defined $item->name() && defined $getopt_obj->{$item->name()} && !$item->validate()){
|
|
|
22 carp join("\n", @{$item->errors()});
|
|
|
23 $issue_count++;
|
|
|
24 }
|
|
|
25 }
|
|
|
26 return $issue_count == 0;
|
|
|
27 }
|
|
|
28
|
|
|
29
|
|
|
30
|
|
|
31 sub push_group {
|
|
|
32 my ( $self, $group ) = @_;
|
|
|
33 $self->push_params($group->flattenOptionsArray());
|
|
|
34 }
|
|
|
35
|
|
|
36
|
|
|
37 sub push_param {
|
|
|
38 my ( $self, $param ) = @_;
|
|
|
39 $self->_push($self->_coerce_param($_));
|
|
|
40 }
|
|
|
41
|
|
|
42
|
|
|
43 sub push_params {
|
|
|
44 my ( $self, $array_ref ) = @_;
|
|
|
45 foreach(@{$array_ref}){
|
|
|
46 my $result = $self->_coerce_param($_);
|
|
|
47 if($result){
|
|
|
48 $self->_push($result);
|
|
|
49 }
|
|
|
50 }
|
|
|
51 }
|
|
|
52
|
|
|
53 sub _push{
|
|
|
54 my ( $self, $array_ref ) = @_;
|
|
|
55 my @arr;
|
|
|
56 if($self->params()){
|
|
|
57 @arr = @{$self->params()};
|
|
|
58 }
|
|
|
59 push(@arr, $array_ref);
|
|
|
60 $self->params(\@arr);
|
|
|
61 }
|
|
|
62
|
|
|
63
|
|
|
64 sub parse_short_name {
|
|
|
65 my ( $self, $parameter ) = @_;
|
|
|
66 if ( index( $parameter, '|' ) > -1 ) {
|
|
|
67 return substr( $parameter, index( $parameter, '|' ) + 1 );
|
|
|
68 }
|
|
|
69 else {
|
|
|
70 return "";
|
|
|
71 }
|
|
|
72 }
|
|
|
73
|
|
|
74
|
|
|
75 sub parse_long_name {
|
|
|
76 my ( $self, $parameter ) = @_;
|
|
|
77 if ( index( $parameter, '|' ) > -1 ) {
|
|
|
78 return substr( $parameter, 0, index( $parameter, '|' ) );
|
|
|
79 }
|
|
|
80 else {
|
|
|
81 return $parameter;
|
|
|
82 }
|
|
|
83 }
|
|
|
84
|
|
|
85
|
|
|
86 sub _coerce0 {
|
|
|
87 my ($self) = @_;
|
|
|
88 require CPT::Parameter::Empty;
|
|
|
89 my $p = CPT::Parameter::Empty->new();
|
|
|
90 return $p;
|
|
|
91 }
|
|
|
92 sub _coerce1 {
|
|
|
93 my ($self, @parts) = @_;
|
|
|
94 require CPT::Parameter::Label;
|
|
|
95 my $p = CPT::Parameter::Label->new(label=> $parts[0]);
|
|
|
96 return $p;
|
|
|
97 }
|
|
|
98 sub _coerce2 {
|
|
|
99 my ($self, @parts) = @_;
|
|
|
100 require CPT::Parameter::Flag;
|
|
|
101 my $p = CPT::Parameter::Flag->new(
|
|
|
102 name => $self->parse_long_name( $parts[0] ),
|
|
|
103 short => $self->parse_short_name( $parts[0] ),
|
|
|
104 multiple => 0,
|
|
|
105 description => $parts[1],
|
|
|
106 );
|
|
|
107 return $p;
|
|
|
108 }
|
|
|
109 sub _coerce3 {
|
|
|
110 my ($self, @parts) = @_;
|
|
|
111 # Three parameter case
|
|
|
112 my %attr = (
|
|
|
113 name => $self->parse_long_name( $parts[0] ),
|
|
|
114 short => $self->parse_short_name( $parts[0] ),
|
|
|
115 multiple => 0,
|
|
|
116 description => $parts[1],
|
|
|
117 );
|
|
|
118
|
|
|
119 # create the attr
|
|
|
120 my %set_attr = %{ $parts[2] };
|
|
|
121
|
|
|
122 # Check if various things are set, if so, copy them.
|
|
|
123 foreach (qw(default options required hidden implies multiple _show_in_galaxy _galaxy_specific data_format default_format file_format)) {
|
|
|
124 if ( defined $set_attr{$_} ) {
|
|
|
125 $attr{$_} = $set_attr{$_};
|
|
|
126 }
|
|
|
127 }
|
|
|
128
|
|
|
129 # Now, if validate is set, we can choose a type and possibly do other coersion.
|
|
|
130 if ( $set_attr{'validate'} ) {
|
|
|
131 my $validate = $set_attr{'validate'};
|
|
|
132 my $p;
|
|
|
133 if ( $validate eq 'Flag' ) {
|
|
|
134 require CPT::Parameter::Flag;
|
|
|
135 $p = CPT::Parameter::Flag->new(%attr);
|
|
|
136 }
|
|
|
137 elsif ( $validate eq 'Float' ) {
|
|
|
138 foreach (qw(min max)) {
|
|
|
139 if ( $set_attr{$_} ) {
|
|
|
140 $attr{$_} = $set_attr{$_};
|
|
|
141 }
|
|
|
142 }
|
|
|
143 require CPT::Parameter::Float;
|
|
|
144 $p = CPT::Parameter::Float->new(%attr);
|
|
|
145 }
|
|
|
146 elsif ( $validate eq 'Int' ) {
|
|
|
147 foreach (qw(min max)) {
|
|
|
148 if ( $set_attr{$_} ) {
|
|
|
149 $attr{$_} = $set_attr{$_};
|
|
|
150 }
|
|
|
151 }
|
|
|
152 require CPT::Parameter::Int;
|
|
|
153 $p = CPT::Parameter::Int->new(%attr);
|
|
|
154 }
|
|
|
155 elsif ( $validate eq 'Option' ) {
|
|
|
156 foreach (qw(options)) {
|
|
|
157 if ( $set_attr{$_} ) {
|
|
|
158 $attr{$_} = $set_attr{$_};
|
|
|
159 }
|
|
|
160 }
|
|
|
161 require CPT::Parameter::Option::Generic;
|
|
|
162 $p = CPT::Parameter::Option::Generic->new(%attr);
|
|
|
163 }
|
|
|
164 elsif ( $validate eq 'String' ) {
|
|
|
165 require CPT::Parameter::String;
|
|
|
166 $p = CPT::Parameter::String->new(%attr);
|
|
|
167 }
|
|
|
168 elsif ( $validate eq 'File/Input' ) {
|
|
|
169 require CPT::Parameter::File::Input;
|
|
|
170 $p = CPT::Parameter::File::Input->new(%attr);
|
|
|
171 }
|
|
|
172 elsif ( $validate eq 'File/Output' ) {
|
|
|
173 require CPT::Parameter::File::Output;
|
|
|
174 $p = CPT::Parameter::File::Output->new(%attr);
|
|
|
175 }
|
|
|
176 elsif ( $validate eq 'File/OutputFormat' ) {
|
|
|
177 require CPT::Parameter::File::OutputFormat;
|
|
|
178 $p = CPT::Parameter::File::OutputFormat->new(%attr);
|
|
|
179 }
|
|
|
180 elsif ( $validate eq 'Genomic/Tag' ) {
|
|
|
181 require CPT::Parameter::Option::Genomic_Tag;
|
|
|
182 $p = CPT::Parameter::Option::Genomic_Tag->new(%attr);
|
|
|
183 }
|
|
|
184 else {
|
|
|
185 die 'Unknown validation type: ' . $validate;
|
|
|
186 }
|
|
|
187 return $p;
|
|
|
188 }
|
|
|
189 else {
|
|
|
190 require CPT::Parameter::Flag;
|
|
|
191 my $p = CPT::Parameter::Flag->new(%attr);
|
|
|
192 return $p;
|
|
|
193 }
|
|
|
194 }
|
|
|
195
|
|
|
196 sub _coerce_param {
|
|
|
197 my ( $self, $param ) = @_;
|
|
|
198 if ( ref($param) eq 'ARRAY' ) {
|
|
|
199 my @parts = @{$param};
|
|
|
200 if ( scalar @parts == 0 ) {
|
|
|
201 return $self->_coerce0(@parts);
|
|
|
202 }
|
|
|
203 elsif ( scalar @parts == 1 ) {
|
|
|
204 return $self->_coerce1(@parts);
|
|
|
205 }
|
|
|
206 elsif ( scalar @parts == 2 ) {
|
|
|
207 return $self->_coerce2(@parts);
|
|
|
208 }
|
|
|
209 else {
|
|
|
210 return $self->_coerce3(@parts);
|
|
|
211 }
|
|
|
212 }
|
|
|
213 else {
|
|
|
214 die 'A non-array type was attempted to be coerced...';
|
|
|
215 }
|
|
|
216 }
|
|
|
217
|
|
|
218
|
|
|
219 sub get_by_name {
|
|
|
220 my ( $self, $name ) = @_;
|
|
|
221 for my $item ( @{ $self->params() } ) {
|
|
|
222 if ( defined $item->name() && $item->name() eq $name ) {
|
|
|
223 return $item;
|
|
|
224 }
|
|
|
225 }
|
|
|
226 return;
|
|
|
227 }
|
|
|
228
|
|
|
229
|
|
|
230 sub getopt {
|
|
|
231 my ($self) = @_;
|
|
|
232 my @clean_opt_spec;
|
|
|
233
|
|
|
234 # Loop through each item
|
|
|
235 for my $item ( @{ $self->params() } ) {
|
|
|
236 my $type = ref($item);
|
|
|
237
|
|
|
238 # If it's an array, that means it's definitely an old style
|
|
|
239 if ( $type eq 'ARRAY' ) {
|
|
|
240
|
|
|
241 # And we can push it through without any issues
|
|
|
242 push( @clean_opt_spec, $item );
|
|
|
243 }
|
|
|
244
|
|
|
245 # If it's a hash, it's probably one of the { one_of/xor/etc }
|
|
|
246 elsif ( $type eq 'CPT::ParameterGroup' ) {
|
|
|
247
|
|
|
248 # D:
|
|
|
249 push( @clean_opt_spec, $item->flattenOptionsArray() );
|
|
|
250 }
|
|
|
251
|
|
|
252 # Otherwise it's one of our CPT::Parameter stuff
|
|
|
253 else {
|
|
|
254
|
|
|
255 # Otherwise, we'll use the method to transform our complex object into a GetOpt compatible item
|
|
|
256 push( @clean_opt_spec, $item->getOptionsArray() );
|
|
|
257 }
|
|
|
258 }
|
|
|
259 return @clean_opt_spec;
|
|
|
260 }
|
|
|
261
|
|
|
262
|
|
|
263 sub populate_from_getopt {
|
|
|
264 my ( $self, $opt ) = @_;
|
|
|
265 # Loop through each item
|
|
|
266 for my $item ( @{ $self->params() } ) {
|
|
|
267 # If it's has a name, and options supplies a value for that name
|
|
|
268 if ( defined($item->name()) && defined ($opt->{$item->name()})){
|
|
|
269 $item->value($opt->{ $item->name() });
|
|
|
270 }
|
|
|
271 }
|
|
|
272 }
|
|
|
273
|
|
|
274 no Moose;
|
|
|
275 1;
|
|
|
276
|
|
|
277 __END__
|
|
|
278
|
|
|
279 =pod
|
|
|
280
|
|
|
281 =encoding UTF-8
|
|
|
282
|
|
|
283 =head1 NAME
|
|
|
284
|
|
|
285 CPT::ParameterCollection
|
|
|
286
|
|
|
287 =head1 VERSION
|
|
|
288
|
|
|
289 version 1.99.4
|
|
|
290
|
|
|
291 =head2 validate
|
|
|
292
|
|
|
293 $pC->validate();
|
|
|
294
|
|
|
295 calls the validate method, which loops through and checks that user values line
|
|
|
296 up with the validate method in each and every slot.
|
|
|
297
|
|
|
298 =head2 push_group
|
|
|
299
|
|
|
300 $pC->push_group(CPT::Parameter::Flag->new( <snip> ));
|
|
|
301
|
|
|
302 Push a new groupeter onto the array
|
|
|
303
|
|
|
304 =head2 push_param
|
|
|
305
|
|
|
306 $pC->push_param(CPT::Parameter::Flag->new( <snip> ));
|
|
|
307
|
|
|
308 Push a new parameter onto the array
|
|
|
309
|
|
|
310 =head2 push_params
|
|
|
311
|
|
|
312 $pC->push_param([
|
|
|
313 <snip some params>
|
|
|
314 ]);
|
|
|
315
|
|
|
316 Pushes a lot of params at once onto the array
|
|
|
317
|
|
|
318 =head2 parse_short_name
|
|
|
319
|
|
|
320 $pc->parse_short_name("file|f");
|
|
|
321 # would return "f"
|
|
|
322
|
|
|
323 =head2 parse_long_name
|
|
|
324
|
|
|
325 $pc->parse_long_name("file|f");
|
|
|
326 # would return "file"
|
|
|
327
|
|
|
328 =head2 _coerce_param
|
|
|
329
|
|
|
330 $pc->_coerce_param(["file|f","input file",{validate=>'File/Input'}]);
|
|
|
331
|
|
|
332 would return a CPT::Parameter::File::Input object.
|
|
|
333
|
|
|
334 =head2 get_by_name
|
|
|
335
|
|
|
336 $pC->get_by_name('format');
|
|
|
337
|
|
|
338 returns the CPT::Parameter object with that key.
|
|
|
339
|
|
|
340 =head2 getopt
|
|
|
341
|
|
|
342 my @getopt_compatible_array = $pC->getopt()
|
|
|
343
|
|
|
344 Returns a getopt compatible array by looping through the array and simply returning array objects, and calling the getOptionsArray method on CPT::Parameter::* objects
|
|
|
345
|
|
|
346 =head2 populate_from_getopt
|
|
|
347
|
|
|
348 $parameterCollection->populate_from_getopt($opt);
|
|
|
349
|
|
|
350 Populate the ->value() from getopt.
|
|
|
351
|
|
|
352 =head1 AUTHOR
|
|
|
353
|
|
|
354 Eric Rasche <rasche.eric@yandex.ru>
|
|
|
355
|
|
|
356 =head1 COPYRIGHT AND LICENSE
|
|
|
357
|
|
|
358 This software is Copyright (c) 2014 by Eric Rasche.
|
|
|
359
|
|
|
360 This is free software, licensed under:
|
|
|
361
|
|
|
362 The GNU General Public License, Version 3, June 2007
|
|
|
363
|
|
|
364 =cut
|
