[MOBY-guts] biomoby commit

[Mark Wilkinson]

mwilkinson
Tue Aug  2 11:18:00 EDT 2005
Update of /home/repository/moby/moby-live/Perl/MOBY
In directory pub.open-bio.org:/tmp/cvs-serv310/MOBY

Modified Files:
	Central.pm Config.pm OntologyServer.pm 
Log Message:
new API prevents inheritence from Primitives.  This is now enforced by the registry.  Added tests to ensure that this works.

moby-live/Perl/MOBY Central.pm,1.197,1.198 Config.pm,1.7,1.8 OntologyServer.pm,1.71,1.72
===================================================================
RCS file: /home/repository/moby/moby-live/Perl/MOBY/Central.pm,v
retrieving revision 1.197
retrieving revision 1.198
diff -u -r1.197 -r1.198
--- /home/repository/moby/moby-live/Perl/MOBY/Central.pm	2005/07/29 18:58:44	1.197
+++ /home/repository/moby/moby-live/Perl/MOBY/Central.pm	2005/08/02 15:18:00	1.198
@@ -267,16 +267,8 @@
 	my ( $success, $message );
 	my $OntologyServer    = &_getOntologyServer( ontology => 'object' );
 	my $RelOntologyServer = &_getOntologyServer( ontology => 'relationship' );
-	$debug
-	  && &_LOG(
-"\n\npayload\n**********************\n$payload\n***********************\n\n"
-	  );
 	my ( $term, $desc, $relationships, $email, $auth, $clobber ) =
 	  &_registerObjectPayload($payload);
-	$debug
-	  && &_LOG(
-"\n\nterm $term\ndesc $desc\nemail $email\nauth $auth\nclobber $clobber\n\n"
-	  );
 
 	unless ( defined $term && defined $desc && defined $auth && defined $email )
 	{
@@ -349,6 +341,24 @@
 			($success == 0) && return &_error( $message, $URI );
 		}
 	}
+
+	# now test if the object inherits from primitives... if so, abort
+	if ( keys %{$relationships} ) {
+		while ( my ( $reltype, $obj ) = each %{$relationships} ) {
+			next unless ($reltype =~ /isa/i); # we are only testing isa relationships here.
+			foreach ( @{$obj} ) {
+				my ( $objectType, $articleName ) = @{$_};
+				if (&_testObjectTypeAgainstPrimitives($objectType)){
+					return &_error( "Inheritance from Primitive data-types is now deprecated.  You shold construct your object using a HASA relationship.  for example, text-plain HASA string (as opposed to ISA string)", "" );
+				}
+			}
+		}
+	}
+
+
+	# should be good to go now...
+
+
 	( $success, $message, $URI ) = $OntologyServer->createObject(
 		node          => $term,
 		description   => $desc,
@@ -384,7 +394,7 @@
 		and may indicate corruption of the MOBY Central registry.", $deleteURI
 		);
 		return &_error(
-"object failed to register due to failure during registration of ISA/HASA relationships"
+"object failed to register due to unexplained failure during registration of ISA/HASA relationships"
 			  . ( join ",", (@failures) ) . "\n",
 			""
 		);
@@ -442,6 +452,17 @@
 	return ( $term, $desc, \%relationships, $email, $authURI, $clobber );
 }
 
+sub _testObjectTypeAgainstPrimitives{
+	my ($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
+	return $x; # return flag state
+}
+
+
+
 =head2 deregisterObjectClass
 
 =over 3
@@ -2867,7 +2888,7 @@
 	  &_nodeTextContent( $doc, "serviceType" );    # if we didn't get anything using objectType try serviceType
 	return undef unless $term;    # and bail out if we didn't succeed
 	$ontology ||= "service"; # if we have now succeeded and haven't already taken the ontology then it must be the service ontology
-	&_LOG("Ontology was $ontology; Term was $term\n");
+	$debug && &_LOG("Ontology was $ontology; Term was $term\n");
 	my $OS = MOBY::OntologyServer->new( ontology => $ontology );
 	my %rels = %{ $OS->Relationships( term => $term, expand => $expand_relationship )};    # %rels = $rels{relationship} = [lsid, lsid,lsid]
 	my $response = "<Relationships>\n";
@@ -3471,12 +3492,12 @@
 
 sub _LOG {
 
-	#return unless $debug;
+	return unless $debug;
 	#print join "\n", @_;
 	#print  "\n---\n";
 	#return;
 	open LOG, ">>/tmp/CentralRegistryLogOut.txt"
-	  or die "can't open logfile $!\n";
+	  or die "can't open mobycentral error logfile $!\n";
 	print LOG join "\n", @_;
 	print LOG "\n---\n";
 	close LOG;

===================================================================
RCS file: /home/repository/moby/moby-live/Perl/MOBY/Config.pm,v
retrieving revision 1.7
retrieving revision 1.8
diff -u -r1.7 -r1.8
--- /home/repository/moby/moby-live/Perl/MOBY/Config.pm	2005/07/06 16:46:41	1.7
+++ /home/repository/moby/moby-live/Perl/MOBY/Config.pm	2005/08/02 15:18:00	1.8
@@ -23,6 +23,7 @@
 		mobyservice      => [ undef, 'read/write' ],
 		mobyrelationship => [ undef, 'read/write' ],
 		valid_secondary_datatypes => [["String", "Integer", "DateTime", "Float"],  'read'],
+		primitive_datatypes => [["String", "Integer", "DateTime", "Float", "Boolean"], 'read'],
 
 	  );
 

===================================================================
RCS file: /home/repository/moby/moby-live/Perl/MOBY/OntologyServer.pm,v
retrieving revision 1.71
retrieving revision 1.72
diff -u -r1.71 -r1.72
--- /home/repository/moby/moby-live/Perl/MOBY/OntologyServer.pm	2005/07/29 17:39:32	1.71
+++ /home/repository/moby/moby-live/Perl/MOBY/OntologyServer.pm	2005/08/02 15:18:00	1.72
@@ -1062,6 +1062,7 @@
 	{
 		my $defs = $self->_doRelationshipsQuery(       $ontology,     $term,
 												 $relationship, $direction );
+		return {[]} unless $defs; # somethig has gone terribly wrong!
 		my $lsid;
 		my $rel;
 		foreach ( @{$defs} ) {