[MOBY-guts] biomoby commit

[Mark Wilkinson]

mwilkinson
Tue Aug 23 19:16:05 EDT 2005
Update of /home/repository/moby/moby-live/Perl/MOBY
In directory pub.open-bio.org:/tmp/cvs-serv23717/MOBY

Modified Files:
	Central.pm 
Log Message:
should now accurately check the entire inheritence tree to ensure that we cannot register any objects that inherit directly or even indirectly from a primitive.  Thus our deprecated objects cannot be extended anymore

moby-live/Perl/MOBY Central.pm,1.204,1.205
===================================================================
RCS file: /home/repository/moby/moby-live/Perl/MOBY/Central.pm,v
retrieving revision 1.204
retrieving revision 1.205
diff -u -r1.204 -r1.205
--- /home/repository/moby/moby-live/Perl/MOBY/Central.pm	2005/08/23 19:38:07	1.204
+++ /home/repository/moby/moby-live/Perl/MOBY/Central.pm	2005/08/23 23:16:05	1.205
@@ -352,7 +352,6 @@
 		}
 	}
 
-
 	# should be good to go now...
 
 
@@ -454,11 +453,40 @@
 }
 
 sub _testObjectTypeAgainstPrimitives{
+	# THIS SUBROUTINE NEEDS TO BE REMOVED AND PLACED INTO THE ONTOLOGY SERVER
+	# one day when MOBY Central and the ontologies are separated properly
 	my ($type) = @_;
+	my $OS = MOBY::OntologyServer->new(ontology => 'object');
+	# get the inputlsid
+	my ($success, $desc, $inputlsid) = $OS->objectExists(term => $type);
+
 	my $CONF = MOBY::Config->new;
 	my @primitives = @{$CONF->primitive_datatypes}; # get the list of known primitive datatypes
 	my $x = 0; # set flag down
-	map {($x=1) if ($type eq $_)} @primitives; # test primitives against this one
+	# convert everything to an LSID first
+	
+	my @primitive_lsids = map{my ($s, $d, $l) = $OS->objectExists(term => $_); return $l} @primitives;
+	
+	map {($x=1) if ($inputlsid eq $_)} @primitive_lsids; # test primitives against this one
+
+	my $OSrel = MOBY::OntologyServer->new(ontology => 'relationship');
+	my ($exists1, $desc2, $isalsid) = $OSrel->relationshipExists(term => 'isa', ontology => 'object');
+	
+	my $relationships = $OS->Relationships(
+		ontology => 'object',
+		term => $type,
+		relationship => $isalsid,
+		direction => 'root',
+		expand =>  1);
+	#relationships{relationship} = [[lsid1,articleNmae], [lsid2, articleName], [lsid3, articleName]]	
+	my ($isa) = keys(%$relationships);  # can only be one key returned, and must be isa in this case
+	my @ISAlist;
+	(@ISAlist = @{$relationships->{$isa}}) if ($relationships->{$isa}) ;
+	# for each of the inherited parents, check their articleNames
+	foreach my $ISA(@ISAlist){  # $ISA = [lsid, articleName] (but articleName shuld be null anyway in this case)
+		my $what_it_is = shift @$ISA;
+		map {($x=1) if ($what_it_is eq $_)} @primitive_lsids; # test primitives against this one
+	}
 	return $x; # return flag state
 }