#!/usr/local/bin/perl -w
# srs6soap.cgi

=head1 NAME

srs6soap.cgi - simple object access to sequence retrieval system

=head1 NOTES

	SRS6 - bioinformatics sequence retrieval system, vers. 6
	SRS6SOAP - calls SRS via system shell
	
	For testing in comparison with srs6ldap - LDAP interface to SRS6.
	Using LDAP search syntax.

	-- add 'getz(params)' method for SRS getz syntax calls
	-- mod. search() to handle ldap://url style for ldapsearch compat.
	-- add other search(params) choices ?
	
	
=cut

use lib('/Users/gilbertd/perl','/bio/perlib');

use SOAP::Transport::HTTP;

SOAP::Transport::HTTP::CGI
  -> dispatch_to('SRS6SOAP')
  -> options({compress_threshold => 10000})
  -> handle;


package SRS6SOAP;

use vars qw( $SRS6LDAP $SRS6GETZ $debug );

BEGIN {
$SRS6LDAP= "/c7/eugenes/ldap/srs6ldap2"; # executable ...
$SRS6GETZ= "/bio/mb/srs61/bin/solaris/getz"; # executable ...
$debug= 1;
}

my %xdecode=('amp'=>'&', 'lt'=>'<', 'gt'=>'>');
sub xdecode { (my $e = $_[0]) =~ s/&(amp|lt|gt);/$xdecode{$1}/eg; $e }

=head1 SRS6SOAP->getz( $query, $params)

Call SRS6 getz function with its parameters, e.g.
  getz('[libs={genbank refseq}-org:homo sapiens]&[libs-des:kinase]','-c');
  getz('[libs={genbank refseq}-org:homo sapiens]&[libs-des:kinase]','-e');
  
  urk! - need to clean-check params
  
=cut

sub getz {
  my ($class, $query, $params) = @_;
	
	$query = xdecode($query);
	$params= xdecode($params);
	my @par= split(/ /,$params);
	for (@par) { $_= '' unless (/^[\w\-]+$/); }
	$params= join(' ',@par);
		
  unless (-e $SRS6GETZ) { return ""; } # some soap error ?

  ## check params for cleanness, should all start w/ -, some have 
	warn "$SRS6GETZ  '$query' $params \n" if $debug;
  my $result= `$SRS6GETZ '$query' $params`;

	$result= "Query:\n$SRS6GETZ '$query' $params \nResult:\n"
				. $result if $debug;
	
  return $result;
}


=head1 SRS6SOAP->search( $basedn, $attributes, $scope, $filter, $extensions)

	Modelled after ldapsearch.
	returns XML'ized version of LDAP results.

parameters:
	basedn - null or syntax specifying library, and id if single record
	    e.g., 'lib=genbank', 'id=1,lib=locuslink'
	attributes - null or attribute list to return
	scope - one of 'base', 'one', 'sub', scope of search hierarchy
	filter - search filter, ldap style
	   '(&(objectClass=*)(|(lib=genbank)(lib=refseq))(des=kinase))'
	extensions - ldap-defined extensions, 
		'sizelimit=10,timelimit=1000,deref=1' 
		(only sizelimit parsed at present)
		
  urk! - need to clean-check params

=cut

sub search {
  my ($class, $basedn, $attributes, $scope, $filter, $extensions) = @_;
  
  my $exparam= '';
  my $ldapurl= $basedn || '';
  $ldapurl .= '?' . $attributes || '';
	$ldapurl .= '?' . $scope || '';
	$ldapurl .= '?' . $filter || '';
	$ldapurl .= '?' . $extensions || '';
	if ($extensions =~ /sizelimit=(\d+)/) {
		$exparam= "-m $1";
		}

	# -x == quick xml format
	warn "$SRS6LDAP -x $exparam -u '$ldapurl' \n" if $debug;
  unless (-e $SRS6LDAP) { return ""; } # some soap error ?
  my $result= `$SRS6LDAP -x $exparam -u '$ldapurl'`;

#?? add some
# <!DOCTYPE BioseqSet PUBLIC "-//IUBio Readseq DTD//EN" 
# "http://iubio.bio.indiana.edu/xml/dtd/Readseq.dtd">
  
  ## FIXME ---
	my $xml = <<"EOX";
<?xml version="1.0" encoding="UTF-8"?>
<BioseqSet>
<debugquery>
$SRS6LDAP -x -u '$ldapurl'
</debugquery>

$result
</BioseqSet>
EOX
  
  return $xml;
}


sub new {
  my $self = shift;
  my $class = ref($self) || $self;
  bless {} => $class;
}