Mercurial > repos > cpt > cpt_psm_plotter

comparison cpt_psm_plotter/lib/CPT/ParameterCollection.pm @ 0:54c7a3ea81e2 draft

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Uploaded
author cpt
date Tue, 05 Jul 2022 05:40:36 +0000
parents
children
comparison
equal deleted inserted replaced
-1:000000000000 0:54c7a3ea81e2
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