[MOBY-guts] biomoby commit
Mark Wilkinson
mwilkinson at pub.open-bio.org
Mon Jun 23 20:29:58 UTC 2003
mwilkinson
Mon Jun 23 16:29:58 EDT 2003
Update of /home/repository/moby/moby-live/Perl/MOBY
In directory pub.open-bio.org:/tmp/cvs-serv4990/MOBY
Modified Files:
OntologyServer.pm
Log Message:
new method traverseDAG in the OntologyServer will return a hash of {relationship_type} = [lsid1, lsid2, lsid3] to describe the full parentage of an object or service. It traverses only one relationship type at a time; i.e. it will not look for the ISA relationships of something that it finds in a HASA relationship with the object in-hand. It keeps no hierarchical structure, all you get is a flattened list of everything it found as it traversed back to root.
moby-live/Perl/MOBY OntologyServer.pm,1.20,1.21
===================================================================
RCS file: /home/repository/moby/moby-live/Perl/MOBY/OntologyServer.pm,v
retrieving revision 1.20
retrieving revision 1.21
diff -u -r1.20 -r1.21
--- /home/repository/moby/moby-live/Perl/MOBY/OntologyServer.pm 2003/06/23 17:49:35 1.20
+++ /home/repository/moby/moby-live/Perl/MOBY/OntologyServer.pm 2003/06/23 20:29:58 1.21
@@ -391,66 +391,6 @@
return (0, "Service relationship creation failed for unknown reasons",'');
}
}
-#
-#sub addObjectISA{
-## adds an ISA relationship
-## fail if another object ISA/HASA this objevt
-# #node => $term,
-# #ISA => $isa_node,
-# #authority => $auth,
-# #contact_email => $email);
-# my ($self, %args) = @_;
-# my ($id) = $self->dbh->selectrow_array(q{select object_id from object where object_type = ?},undef,$args{node});
-# # object1_id ISA object2_id?
-# my (@isa) = $self->dbh->selectrow_array(q{select * from object_term2term where object2_id = ?},undef, $id);
-# if (scalar @isa){
-# return (0, q{Object type $term has object dependencies in the ontology. It can not be changed},$self->setURI($id));
-# }
-# my ($relid) = $self->dbh->selectrow_array(q{select object_id from object where object_type = ?},undef,$args{ISA}); # get ID of the related object
-# $relid || return (0, q{Object $args{ISA} does not exist in the ontology},'');
-#
-# $self->dbh->do(
-# q{insert into object_term2term (relationship_type, object1_id, object2_id) values (?,?,?)},
-# undef,
-# ("URN:LSID:biomoby.org:ObjectRelation:ISA",$id,$relid));
-# if ($self->dbh->{mysql_insertid}){
-# return (1,"Object relationsihp created successfully",'');
-# } else {
-# return (0, "Object relationship creation failed for unknown reasons",'');
-# }
-#}
-#
-#sub addObjectHASA {
-## adds a HASA relationship
-## fail if another object ISA/HASA this objevt
-# #node => $term,
-# #HASA => $isa_node,
-# #authority => $auth,
-# #contact_email => $email
-# #articleName => $name
-# my ($self, %args) = @_;
-# my ($id) = $self->dbh->selectrow_array(q{select object_id from object where object_type = ?},undef,$args{node});
-# # object1_id ISA object2_id?
-# my (@isa) = $self->dbh->selectrow_array(q{select * from object_term2term where object2_id = ?},undef, $id);
-# if (scalar @isa){
-# return (0, q{Object type $term has object dependencies in the ontology. It can not be changed},$self->setURI($id));
-# }
-# my ($relid) = $self->dbh->selectrow_array(q{select object_id from object where object_type = ?},undef,$args{HASA}); # get ID of the related object
-# $relid || return (0, "Object $args{HASA} does not exist in the ontology",'');
-#
-# $self->dbh->do(q{insert into object_term2term (relationship_type, object1_id, object2_id, object2_articlename) values (?,?,?,?)},undef,("URN:LSID:biomoby.org:ObjectRelation:HASA",$id,$relid,$args{'articleName'}));
-# if ($self->dbh->{mysql_insertid}){
-# return (1,"Object relationsihp created successfully",'');
-# } else {
-# return (0, "Object relationship creation failed for unknown reasons",'');
-# }
-#}
-#
-#sub removeObjectISA{
-## removes an ISA relationship
-## will fail if another object ISA of this object or HASA this object
-## just ignore it if it doesn't exist in the first place
-#}
=head2 serviceExists
@@ -541,32 +481,6 @@
}
-#sub addServiceISA{ # this is not completely transformed yet, then I commenteed it out
-## adds an ISA relationship
-## fail if another object ISA/HASA this objevt
-# #node => $term,
-# #ISA => $isa_node,
-# #authority => $auth,
-# #contact_email => $email);
-# my ($self, %args) = @_;
-# return (0, "WRONG ONTOLOGY!",'') unless ($self->ontology eq 'service');
-# my ($id, $lsid) = $self->dbh->selectrow_array(q{select service_id, service_lsid from service where service_type = ?},undef,$args{node});
-# # object1_id ISA object2_id?
-# my (@isa) = $self->dbh->selectrow_array(q{select * from service_term2term where service2_id = ?},undef, $id);
-# if (scalar @isa){
-# return (0, q{Service type $term has object dependencies in the ontology. It can not be changed},$lsid);
-# }
-# my ($relid) = $self->dbh->selectrow_array(q{select service_id from service where service_type = ?},undef,$args{ISA}); # get ID of the related service
-# $relid || return (0, q{Service $args{ISA} does not exist in the ontology},'');
-#
-# $self->dbh->do(q{insert into service_term2term (relationship_type, service1_id, service2_id) values (?,?,?)},undef,("URN:LSID:biomoby.org:ServiceRelation:ISA",$id,$relid));
-# if ($self->dbh->{mysql_insertid}){
-# return (1,"Service relationship created successfully",'');
-# } else {
-# return (0, "Service relationship creation failed for unknown reasons",'');
-# }
-#}
-
=head2 namespaceExists
=cut
@@ -802,10 +716,12 @@
sub getRelationshipTypes {
my ($self, %args) = @_;
my $ontology = $args{'ontology'};
- my $defs = $self->dbh->selectall_arrayref(q{select relationship_type, authority, description from relationship where ontology = ?}, undef, $ontology);
+ my $OS = MOBY::OntologyServer->new(ontology => "relationship");
+
+ my $defs = $OS->dbh->selectall_arrayref(q{select relationship_lsid, relationship_type, authority, description from relationship where ontology = ?}, undef, $ontology);
my %result;
foreach (@{$defs}){
- $result{$_->[0]} = [$_->[1], $_->[2]];
+ $result{$_->[0]} = [$_->[1], $_->[2], $_->[3]];
}
return \%result;
}
@@ -885,52 +801,49 @@
=head2 traverseDAG
=cut
-#
-#sub traverseDAG {
-# my ($self, $term) = @_;
-# my $ontology = $self->ontology;
-# return {} unless $ontology;
-# return {} unless $term;
-# if ($ontology eq 'service'){
-# $term = $self->getServiceURI($term);
-# } elsif ($ontology eq 'object'){
-# $term = $self->getObjectURI($term);
-# }
-# return {} unless $term =~ /^urn\:lsid/; # now its a URI
-#
-# my $relhash = $self->getRelationshipTypes(ontology => $ontology);
-# return {} unless $relhash;
-# my @rels = keys %{$relhash};
-# my %IDS;
-# foreach my $relationship (@rels){
-# my $reluri = $self->getRelationshipURI($ontology, $relationship);
-# $IDS{$term} = "untested";
-# while (grep /untested/, (values %IDS)){ # now, while there are untested services in our list...
-# foreach my $service(keys %IDS){ # start parsing through the list
-# next if ($IDS{$service} eq "tested"); # if it has been tested already then move on
-# my $lsids = $self->Relationships(term => $term, relationship => $relationship);
-# $IDS{$service} = "tested";
-# #${$lsids}{relationshiptype}=[lsid, lsid, lsid];
-#
-# }
-# }
-# }
-#}
-#
-#
-# $ServiceIDs{$root_id} = "untested"; # mark the one in-hand as untested
-# while (grep /untested/, (values %ServiceIDs)){ # now, while there are untested services in our list...
-# foreach my $service(keys %ServiceIDs){ # start parsing through the list
-# next if ($ServiceIDs{$service} eq "tested"); # if it has been tested already then move on
-# my $sth = $dbh->prepare($sth{get_service_hierarchy_list});
-# $sth->execute($service); # execute the query for child nodes
-# $ServiceIDs{$service} = "tested"; # mark it as tested
-# while (my $new = $sth->fetchrow_array){ # now get each of the child nodes
-# next if (defined $ServiceIDs{$new}); # if we have already heard about it then move on
-# $ServiceIDs{$new} = "untested"; #otherwise mark it as untested, and start all over again
-# }
-# }
-# }
+
+sub traverseDAG {
+ my ($self, $term) = @_;
+ my $ontology = $self->ontology;
+ return {} unless $ontology;
+ return {} unless $term;
+ if ($ontology eq 'service'){
+ $term = $self->getServiceURI($term);
+ } elsif ($ontology eq 'object'){
+ $term = $self->getObjectURI($term);
+ }
+ return {} unless $term =~ /^urn\:lsid/; # now its a URI
+
+ my $relhash = $self->getRelationshipTypes(ontology => $ontology);
+ return {} unless $relhash;
+ my @rels = keys %{$relhash};
+ my %relationships;
+ foreach my $relationship (@rels){
+ my %IDS;
+ my $OS = MOBY::OntologyServer->new(ontology => 'relationship');
+ my $reluri = $OS->getRelationshipURI($ontology, $relationship);
+ $IDS{$term} = "untestedroot"; # mark the one in-hand as being untested
+ while (grep /untested/, (values %IDS)){ # now, while there are untested services in our list...
+ foreach my $service(keys %IDS){ # start parsing through the current list (hash keys)
+ next if ($IDS{$service} eq "tested"); # if it has been tested already then move on
+ my $lsids = $self->Relationships(term => $term, relationship => $relationship); # get the related terms for this type; this should return a single hash value
+ if ($IDS{$term} =~ /root/){
+ delete $IDS{$term}
+ } else {
+ $IDS{$service} = "tested"; # mark the current one as now being "done"
+ }
+ #${$lsids}{relationshiptype}=[lsid, lsid, lsid];
+ foreach my $lsid(@{$lsids->{$relationship}}){ # go through the related terms
+ next if (defined $IDS{$lsid}); # if we have already seen that term, skip it
+ $IDS{$lsid} = "untested" # otherwise add it to the list and loop again.
+ }
+ }
+ }
+ my @IDS = keys %IDS;
+ $relationships{$relationship} = \@IDS; # and associate them all with the current relationship type
+ }
+ return \%relationships;
+}
sub DESTROY {}
More information about the MOBY-guts
mailing list