Mercurial > repos > cpt > cpt_psm_plotter

comparison lib/CPT/Galaxy.pm @ 1:8691c1c61a8e 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:48:47 +0000
parents
children
comparison
equal deleted inserted replaced
0:54c7a3ea81e2 1:8691c1c61a8e
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