diff lib/CPT/Galaxy.pm @ 1:8691c1c61a8e draft default tip

planemo upload commit 94b0cd1fff0826c6db3e7dc0c91c0c5a8be8bb0c
author cpt
date Mon, 05 Jun 2023 02:48:47 +0000
parents
children
line wrap: on
line diff
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/lib/CPT/Galaxy.pm	Mon Jun 05 02:48:47 2023 +0000
@@ -0,0 +1,284 @@
+package CPT::Galaxy;
+use Moose;
+use strict;
+use warnings;
+use Data::Dumper;
+use autodie;
+
+
+sub gen {
+	my ( $self, %p ) = @_;
+	my $parameterCollection = $p{full_options};
+	my @opt_spec            = @{ $parameterCollection->params() };    # This feels bad?
+	my %defaults            = @{ $p{defaults} };
+	my @outputs             = @{ $p{outputs} };
+	my @tests;
+	if(defined $p{tests} && ref $p{tests} eq 'ARRAY'){
+	    @tests = @{ $p{tests} };
+	}
+
+	my $optional_output_file = $p{_output_file};
+
+	#my @registered_outputs = @{ $outputs{'registered'} };
+	my $appid   = $p{appid};
+	my $appname = $p{appname};
+	my $appdesc = $p{appdesc};
+	my $appvers = $p{appvers};
+
+	# Set up the XML Writer
+	require XML::Writer;
+	my $xml_writer;
+	if($optional_output_file){
+		$xml_writer = XML::Writer->new(OUTPUT => $optional_output_file);
+	}else{
+		$xml_writer = XML::Writer->new();
+	}
+
+	# Set up the tool element
+	$xml_writer->startTag(
+		'tool',
+		id      => $appid,
+		name    => $appname,
+		version => $appvers,
+	);
+
+	# Add all of our sections, passing a single xml_writer around.
+	$self->description_section($xml_writer,$appdesc);
+	$self->version_section($xml_writer);
+	$self->stdio_section($xml_writer);
+
+	$self->command_section($xml_writer,\@opt_spec);
+	$self->input_section($xml_writer,\@opt_spec);
+	$self->output_section($xml_writer,\@opt_spec);
+
+	$self->help_section($xml_writer);
+
+	$self->test_section($xml_writer, @tests);
+
+	$xml_writer->endTag('tool');
+	$xml_writer->end();
+	# End of tool xml conf
+	
+	# if OOF was set to 'self', that means it's stored internally, so we should return
+	if(defined $optional_output_file && $optional_output_file eq 'self'){
+		return $xml_writer->to_string;
+	}
+}
+
+sub test_section {
+	my ($self, $xml_writer, @test_cases) = @_;
+	$xml_writer->startTag('tests');
+	foreach my $test(@test_cases){
+		my %test_details = %{$test};
+		$xml_writer->startTag('test');
+		# Each test case has: name, params, outputs
+
+		# Params will be as they're specified on the command line, so they /should/ be okay to use in galaxy code.
+		my %params = %{$test_details{'params'}};
+		foreach(sort(keys(%params))){
+			# As written, will not handle multiply valued attributes
+			$xml_writer->startTag('param',
+				name  => $_,
+				value => $params{$_},
+			);
+			$xml_writer->endTag();
+		}
+		# outputs
+		my %outputs = %{$test_details{'outputs'}};
+		foreach(sort(keys(%outputs))){
+			# As written, will not handle multiple outputs well
+			# This bit of code because for every output there's a
+			# name you expect on the command line, and a file you
+			# want to compare against (galaxy mucks about with
+			# names so we don't have to worry about it. However,
+			# from the command line, we have to know the name of
+			# the output file we're going to produce so we can
+			# compare it against another copy of this file. It's
+			# less than ideal, but there's not much we can do.
+			my @output_cmp = @{$outputs{$_}};
+			$xml_writer->startTag('output',
+				name => $_,
+				file => $output_cmp[1],
+			);
+			$xml_writer->endTag();
+		}
+		$xml_writer->endTag();
+	}
+	$xml_writer->endTag();
+}
+
+sub description_section{
+	my ($self, $xml_writer, $appdesc) = @_;
+	$xml_writer->startTag('description');
+	$xml_writer->characters(sprintf('%s',$appdesc));
+	$xml_writer->endTag('description');
+}
+
+sub version_section{
+	my ($self, $xml_writer) = @_;
+	$xml_writer->startTag('version_command');
+	$xml_writer->characters("perl $0 --version");
+	$xml_writer->endTag('version_command');
+}
+sub stdio_section{
+	my ($self, $xml_writer) = @_;
+	$xml_writer->startTag('stdio');
+	$xml_writer->startTag(
+		'exit_code',
+		range => "1:",
+		level => "fatal",
+	);
+	$xml_writer->endTag('exit_code');
+	$xml_writer->endTag('stdio');
+}
+sub command_section{
+	###################
+	# COMMAND SECTION #
+	###################
+	my ($self, $xml_writer,$opt_spec_ref) = @_;
+	my @opt_spec = @{$opt_spec_ref};
+	$xml_writer->startTag(
+		'command',
+		interpreter      => 'perl',
+	);
+	my $command_string = join("\n", $0, '--galaxy','--outfile_supporting $__new_file_path__','');
+	foreach (@opt_spec) {
+		if(
+		    # not galaxy specific and we are not instructed to hide
+		    !$_->_galaxy_specific() && $_->_show_in_galaxy()
+		    ||
+		    # is galaxy specific and is hidden
+		    $_->_galaxy_specific() && $_->hidden() && $_->_show_in_galaxy() 
+		){
+		#if(!$_->hidden() || ){
+			my $command_addition = $_->galaxy_command();
+			if($command_addition){
+				$command_string .= $command_addition . "\n";
+			}
+		}
+	}
+	$xml_writer->characters($command_string);
+	$xml_writer->endTag('command');
+}
+sub input_section{
+	my ($self, $xml_writer,$opt_spec_ref) = @_;
+	my @opt_spec = @{$opt_spec_ref};
+	#################
+	# INPUT SECTION #
+	#################
+	$xml_writer->startTag('inputs');
+	foreach (@opt_spec) {
+		if(
+		    # not galaxy specific and we are not instructed to hide
+			!$_->hidden() && !$_->_galaxy_specific() && $_->_show_in_galaxy()
+		){
+			$_->galaxy_input($xml_writer);
+		}
+	}
+	$xml_writer->endTag('inputs');
+}
+sub output_section{
+	my ($self, $xml_writer,$opt_spec_ref) = @_;
+	my @opt_spec = @{$opt_spec_ref};
+	##################
+	# OUTPUT SECTION #
+	##################
+	$xml_writer->startTag('outputs');
+	foreach (@opt_spec) {
+		if(
+		    # not galaxy specific and we are not instructed to hide
+		    !$_->_galaxy_specific() && $_->_show_in_galaxy()
+		){
+			$_->galaxy_output($xml_writer);
+		}
+	}
+	$xml_writer->endTag('outputs');
+}
+sub help_section{
+	my ($self, $xml_writer) = @_;
+	################
+	# HELP SECTION #
+	################
+
+	$xml_writer->startTag('help');
+	# Here we incur some dependencies. D:
+	use IPC::Run3;
+	my ($in,$out,$err);
+	use File::Temp;
+	my $tempfile = File::Temp->new(
+		TEMPLATE => 'libcpt.galaxy.tempXXXXX',
+		DIR      => '/tmp/',
+		UNLINK   => 1,
+		SUFFIX   => '.html'
+	);
+
+	use File::Which;
+	my $pod2md = which("pod2markdown");
+	if(! defined($pod2md)){
+		print STDERR "pod2markdown not available. Install Pod::Markdown";
+	}else{
+		my @command = ('pod2markdown',$0,$tempfile);
+		run3 \@command, \$in, \$out, \$err;
+		# Pandoc
+		my $pandoc = which("pandoc");
+		if(! defined($pandoc)){
+			print STDERR "Pandoc not available, cannot convert to RST";
+		}else{
+			@command = ("pandoc",'-f','markdown','-t','rst', $tempfile);
+			run3 \@command, \$in, \$out, \$err;
+			if(-e $tempfile){
+			    unlink($tempfile);
+			}
+			$xml_writer->characters($out);
+		}
+	}
+	$xml_writer->endTag('help');
+}
+
+no Moose;
+1;
+
+__END__
+
+=pod
+
+=encoding UTF-8
+
+=head1 NAME
+
+CPT::Galaxy
+
+=head1 VERSION
+
+version 1.99.4
+
+=head2 gen
+
+	require CPT::Galaxy;
+	my $galaxy_xml_generator = CPT::Galaxy->new();
+	$galaxy_xml_generator->gen(
+		full_options => \@options_specification,
+		appdesc      => $self->{'appdesc'},
+		appid        => $self->{'appid'},
+		appname      => $self->{'appname'},
+		defaults     => $passed_opts{'defaults'},
+		outputs      => $passed_opts{'outputs'},
+	);
+
+Generates a galaxy XML file (using XML::Writer) from the options_specification object, which is an array of 
+['file|f=s', "blah", {some_req => 'some_val'] and CPT::Parameter::* objects. For simplicity, the first type 
+is currently DEPRECATED
+
+=head1 AUTHOR
+
+Eric Rasche <rasche.eric@yandex.ru>
+
+=head1 COPYRIGHT AND LICENSE
+
+This software is Copyright (c) 2014 by Eric Rasche.
+
+This is free software, licensed under:
+
+  The GNU General Public License, Version 3, June 2007
+
+=cut