GeneWiz test case

#!/usr/bin/perl
# Description: Construct a simple circular atlas containing AT content and annotations only
# Author: Peter Fischer Hallin
# Email: pfh@cbs.dtu.dk
# Version: 1.0a
# Date: 2009-05-08 


# usage: perl simple.pl L43967 > output.ps

use MIME::Base64;
use strict;
use XML::Compile;
use XML::Compile::WSDL11;
use XML::Compile::Transport::SOAPHTTP;
use MIME::Base64;
use URI::WithBase;

my $ACCESSION = 'L43967';


# load service endpoints of these WSDLs:
warn "loading genewiz wsdl...\n";
my $genewiz = WSDLclient('http://www.cbs.dtu.dk/ws/GeneWiz/GeneWiz_1_0a_ws0.wsdl');
warn "loading genomeatlas wsdl...\n";
my $genomeatlas = WSDLclient('http://www.cbs.dtu.dk/ws/GenomeAtlas/GenomeAtlas_3_0_ws1.wsdl');

warn "requesting genome sequence...\n";
my $getSeqResponse = $genomeatlas->{getSeq}->(parameters => { parameters => { genbank => $ACCESSION  }});
my $id = $getSeqResponse->{parameters}->{output}->{sequencedata}->{sequence}[0]->{id};
my $seq = $getSeqResponse->{parameters}->{output}->{sequencedata}->{sequence}[0]->{seq};
die "no sequence obtained\n" unless $seq =~ /[A-Z]+/gi;

my $lengthText = length ( $seq ) ;
$lengthText =~ s/(\d{1,3}?)(?=(\d{3})+$)/$1,/g;
warn " (got $lengthText bp.)\n";
warn "submitting dna property job (percent at)...\n";
my $DNApropertyRunResponse = $genomeatlas->{DNApropertyRun}->( parameters => { parameters => { method => 'Percent AT' ,  sequence => { 'id' => $id, 'seq' => $seq}}});
my $jobid =  $DNApropertyRunResponse->{queueentry}->{queueentry}->{jobid};
wait_job ($genomeatlas->{pollQueue},$jobid);
my $DNApropertyFetchResultResponse = $genomeatlas->{DNApropertyFetchResult}->( job => {  jobid => $jobid });
die unless $DNApropertyFetchResultResponse;

warn "requesting features...\n";
my $getFeaturesResponse = $genomeatlas->{getFeatures}->( parameters => { parameters => { accession => $ACCESSION , features => 'CDS,rRNA,tRNA',keys => 'none' }});
my @FEATURES;
foreach my $f (@{$getFeaturesResponse->{parameters}->{output}->{features}->{feature}}) {
  push @FEATURES , ({
		      'begin' => $f->{begin} , 
		      'end' => $f->{end} , 
		      'type' => $f->{type} , 
		      'dir' => $f->{dir} , 
		      'label' => $f->{label} 
		     }); 
}
printf STDERR " (got %d entry/entries)\n" , scalar ( @FEATURES );

warn "requesting genome information...\n";
my $queryGenomesResponse = $genomeatlas->{queryGenomes}->(  parameters => { parameters => { genbank =>  $ACCESSION , hideMerged=>'yes'}});
my $organism_name = $queryGenomesResponse->{parameters}->{output}->{entries}->{entry}[0]->{organism};
$organism_name =~ s/^([A-Z])[a-z]+\s+/$1./g;
warn " (got $organism_name)\n";

