Mercurial > repos > cpt > cpt_psm_comparison_table

comparison lib/CPT/ParameterCollection.pm @ 1:f093e08f21f3 draft default tip

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
planemo upload commit 94b0cd1fff0826c6db3e7dc0c91c0c5a8be8bb0c
author cpt
date Mon, 05 Jun 2023 02:47:24 +0000
parents
children
comparison
equal deleted inserted replaced
0:b8b8b52904a5 1:f093e08f21f3
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