[MOBY-guts] biomoby commit

[Mark Wilkinson]

mwilkinson
Fri Aug 15 19:41:56 EDT 2003
Update of /home/repository/moby/moby-live/Perl/scripts/Services
In directory pub.open-bio.org:/tmp/cvs-serv3366/Services

Modified Files:
	LocalServices.pm 
Log Message:
get GO gene product associations service

moby-live/Perl/scripts/Services LocalServices.pm,1.27,1.28
===================================================================
RCS file: /home/repository/moby/moby-live/Perl/scripts/Services/LocalServices.pm,v
retrieving revision 1.27
retrieving revision 1.28
diff -u -r1.27 -r1.28
--- /home/repository/moby/moby-live/Perl/scripts/Services/LocalServices.pm	2003/08/14 20:47:02	1.27
+++ /home/repository/moby/moby-live/Perl/scripts/Services/LocalServices.pm	2003/08/15 23:41:56	1.28
@@ -59,7 +59,10 @@
     die "can't connecvt to database\n" unless $dbh;
     my $sth = $dbh->prepare(q{select name, term_definition from term, term_definition where term.id = term_definition.term_id and acc=?});
     
-    foreach (@accessions){
+    foreach my $acc(@accessions){
+		unless ($acc =~/^GO:/){
+			$acc = "GO:$acc";  # we still haven't decided on whether id's should include the prefix...
+		}
         $sth->execute($_);        
         my ($term, $def) = $sth->fetchrow_array;
         if ($term){
@@ -80,6 +83,85 @@
 }
 
 
+sub getGoTermAssociations {
+
+    my $SOM = pop;  
+    my ($self, $data) = @_;
+    my $response = "";
+	my @accessions;
+	# first, get the valid URI for the namespace that we accept
+	my $OS = MOBY::Client::OntologyServer->new;
+	my ($s, $m, $VALID_NAMESPACE) = $OS->namespaceExists(term => 'GO');
+	unless ($VALID_NAMESPACE){  # unless we could get the known namespace LSID's we should bail because somethign is very very wrong!
+		print STDERR "the namespace GO does not exist in the MOBY namespace ontology\n";
+		return SOAP::Data->type('base64' => responseHeader() . responseFooter());  # base 64 encode it (optional)
+	}
+
+	# now start analyzing the input data
+	my @input_nodes = getInputArticles($data);
+	foreach (@input_nodes){
+		my ($input) = @{$_}; # this service only allows one input per query, so take the first
+		my $ns = getSimpleArticleNamespaceURI($input);
+		push @accessions, undef unless $ns eq $VALID_NAMESPACE; # if we have been sent an invalid namespace, then stack an undef as a response
+		my ($id) = getSimpleArticleIDs($ns, [$input]);
+		if (defined $id){
+			push @accessions, $id;
+		} else {
+			push @accessions, undef;
+		}
+    }
+
+    use DBI;
+    use DBD::mysql;
+    my $dbh = _dbAccess('go');
+    die "can't connecvt to database\n" unless $dbh;
+    my $sth = $dbh->prepare("
+		select
+			gp.symbol,
+			species_id,
+			xr.xref_dbname,
+			t.term_type,
+			t.name,
+			term_definition 
+		from
+			gene_product as gp,
+			term as t,
+			term_definition,
+			association as a,
+			dbxref as xr
+		where
+			t.id = a.term_id
+		and a.gene_product_id = gp.id
+		and xr.id = gp.dbxref_id
+		and t.acc=?
+		and a.is_not = 0
+		and term.id = term_definition.term_id 
+		order by species_id");
+							
+    foreach my $acc(@accessions){
+		unless ($acc =~/^GO:/){
+			$acc = "GO:$acc";  # we still haven't decided on whether id's should include the prefix...
+		}
+		my @simples;
+        $sth->execute($_);
+        while (my ($symb, $sp, $namsp, $type, $name, $def) = $sth->fetchrow_array){
+            my $response_data .= "<Object namespace='$namsp' id='$symb'>\n";
+			$response_data .= "	<CrossReference>\n";
+			$response_data .= "		<Invocation namespace='GO' id='$acc'/>\n";
+			$response_data .= "		<Object namespace='taxon' id='$sp'/>\n";
+            $response_data .= "	</CrossReference>\n";
+            $response_data .= "</Object>\n";
+			push @simples, simpleResponse($response_data);
+        }
+		$response .= collectionResponse(\@simples); # after all images have been collected, create the collection
+    }
+    $response =  responseHeader() . $response . responseFooter();
+    my $SOAPResponse = SOAP::Data->type('base64' => $response);
+    return $SOAPResponse
+    
+}
+
+
 sub RetrieveGOFromKeywords {
 	my $SOM = pop; 	
 	my ($self, $query) = @_;