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