Mercurial > repos > cpt > cpt_psm_plotter
comparison lib/CPT/Parameter.pm @ 1:8691c1c61a8e draft default tip
planemo upload commit 94b0cd1fff0826c6db3e7dc0c91c0c5a8be8bb0c
author | cpt |
---|---|
date | Mon, 05 Jun 2023 02:48:47 +0000 |
parents | |
children |
comparison
equal
deleted
inserted
replaced
0:54c7a3ea81e2 | 1:8691c1c61a8e |
---|---|
1 package CPT::Parameter; | |
2 use Moose::Role; | |
3 use strict; | |
4 use warnings; | |
5 use autodie; | |
6 use Carp; | |
7 | |
8 #requires 'galaxy_command'; | |
9 requires 'galaxy_input'; | |
10 requires 'galaxy_output'; | |
11 requires 'validate_individual'; | |
12 requires 'getopt_format'; | |
13 | |
14 # Long name for this parameter (mandatory) | |
15 has 'name' => ( is => 'rw', isa => 'Str' ); | |
16 | |
17 # Short name for this paramter (optional) | |
18 has 'short' => ( is => 'rw', isa => 'Str' ); | |
19 has 'multiple' => ( is => 'rw', isa => 'Bool' ); | |
20 has 'description' => ( is => 'rw', isa => 'Str' ); | |
21 | |
22 # Attr | |
23 # Default supplied parameters | |
24 has 'default' => ( is => 'rw', isa => 'Any' ); | |
25 # User supplied values | |
26 has 'value' => ( is => 'rw', isa => 'Any' ); | |
27 has 'required' => ( is => 'rw', isa => 'Bool' ); | |
28 has 'hidden' => ( is => 'rw', isa => 'Bool' ); | |
29 | |
30 # Set of error messages to be returned | |
31 has 'errors' => ( is => 'rw', isa => 'ArrayRef', default => sub { [] } ); | |
32 | |
33 # Unimplemented | |
34 # Are there any implications of setting this | |
35 has 'implies' => ( is => 'rw', isa => 'ArrayRef' ); | |
36 | |
37 # Internal | |
38 has '_index' => ( is => 'rw', isa => 'Int', default => 0 ); | |
39 | |
40 # Galaxy Specific | |
41 has '_galaxy_specific' => (is => 'rw', isa => 'Bool', default => 0); | |
42 # implies option is somehow intertwined with whether or not this is being produced for use in galaxy. | |
43 has '_show_in_galaxy' => (is => 'rw', isa => 'Bool', default => 1); | |
44 # This is a custom override. If the object is hidden by default, it will causae it to be shown. If the object is visible by default, it can cause it to be hidden. | |
45 | |
46 | |
47 | |
48 sub galaxy_command { | |
49 my ($self) = @_; | |
50 my $value = $self->get_galaxy_command_identifier(); | |
51 | |
52 # If it's hidden, specific to galaxy, and hidden from galaxy users, | |
53 # then it is safe to assume we've specified a SANE default. | |
54 if($self->hidden() && $self->_galaxy_specific()){ | |
55 $value = $self->default(); | |
56 } | |
57 my $string; | |
58 | |
59 # If it's a repeat, we handle that | |
60 $string .= $self->handle_possible_galaxy_command_repeat_start(); | |
61 # If it's required we set it to a value IF we have one. Otherwise value | |
62 # will be the galaxy_identifier. | |
63 if($self->required()){ | |
64 $string .= sprintf( '--%s "${%s}"' . "\n", | |
65 $self->get_galaxy_cli_identifier(), $value | |
66 ); | |
67 }else{ | |
68 # If | |
69 # This code is only relevant if we're multiple, otherwise the loop will | |
70 # not pass here | |
71 if ( !$self->multiple() ){ | |
72 $string .= sprintf('#if $%s and $%s is not "None":' . "\n", | |
73 $self->get_galaxy_cli_identifier(), | |
74 $self->get_galaxy_cli_identifier() | |
75 ); | |
76 } | |
77 # Flag | |
78 $string .= sprintf( '--%s "${%s}"'."\n", | |
79 $self->get_galaxy_cli_identifier(), | |
80 $value | |
81 ); | |
82 # End | |
83 if ( !$self->multiple() ){ | |
84 $string .= "#end if\n"; | |
85 } | |
86 } | |
87 $string .= $self->handle_possible_galaxy_command_repeat_end(); | |
88 return $string; | |
89 } | |
90 | |
91 | |
92 | |
93 sub getOptionsArray { | |
94 my ($self) = @_; | |
95 my @getoptions; | |
96 push( @getoptions, $self->getopt_identifier() ); | |
97 | |
98 my $mod_desc = $self->description(); | |
99 if(defined $self->default()){ | |
100 if(ref $self->default() eq 'ARRAY'){ | |
101 $mod_desc .= sprintf(" (Default: %s)", join(",",@{$self->default()})); | |
102 }else{ | |
103 $mod_desc .= sprintf(" (Default: %s)", $self->default()); | |
104 } | |
105 } | |
106 if(substr(blessed($self),0,22) eq 'CPT::Parameter::Option'){ | |
107 my %kv = %{$self->options()}; | |
108 my @k = keys(%kv); | |
109 $mod_desc .= sprintf(" (Options: %s)", | |
110 join( | |
111 ", ", | |
112 map { $kv{$_} . " [$_]" } @k | |
113 ) | |
114 ); | |
115 }else{ | |
116 } | |
117 | |
118 push( @getoptions, $mod_desc ); | |
119 | |
120 # Values to copy over: required, hidden, default, values | |
121 my %attr = (); | |
122 if ( $self->required() ) { | |
123 $attr{required} = $self->required(); | |
124 } | |
125 if ( $self->hidden() ) { | |
126 $attr{hidden} = $self->hidden(); | |
127 } | |
128 if ( $self->default() ) { | |
129 $attr{default} = $self->default(); | |
130 } | |
131 push( @getoptions, \%attr ); | |
132 return \@getoptions; | |
133 } | |
134 | |
135 | |
136 sub getopt_identifier { | |
137 my ($self) = @_; | |
138 if ( defined( $self->short() ) && length($self->short()) > 0 ) { | |
139 return sprintf( "%s|%s%s%s", $self->name(), $self->short(), $self->getopt_format(), ( $self->multiple() ? '@' : '' ), ); | |
140 } | |
141 else { | |
142 return sprintf( "%s%s%s", $self->name(), $self->getopt_format(), ( $self->multiple() ? '@' : '' ), ) | |
143 | |
144 } | |
145 } | |
146 | |
147 | |
148 sub get_galaxy_command_identifier { | |
149 my ($self) = @_; | |
150 if($self->multiple()){ | |
151 return sprintf('%s.%s', $self->get_repeat_idx_name(), $self->get_galaxy_cli_identifier()); | |
152 }else{ | |
153 return $self->get_galaxy_cli_identifier(); | |
154 } | |
155 } | |
156 | |
157 | |
158 sub get_galaxy_cli_identifier { | |
159 my ($self) = @_; | |
160 return $self->name(); | |
161 } | |
162 | |
163 | |
164 sub is_optional { | |
165 my ($self) = @_; | |
166 # Want coerced to int. | |
167 #return !$self->required(); | |
168 if($self->required()){ | |
169 return 0; | |
170 }else{ | |
171 return 1; | |
172 } | |
173 } | |
174 | |
175 | |
176 sub is_optional_galaxy { | |
177 my ($self) = @_; | |
178 return $self->is_optional() ? "True" : "False"; | |
179 } | |
180 | |
181 | |
182 sub update_index { | |
183 my ($self) = @_; | |
184 if($self->multiple()){ | |
185 my $size = scalar( @{ $self->value() } ); | |
186 # E.g: | |
187 # [1,2,3] , size = 3 | |
188 # index = 3 | |
189 # size = 3-1 = 2 | |
190 # index -> 0 | |
191 if ( $self->_index() ge $size - 1 ) { | |
192 $self->_index(0); | |
193 } | |
194 else { | |
195 $self->_index( $self->_index() + 1 ); | |
196 } | |
197 } | |
198 } | |
199 | |
200 | |
201 sub reset_index { | |
202 my ($self) = @_; | |
203 $self->_index(0); | |
204 } | |
205 | |
206 | |
207 sub get_value { | |
208 my ($self) = @_; | |
209 if ( defined $self->value() ) { | |
210 if ( $self->multiple ) { | |
211 my @data = @{ $self->value() }; | |
212 return $data[ $self->_index() ]; | |
213 } | |
214 else { | |
215 return $self->value(); | |
216 } | |
217 }else{ | |
218 return; | |
219 } | |
220 } | |
221 | |
222 | |
223 sub get_default { | |
224 my ($self) = @_; | |
225 if ( defined $self->default() ) { | |
226 if ( $self->multiple ) { | |
227 my @data = @{ $self->default() }; | |
228 return $data[ $self->_index() ]; | |
229 } | |
230 else { | |
231 return $self->default(); | |
232 } | |
233 }else{ | |
234 return; | |
235 } | |
236 } | |
237 | |
238 | |
239 | |
240 sub validate { | |
241 my ($self) = @_; | |
242 if ( $self->multiple() ) { | |
243 my $errors = 0; | |
244 if( ref($self->value()) ne 'ARRAY' ){ | |
245 carp "Author specified a non-array default value for " . $self->name() . ", which allows multiple values. Script author should modify the default value to be an ArrayRef."; | |
246 } | |
247 for my $val ( @{ $self->value() } ) { | |
248 if($self->validate_individual($val) == 0){ | |
249 $errors++; | |
250 } | |
251 } | |
252 # Must cast to number otherwise it returns "" which is bad since I use | |
253 # 1/0 as T/F (true = good, false = bad) | |
254 return 0+($errors == 0); | |
255 } | |
256 else { | |
257 return 0+$self->validate_individual($self->value()); | |
258 } | |
259 } | |
260 | |
261 | |
262 sub get_repeat_idx_name { | |
263 my ($self) = @_; | |
264 return 'item'; | |
265 } | |
266 | |
267 | |
268 sub get_repeat_name { | |
269 my ($self) = @_; | |
270 if($self->multiple()){ | |
271 return sprintf('repeat_%s', $self->get_galaxy_cli_identifier()); | |
272 }else{ | |
273 confess "Tried to get repeat name for non-multiple item"; | |
274 } | |
275 } | |
276 | |
277 | |
278 sub handle_possible_galaxy_input_repeat_start { | |
279 my ($self, $xml_writer ) = @_; | |
280 if ( $self->multiple() ) { | |
281 my $title = $self->get_galaxy_cli_identifier(); | |
282 $title =~ s/_/ /g; | |
283 # Convert To Title Case (http://www.davekb.com/browse_programming_tips:perl_title_case:txt) | |
284 $title =~ s/(\w+)/\u\L$1/g; | |
285 $xml_writer->startTag( | |
286 'repeat', | |
287 'name' => $self->get_repeat_name(), | |
288 'title' => $title, | |
289 ); | |
290 } | |
291 } | |
292 | |
293 | |
294 sub handle_possible_galaxy_input_repeat_end { | |
295 my ($self, $xml_writer ) = @_; | |
296 if ( $self->multiple() ) { | |
297 $xml_writer->endTag('repeat'); | |
298 } | |
299 } | |
300 | |
301 | |
302 | |
303 sub handle_possible_galaxy_command_repeat_start { | |
304 my ( $self ) = @_; | |
305 if($self->multiple()){ | |
306 return sprintf("#for \$%s in \$%s:\n", | |
307 $self->get_repeat_idx_name(), | |
308 $self->get_repeat_name() | |
309 ); | |
310 }else{ | |
311 return ''; | |
312 } | |
313 } | |
314 | |
315 | |
316 sub handle_possible_galaxy_command_repeat_end { | |
317 my ( $self ) = @_; | |
318 if($self->multiple()){ | |
319 return "#end for\n"; | |
320 }else{ | |
321 return ''; | |
322 } | |
323 } | |
324 | |
325 sub get_default_input_parameters { | |
326 my ( $self, $type ) = @_; | |
327 my %params = ( | |
328 name => $self->get_galaxy_cli_identifier(), | |
329 optional => $self->is_optional_galaxy(), | |
330 label => $self->get_galaxy_cli_identifier(), | |
331 help => $self->description(), | |
332 type => $type, | |
333 ); | |
334 | |
335 # Multiple values would return ARRAY(0xAAAAAAA) locations, so we have to | |
336 # handle those semi-intelligently until galaxy can handle default values | |
337 # for repeats | |
338 if($self->multiple() && defined $self->default()){ | |
339 if(ref($self->default()) ne 'ARRAY'){ | |
340 carp "Author specified a non-array default value for " . $self->name() . ", which allows multiple values. Script author should modify the default value to be an ArrayRef."; | |
341 } | |
342 $params{value} = ${$self->default}[0]; | |
343 }elsif(!$self->multiple() && defined $self->default()){ | |
344 $params{value} = $self->default(); | |
345 } | |
346 | |
347 return %params; | |
348 } | |
349 | |
350 no Moose::Role; | |
351 | |
352 1; | |
353 | |
354 __END__ | |
355 | |
356 =pod | |
357 | |
358 =encoding UTF-8 | |
359 | |
360 =head1 NAME | |
361 | |
362 CPT::Parameter | |
363 | |
364 =head1 VERSION | |
365 | |
366 version 1.99.4 | |
367 | |
368 =head2 galaxy_command | |
369 | |
370 $file_param->galaxy_command(); # where $file_param is a CPT::Parameter::* | |
371 | |
372 Returns the portion of the command used in the <command/> block in galaxy XML files | |
373 | |
374 =head2 getOptionsArray | |
375 | |
376 When called on a CPT::Parameter::* object, it will collapse the object into a GetOpt::Long compatible array | |
377 | |
378 =head2 getopt_identifier | |
379 | |
380 Used for backwards compatability with existing defaults => { 'file|f=s' => "Blah" } format | |
381 | |
382 =head2 get_galaxy_identifier | |
383 | |
384 Returns the identifier associated with a given variable. This identifier is what the Cheetah template knows the variable as (given the correct context). | |
385 | |
386 For non-multiple variables it should be the name of the variable. | |
387 | |
388 For multiple variables it will reference the repeat item name and then the variable name (e.g., C< $item.label >) | |
389 | |
390 =head2 get_galaxy_cli_identifier | |
391 | |
392 Returns the command line identifier (i.e., the command line flag) associated | |
393 with a given parameter. For a `--format` flag, this would return "format". | |
394 This should work out of the box, as CLI parameters have the same name as we | |
395 specify them with (even if they're repeated) | |
396 | |
397 =head2 is_optional | |
398 | |
399 If required, it is NOT optional; If not reqiured, it IS optional | |
400 | |
401 =head2 is_optional_galaxy | |
402 | |
403 Returns is_optional() as "True" or "False" for convenience and reduced code duplication | |
404 | |
405 =head2 update_index | |
406 | |
407 Convenience method to increment the index. This wraps around. | |
408 | |
409 =head2 reset_index | |
410 | |
411 convenience method to zero the index (i.e., the next get_value request will start at the beginning again) | |
412 | |
413 =head2 get_value | |
414 | |
415 Returns the value in the current index. | |
416 | |
417 =head2 get_default | |
418 | |
419 Returns the default in the current index. Something to note, please bear in | |
420 mind this you are trying to access an array based on an index which wraps | |
421 according to value() not according to default(). This means you may not reach | |
422 the end of default/reach over the end of default depending on how many values | |
423 the user actually passes | |
424 | |
425 =head2 validate | |
426 | |
427 Validation logic was eventually moved out here, as the logic for validaton is | |
428 identical everywhere, and requires slightly different behaviour based on | |
429 wheterh or not it's a single/multiple valued item. | |
430 | |
431 =head2 get_repeat_idx_name | |
432 | |
433 Function to obtain the name of the item as it is called inside the repeat. This | |
434 is necessary to know which variable we are referring to within a loop. | |
435 | |
436 =head2 get_repeat_name | |
437 | |
438 Function to obtain the name of the repeat. It is necessary that this is used | |
439 identically in the command section as well as in the input section. | |
440 | |
441 =head2 handle_possible_galaxy_input_repeat_start | |
442 | |
443 If the feature is repeated, this should automatically handle the start of that | |
444 repeat | |
445 | |
446 =head2 handle_possible_galaxy_input_repeat_end | |
447 | |
448 If the feature is repeated, this should automatically handle the end of that | |
449 repeat | |
450 | |
451 =head2 handle_possible_galaxy_command_repeat_start | |
452 | |
453 If the feature is repeated, this should automatically handle the start of that | |
454 repeat with a | |
455 | |
456 #for $item in $repeat_name: | |
457 | |
458 =head2 handle_possible_galaxy_command_repeat_end | |
459 | |
460 If the feature is repeated, this should automatically handle the end of that | |
461 repeat with | |
462 | |
463 #end for | |
464 | |
465 =head1 AUTHOR | |
466 | |
467 Eric Rasche <rasche.eric@yandex.ru> | |
468 | |
469 =head1 COPYRIGHT AND LICENSE | |
470 | |
471 This software is Copyright (c) 2014 by Eric Rasche. | |
472 | |
473 This is free software, licensed under: | |
474 | |
475 The GNU General Public License, Version 3, June 2007 | |
476 | |
477 =cut |