# getting organism details
warn "submitting genewiz job...\n";
my $job = $genewiz->{runGenewiz}->( { 
		      parameters => {
				     'parameters' => {
						      'genomesize' => length($seq ) , 
						      'stamp' => "Custom" , 
						      'main' => $organism_name , 
						      'sub' => sprintf('%s bp', $lengthText ) , 
						      'modus' => 'circle',
						      'annotations' => {
									'entry' => [ {
										      'featurename' => 'CDS' , 
										      'dir' => 'pos',
										      'legend' => 'CDS +',
										      'mark' => 'fillarrow mark',
										      'color' => { 'r' => '0.0','g' => '0.0' ,'b' => '1.0' } , 
										     } , {
											  'featurename' => 'CDS' , 
											  'dir' => 'neg',
											  'legend' => 'CDS -',
											  'mark' => 'fillarrow mark',
											  'color' => { 'r' => '1.0','g' => '0.0' ,'b' => '0.0' } , 
											 } , {  
											      'featurename' => 'rRNA' , 
											      'legend' => 'rRNA',
											      'mark' => 'fillarrow mark',
											      'color' => { 'r' => '0.0','g' => '1.0' ,'b' => '1.0' } , 
											     } , {
												  'featurename' => 'rRNA' , 
												  'dir' => 'pos',
												  'legend' => 'rRNA +',
												  'mark' => 'fillarrow mark',
												  'color' => { 'r' => '0.0','g' => '1.0' ,'b' => '1.0' } , 
												 } , {
												      'featurename' => 'rRNA' , 
												      'dir' => 'neg',
												      'legend' => 'rRNA -',
												      'mark' => 'fillarrow mark',
												      'color' => { 'r' => '0.0','g' => '1.0' ,'b' => '1.0' } , 
												     } , { 
													  'featurename' => 'tRNA' , 
													  'legend' => 'tRNA',
													  'mark' => 'fillarrow mark',
													  'color' => { 'r' => '0.0','g' => '1.0' ,'b' => '0.0' } , 
													 } ,  {
													       'featurename' => 'tRNA' , 
													       'dir' => 'pos',
													       'legend' => 'tRNA +',
													       'mark' => 'fillarrow mark',
													       'color' => { 'r' => '0.0','g' => '1.0' ,'b' => '0.0' } , 
													      } , {
														   'featurename' => 'tRNA' , 
														   'dir' => 'neg',
														   'legend' => 'tRNA -',
														   'mark' => 'fillarrow mark',
														   'color' => { 'r' => '0.0','g' => '1.0' ,'b' => '0.0' } , 
														  }] , 
								       } ,  
						      'data' => {
								 'entry' => {
									     'boxfilter' => int(length($seq) / 100 ) , 
									     'ref' => 'Reference G',
									     'legend' => 'Percent AT',
									    }
								},
						      'lanes' => {
								  'entry' => [ {
										'ref' => 'Annotation A', 
										'ann' => {
											  'entry' => [ {
													'featurename' => 'CDS',
													'dir' => 'pos' 
												       } , {
													    'featurename' => 'CDS', 
													    'dir' => 'neg'
													   } , {
														'featurename' => 'rRNA',
													       } , {
														    'featurename' => 'tRNA',
														   }
												     ] }
									       } , {
										    'ref' => 'Reference G' , 
										    'dat' => {
											      'color' => { 
													  'from' => { 'r' => 0, 'g' => 10,'b' => 10} , 
													  'via' => { 'r' => 10, 'g' => 10,'b' => 10},
													  'to' => { 'r' => 10, 'g' => 0,'b' => 0},
													 },
											      byrange => {top => 0.8 , bottom => 0.2}
											     } ,
										   } ] 
								 } ,
						      files => {
								entry => [ {
									    ref => 'Annotation A' ,  
									    'ann' => {
										      'features' => { 'feature' => [ @FEATURES ]  }
										     }
									   } , {
										'ref' => 'Reference G' , 
										'dat' => {
											  'values' => $DNApropertyFetchResultResponse->{parameters}->{output}->{values}
											 }
									       }
									 ]
							       }
						     }}}
);

my $jobid =  $job->{parameters}->{queueentry}->{jobid};
wait_job ($genewiz->{pollQueue},$jobid);
my $response = $genewiz->{fetchResult}->( job => { jobid => $jobid });
die unless length ( $response->{parameters}->{output}->{ps}->{content}) > 0 ;
exit 0;


sub WSDLclient {
	# by hhs 2008
	my ($wsdlurl, @ops)=@_;
	my %imports=();	
	my $importcnt;
	my %ops;
	my $wsdl = XML::LibXML->new->parse_file($wsdlurl);
	my $proxy = XML::Compile::WSDL11->new($wsdl);
		while (1) {
		foreach my $ns (keys %{$proxy->{schemas}->{namespaces} }) {
			foreach my $uri (keys %{$proxy->{schemas}->{namespaces}->{$ns}}) {
				foreach my $e (@{$proxy->{schemas}->{namespaces}->{$ns}->{$uri}}) {
					my $base = $wsdlurl;
					$base = $e->{filename} if defined $e->{filename};
					foreach my $ns2 (keys %{$e->{import}} ) {
						foreach my $fn ( @{$e->{import}->{$ns2}} ) {
							$uri = URI::WithBase->new($fn, $base);
							$imports{$uri->abs}=0 unless (defined $imports{$uri->abs});
						}
					}
				}
			}
		}
		$importcnt=0;
		foreach my $url (keys %imports) {
			next if $imports{$url} == 1; # added by pfh
			my $f = XML::LibXML->new->parse_file($url);
			$proxy->schemas->importDefinitions ($f);			
			$importcnt++;
			$imports{$url}=1;
		}
		last unless($importcnt);
	}

	my %inc;
	if ( $#ops >= 0) {
		foreach (@ops) {
			$inc{$_} = 1;
		}
	}
	foreach my $op ($proxy->operations) {
		next if $#ops >= 0 and ! defined $inc{$op->{operation}};
		$ops{$op->{operation}} = $proxy->compileClient($op->{operation});
	}

	return \%ops;	
}


sub wait_job {
	my ($op_handle,$jobid) = @_;
	my $sleep = 0;
	my $status = "UNKNOWN";
	my $response;
	while ( $status !~ /FINISHED|FAILED/ ) {
		$response = $op_handle->( job => { job  => { jobid => $jobid }   }) ;
		my $new_status = $response->{queueentry}->{queueentry}->{status};
		if ( $new_status ne $status and $new_status ne "") {
			print STDERR "# job $jobid $new_status ($response->{queueentry}->{queueentry}->{datetime})\n";
			$status = $new_status;
		}
		$sleep = 5 if $status eq "ACTIVE";
		sleep $sleep;
	}
	die "# ERROR: job $jobid FAILED\n" if $status ne "FINISHED";
}