[MOBY-guts] biomoby commit

Mark Wilkinson mwilkinson at pub.open-bio.org
Tue Apr 20 18:58:05 UTC 2004


mwilkinson
Tue Apr 20 14:58:05 EDT 2004
Update of /home/repository/moby/moby-live/Perl/MOBY
In directory pub.open-bio.org:/tmp/cvs-serv14359

Modified Files:
	OntologyServer.pm 
Log Message:
moving toward LSID compabitibility for the ontology server.

moby-live/Perl/MOBY OntologyServer.pm,1.34,1.35
===================================================================
RCS file: /home/repository/moby/moby-live/Perl/MOBY/OntologyServer.pm,v
retrieving revision 1.34
retrieving revision 1.35
diff -u -r1.34 -r1.35
--- /home/repository/moby/moby-live/Perl/MOBY/OntologyServer.pm	2004/04/20 18:49:45	1.34
+++ /home/repository/moby/moby-live/Perl/MOBY/OntologyServer.pm	2004/04/20 18:58:05	1.35
@@ -230,13 +230,26 @@
     return (0, "requires a contact email address",'') unless ($args{contact_email});
     return (0, "requires a object description",'') unless ($args{description});
     my $term = $args{node};
-    if ($term =~ /^urn:lsid/ && !($term =~ /^urn:lsid:biomoby.org:objectclass/)){  # if it is an LSID, but not a MOBY LSID, than barf
-        return (0, "can't create a term in a non-MOBY ontology!", $term);
-    }
+
+#    if ($term =~ /^urn:lsid/ && !($term =~ /^urn:lsid:biomoby.org:objectclass/)){  # if it is an LSID, but not a MOBY LSID, than barf
+#        return (0, "can't create a term in a non-MOBY ontology!", $term);
+#    }
 
     my $LSID = ($args{'node'} =~ /urn\:lsid/)?$args{'node'}:$self->setURI($args{'node'});
     unless ($LSID){return (0, "Failed during creation of an LSID",'')}
 
+    if ($args{'node'} =~ /^urn\:lsid/){
+        $sth = $self->dbh->prepare("select object_lsid, object_type, description, authority, contact_email from object where object_lsid = ?");
+    } else {
+        $sth = $self->dbh->prepare("select object_lsid, object_type, description, authority, contact_email from object where object_type = ?");
+    }
+    $sth->execute($term);
+    my ($lsid, $type, $desc, $auth, $email) = $sth->fetchrow_array;
+    if ($lsid){  # if it is in there, then the object exists
+        return (0,"This term already exists: $lsid",$lsid);
+	}
+
+
     $args{description} =~ s/^\s+(.*?)\s+$/$1/s;
     $args{node} =~ s/^\s+(.*?)\s+$/$1/s;
     $args{contact_email} =~ s/^\s+(.*?)\s+$/$1/s;
@@ -368,20 +381,32 @@
 # adds a  relationship
 #subject_node => $term,
 #relationship => $reltype,
-#predicate_node => $objectType,
+#object_node => $objectType,
 #articleName => $articleName,
 #authority => $auth,
 #contact_email => $email
     my ($self, %args) = @_;
+
     return (0, "WRONG ONTOLOGY!",'') unless ($self->ontology eq 'object');
-    my ($subj_id, $subj_lsid) = $self->dbh->selectrow_array(q{select object_id, object_lsid from object where object_type = ?},undef,$args{subject_node});
+
+	if ($args{subject_node} =~ /^urn:lsid/){
+	    my ($subj_id, $subj_lsid) = $self->dbh->selectrow_array(q{select object_id, object_lsid from object where object_lsid = ?},undef,$args{subject_node});
+	} else {
+	    my ($subj_id, $subj_lsid) = $self->dbh->selectrow_array(q{select object_id, object_lsid from object where object_type = ?},undef,$args{subject_node});
+	}
     return (0, qq{Object type $args{subject_node} does not exist in the ontology},'') unless defined $subj_id;
 
+	if ($args{object_node} =~ /^urn:lsid/){
+	    my ($subj_id, $subj_lsid) = $self->dbh->selectrow_array(q{select object_id, object_lsid from object where object_lsid = ?},undef,$args{object_node});
+	} else {
+	    my ($subj_id, $subj_lsid) = $self->dbh->selectrow_array(q{select object_id, object_lsid from object where object_type = ?},undef,$args{object_node});
+	}
+    return (0, qq{Object type $args{object_node} does not exist in the ontology},'') unless defined $subj_id;
+
+
     my (@isa) = $self->dbh->selectrow_array(q{select * from object_term2term where object2_id = ?},undef, $subj_id);
     if (scalar @isa){return (0, qq{Object type $args{subject_node} has existing object dependencies in the ontology.  It cannot be changed.},$subj_lsid);}
-    
-    my ($obj_id, $obj_lsid) = $self->dbh->selectrow_array(q{select object_id, object_lsid from object where object_type = ?},undef,$args{object_node}); # get ID of the related object
-    defined $obj_lsid || return (0, qq{Object $args{object_node} does not exist in the ontology},'');
+
     
     my $OE = MOBY::OntologyServer->new(ontology => 'relationship');
     my ($success, $desc, $rel_lsid) = $OE->relationshipExists(term => $args{relationship}, ontology => 'object');




More information about the MOBY-guts mailing list