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

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::Galaxy;
2 use Moose;
3 use strict;
4 use warnings;
5 use Data::Dumper;
6 use autodie;
7
8
9 sub gen {
10 my ( $self, %p ) = @_;
11 my $parameterCollection = $p{full_options};
12 my @opt_spec = @{ $parameterCollection->params() }; # This feels bad?
13 my %defaults = @{ $p{defaults} };
14 my @outputs = @{ $p{outputs} };
15 my @tests;
16 if(defined $p{tests} && ref $p{tests} eq 'ARRAY'){
17 @tests = @{ $p{tests} };
18 }
19
20 my $optional_output_file = $p{_output_file};
21
22 #my @registered_outputs = @{ $outputs{'registered'} };
23 my $appid = $p{appid};
24 my $appname = $p{appname};
25 my $appdesc = $p{appdesc};
26 my $appvers = $p{appvers};
27
28 # Set up the XML Writer
29 require XML::Writer;
30 my $xml_writer;
31 if($optional_output_file){
32 $xml_writer = XML::Writer->new(OUTPUT => $optional_output_file);
33 }else{
34 $xml_writer = XML::Writer->new();
35 }
36
37 # Set up the tool element
38 $xml_writer->startTag(
39 'tool',
40 id => $appid,
41 name => $appname,
42 version => $appvers,
43 );
44
45 # Add all of our sections, passing a single xml_writer around.
46 $self->description_section($xml_writer,$appdesc);
47 $self->version_section($xml_writer);
48 $self->stdio_section($xml_writer);
49
50 $self->command_section($xml_writer,\@opt_spec);
51 $self->input_section($xml_writer,\@opt_spec);
52 $self->output_section($xml_writer,\@opt_spec);
53
54 $self->help_section($xml_writer);
55
56 $self->test_section($xml_writer, @tests);
57
58 $xml_writer->endTag('tool');
59 $xml_writer->end();
60 # End of tool xml conf
61
62 # if OOF was set to 'self', that means it's stored internally, so we should return
63 if(defined $optional_output_file && $optional_output_file eq 'self'){
64 return $xml_writer->to_string;
65 }
66 }
67
68 sub test_section {
69 my ($self, $xml_writer, @test_cases) = @_;
70 $xml_writer->startTag('tests');
71 foreach my $test(@test_cases){
72 my %test_details = %{$test};
73 $xml_writer->startTag('test');
74 # Each test case has: name, params, outputs
75
76 # Params will be as they're specified on the command line, so they /should/ be okay to use in galaxy code.
77 my %params = %{$test_details{'params'}};
78 foreach(sort(keys(%params))){
79 # As written, will not handle multiply valued attributes
80 $xml_writer->startTag('param',
81 name => $_,
82 value => $params{$_},
83 );
84 $xml_writer->endTag();
85 }
86 # outputs
87 my %outputs = %{$test_details{'outputs'}};
88 foreach(sort(keys(%outputs))){
89 # As written, will not handle multiple outputs well
90 # This bit of code because for every output there's a
91 # name you expect on the command line, and a file you
92 # want to compare against (galaxy mucks about with
93 # names so we don't have to worry about it. However,
94 # from the command line, we have to know the name of
95 # the output file we're going to produce so we can
96 # compare it against another copy of this file. It's
97 # less than ideal, but there's not much we can do.
98 my @output_cmp = @{$outputs{$_}};
99 $xml_writer->startTag('output',
100 name => $_,
101 file => $output_cmp[1],
102 );
103 $xml_writer->endTag();
104 }
105 $xml_writer->endTag();
106 }
107 $xml_writer->endTag();
108 }
109
110 sub description_section{
111 my ($self, $xml_writer, $appdesc) = @_;
112 $xml_writer->startTag('description');
113 $xml_writer->characters(sprintf('%s',$appdesc));
114 $xml_writer->endTag('description');
115 }
116
117 sub version_section{
118 my ($self, $xml_writer) = @_;
119 $xml_writer->startTag('version_command');
120 $xml_writer->characters("perl $0 --version");
121 $xml_writer->endTag('version_command');
122 }
123 sub stdio_section{
124 my ($self, $xml_writer) = @_;
125 $xml_writer->startTag('stdio');
126 $xml_writer->startTag(
127 'exit_code',
128 range => "1:",
129 level => "fatal",
130 );
131 $xml_writer->endTag('exit_code');
132 $xml_writer->endTag('stdio');
133 }
134 sub command_section{
135 ###################
136 # COMMAND SECTION #
137 ###################
138 my ($self, $xml_writer,$opt_spec_ref) = @_;
139 my @opt_spec = @{$opt_spec_ref};
140 $xml_writer->startTag(
141 'command',
142 interpreter => 'perl',
143 );
144 my $command_string = join("\n", $0, '--galaxy','--outfile_supporting $__new_file_path__','');
145 foreach (@opt_spec) {
146 if(
147 # not galaxy specific and we are not instructed to hide
148 !$_->_galaxy_specific() && $_->_show_in_galaxy()
149 ||
150 # is galaxy specific and is hidden
151 $_->_galaxy_specific() && $_->hidden() && $_->_show_in_galaxy()
152 ){
153 #if(!$_->hidden() || ){
154 my $command_addition = $_->galaxy_command();
155 if($command_addition){
156 $command_string .= $command_addition . "\n";
157 }
158 }
159 }
160 $xml_writer->characters($command_string);
161 $xml_writer->endTag('command');
162 }
163 sub input_section{
164 my ($self, $xml_writer,$opt_spec_ref) = @_;
165 my @opt_spec = @{$opt_spec_ref};
166 #################
167 # INPUT SECTION #
168 #################
169 $xml_writer->startTag('inputs');
170 foreach (@opt_spec) {
171 if(
172 # not galaxy specific and we are not instructed to hide
173 !$_->hidden() && !$_->_galaxy_specific() && $_->_show_in_galaxy()
174 ){
175 $_->galaxy_input($xml_writer);
176 }
177 }
178 $xml_writer->endTag('inputs');
179 }
180 sub output_section{
181 my ($self, $xml_writer,$opt_spec_ref) = @_;
182 my @opt_spec = @{$opt_spec_ref};
183 ##################
184 # OUTPUT SECTION #
185 ##################
186 $xml_writer->startTag('outputs');
187 foreach (@opt_spec) {
188 if(
189 # not galaxy specific and we are not instructed to hide
190 !$_->_galaxy_specific() && $_->_show_in_galaxy()
191 ){
192 $_->galaxy_output($xml_writer);
193 }
194 }
195 $xml_writer->endTag('outputs');
196 }
197 sub help_section{
198 my ($self, $xml_writer) = @_;
199 ################
200 # HELP SECTION #
201 ################
202
203 $xml_writer->startTag('help');
204 # Here we incur some dependencies. D:
205 use IPC::Run3;
206 my ($in,$out,$err);
207 use File::Temp;
208 my $tempfile = File::Temp->new(
209 TEMPLATE => 'libcpt.galaxy.tempXXXXX',
210 DIR => '/tmp/',
211 UNLINK => 1,
212 SUFFIX => '.html'
213 );
214
215 use File::Which;
216 my $pod2md = which("pod2markdown");
217 if(! defined($pod2md)){
218 print STDERR "pod2markdown not available. Install Pod::Markdown";
219 }else{
220 my @command = ('pod2markdown',$0,$tempfile);
221 run3 \@command, \$in, \$out, \$err;
222 # Pandoc
223 my $pandoc = which("pandoc");
224 if(! defined($pandoc)){
225 print STDERR "Pandoc not available, cannot convert to RST";
226 }else{
227 @command = ("pandoc",'-f','markdown','-t','rst', $tempfile);
228 run3 \@command, \$in, \$out, \$err;
229 if(-e $tempfile){
230 unlink($tempfile);
231 }
232 $xml_writer->characters($out);
233 }
234 }
235 $xml_writer->endTag('help');
236 }
237
238 no Moose;
239 1;
240
241 __END__
242
243 =pod
244
245 =encoding UTF-8
246
247 =head1 NAME
248
249 CPT::Galaxy
250
251 =head1 VERSION
252
253 version 1.99.4
254
255 =head2 gen
256
257 require CPT::Galaxy;
258 my $galaxy_xml_generator = CPT::Galaxy->new();
259 $galaxy_xml_generator->gen(
260 full_options => \@options_specification,
261 appdesc => $self->{'appdesc'},
262 appid => $self->{'appid'},
263 appname => $self->{'appname'},
264 defaults => $passed_opts{'defaults'},
265 outputs => $passed_opts{'outputs'},
266 );
267
268 Generates a galaxy XML file (using XML::Writer) from the options_specification object, which is an array of
269 ['file|f=s', "blah", {some_req => 'some_val'] and CPT::Parameter::* objects. For simplicity, the first type
270 is currently DEPRECATED
271
272 =head1 AUTHOR
273
274 Eric Rasche <rasche.eric@yandex.ru>
275
276 =head1 COPYRIGHT AND LICENSE
277
278 This software is Copyright (c) 2014 by Eric Rasche.
279
280 This is free software, licensed under:
281
282 The GNU General Public License, Version 3, June 2007
283
284 =cut