#!/usr/bin/perl
# Description: Standalone test script - all prerequisites embedded
# Author: Peter Fischer Hallin
# Email: pfh@cbs.dtu.dk
# Version: Genome Atlas 3.0 ws2
# Date: 2009-05-05

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


# create proxy to genome atlas
my $proxy = WSDLclient ( 'http://www.cbs.dtu.dk/ws/GenomeAtlas/GenomeAtlas_3_0_ws2.wsdl');

####################  queryGenomes ####################

# obtain the accession of the shortest genbank accession of a prokaryotic chromosome, having genes annotated
print STDERR "fetching a small chromosome using queryGenomes...\n";
my $queryGenomesResponse = $proxy->{queryGenomes}->(  parameters => { parameters => { segment => 'Chromosome' , segment => 'Chromosome' , hideMerged => 'yes' }});
die "unexpected response\n" unless $queryGenomesResponse;

my $genbank = "";
my $shortest;
my $kingdom;
my $organism;
my $length;
foreach my $segment (@{$queryGenomesResponse->{parameters}->{output}->{entries}->{entry}}) {
	if ( (! $shortest or $shortest > $segment->{properties}->{LENGTH} ) and $segment->{properties}->{NGENES} > 500 ) {
		$genbank = $segment->{genbank};
		$shortest = $segment->{properties}->{LENGTH};
		$kingdom = lc ( substr( $segment->{kingdom},0,3));
		$organism = $segment->{organism};
	}
}

die "unable to obtain genbank accession no.\n" unless defined $genbank;

print STDERR "selected genbank accesion $organism (genbank accession $genbank, length $shortest bp)\n";

####################  getSeq ####################
print STDERR "testing getSeq...\n";
my $getSeqResponse = $proxy->{getSeq}->(  parameters => { parameters => { genbank => $genbank }});
die "unexpected response\n" unless $getSeqResponse;
printf STDERR "got %d entry/entries\n" , scalar ( @{$getSeqResponse->{parameters}->{output}->{sequencedata}->{sequence}});

####################  getProt ####################
print STDERR "testing getProt...\n";
my $getProtResponse = $proxy->{getProt}->( parameters => { parameters => { genbank => $genbank }});
die "unexpected response\n" unless $getProtResponse;
printf STDERR "got %d entry/entries\n" , scalar ( @{$getProtResponse->{parameters}->{output}->{sequencedata}->{sequence}});

####################  getOrfs ####################
print STDERR "testing getOrfs...\n";
my $getOrfsResponse = $proxy->{getOrfs}->( parameters => { parameters => { genbank => $genbank }});
die "unexpected response\n" unless $getOrfsResponse;
printf STDERR "got %d entry/entries\n" , scalar ( @{$getOrfsResponse->{parameters}->{output}->{sequencedata}->{sequence}});

####################  getFeatures ####################
print STDERR "testing getFeatures...\n";
my $getFeaturesResponse = $proxy->{getFeatures}->( parameters => { parameters => { accession => $genbank , features => 'CDS' ,keys => 'translation' }});
die "unexpected response\n" unless $getFeaturesResponse;
printf STDERR "got %d entry/entries\n" , scalar ( @{$getFeaturesResponse->{parameters}->{output}->{features}->{feature}});

####################  DNApropertyRun ####################
print STDERR "testing DNApropertyRun...\n";
my $DNApropertyRunResponse = $proxy->{DNApropertyRun}->( parameters => { parameters => { method => 'Percent AT' ,  sequence => { 'id' => $getSeqResponse->{parameters}->{output}->{sequencedata}->{sequence}[0]->{id},'seq' => $getSeqResponse->{parameters}->{output}->{sequencedata}->{sequence}[0]->{seq}}}});
die "unexpected response\n" unless $DNApropertyRunResponse;
my $jobid =  $DNApropertyRunResponse->{queueentry}->{queueentry}->{jobid};
printf STDERR "got job id %s\n" , $jobid;
wait_job ($proxy->{pollQueue},$jobid);
my $DNApropertyFetchResultResponse = $proxy->{DNApropertyFetchResult}->( job => {  jobid => $jobid });
die unless $DNApropertyFetchResultResponse;
printf STDERR "got %d entry/entries\n" , scalar ( ( split ( "," , $DNApropertyFetchResultResponse->{parameters}->{output}->{values})));

####################  trnascanRun ####################
print STDERR "testing trnascanRun...\n";
my $trnascanRunResponse = $proxy->{trnascanRun}->( parameters => { parameters => { kingdom => $kingdom ,  sequence => { 'id' => $getSeqResponse->{parameters}->{output}->{sequencedata}->{sequence}[0]->{id},'seq' => $getSeqResponse->{parameters}->{output}->{sequencedata}->{sequence}[0]->{seq}}}});
die "unexpected response\n" unless $trnascanRunResponse;
my $jobid =  $trnascanRunResponse->{queueentry}->{queueentry}->{jobid};
printf STDERR "got job id %s\n" , $jobid;
wait_job ($proxy->{pollQueue},$jobid);
my $trnascanRunResponse = $proxy->{trnascanFetchResult}->( job => {  jobid => $jobid });
die unless $trnascanRunResponse;
printf STDERR "got %d entry/entries\n" , scalar ( @{$trnascanRunResponse->{parameters}->{anndata}->{ann}[0]->{annrecords}->{annrecord}});

####################  aaUsage ####################
print STDERR "testing aaUsage...\n";
my $aaUsageResponse = $proxy->{aaUsage}->( parameters => { parameters => { sequencedata => $getProtResponse->{parameters}->{output}->{sequencedata} }});
die "unexpected response\n" unless $aaUsageResponse->{parameters}->{output}->{sequence}[0]->{aaUsage};
printf STDERR "got %d entry/entries\n" , scalar ( @{$aaUsageResponse->{parameters}->{output}->{sequence}[0]->{aaUsage}->{entry}});

####################  codonUsage ####################
print STDERR "testing codonUsage...\n";
my $codonUsageResponse = $proxy->{codonUsage}->( parameters => { parameters => { sequencedata => $getSeqResponse->{parameters}->{output}->{sequencedata} }});
die "unexpected response\n" unless $codonUsageResponse->{parameters}->{output}->{sequence}[0]->{codonUsage};
printf STDERR "got %d entry/entries\n" , scalar ( @{$codonUsageResponse->{parameters}->{output}->{sequence}[0]->{codonUsage}->{entry}});

exit 0;

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";
}

# with time, this is to replace the above functions!

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;	
}