[MOBY-guts] biomoby commit
Mark Wilkinson
mwilkinson at pub.open-bio.org
Thu Jul 10 19:41:38 UTC 2003
mwilkinson
Thu Jul 10 15:41:38 EDT 2003
Update of /home/repository/moby/moby-live/Perl/MOBY
In directory pub.open-bio.org:/tmp/cvs-serv5905/Perl/MOBY
Modified Files:
OntologyServer.pm
Log Message:
OntologyServer was not being LSID-friendly
moby-live/Perl/MOBY OntologyServer.pm,1.24,1.25
===================================================================
RCS file: /home/repository/moby/moby-live/Perl/MOBY/OntologyServer.pm,v
retrieving revision 1.24
retrieving revision 1.25
diff -u -r1.24 -r1.25
--- /home/repository/moby/moby-live/Perl/MOBY/OntologyServer.pm 2003/07/10 06:06:57 1.24
+++ /home/repository/moby/moby-live/Perl/MOBY/OntologyServer.pm 2003/07/10 19:41:38 1.25
@@ -171,8 +171,12 @@
my ($self, %args) = @_;
my $term = $args{term};
return (0, "WRONG ONTOLOGY!",'') unless ($self->ontology eq 'object');
-
- my $sth = $self->dbh->prepare("select object_lsid, object_type, description, authority, contact_email from object where object_type = ?");
+ my $sth;
+ if ($term =~ /^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 ($id, $type, $desc, $auth, $email) = $sth->fetchrow_array;
if ($id){
@@ -304,9 +308,12 @@
my $term = lc($args{term});
my $ont = $args{ontology};
return (0, "requires both term and ontology arguments\n",'') unless (defined($term) && defined($ont));
-
- unless ($term =~ /urn\:lsid/i){$term = "urn:lsid:biomoby.org:${ont}relation:$term"}
- my $sth = $self->dbh->prepare("select relationship_lsid, relationship_type, description, authority, contact_email from relationship where relationship_lsid = ? and ontology=?");
+ my $sth;
+ if ($term =~ /^urn\:lsid/){
+ $sth = $self->dbh->prepare("select relationship_lsid, relationship_type, description, authority, contact_email from relationship where relationship_lsid = ? and ontology=?");
+ } else {
+ $sth = $self->dbh->prepare("select relationship_lsid, relationship_type, description, authority, contact_email from relationship where relationship_type = ? and ontology=?");
+ }
$sth->execute($term, $ont);
my ($lsid, $type, $desc, $auth, $email) = $sth->fetchrow_array;
if ($lsid){
@@ -402,7 +409,14 @@
my ($self, %args) = @_;
return (0, "WRONG ONTOLOGY!",'') unless ($self->ontology eq 'service');
my $term = $args{term};
- my $sth = $self->dbh->prepare("select service_id, service_type, service_lsid, description, authority, contact_email from service where service_type = ?");
+
+ my $sth;
+ if ($term =~ /^urn\:lsid/){
+ $sth = $self->dbh->prepare("select service_id, service_type, service_lsid, description, authority, contact_email from service where service_lsid = ?");
+ } else {
+ $sth = $self->dbh->prepare("select service_id, service_type, service_lsid, description, authority, contact_email from service where service_type = ?");
+ }
+
$sth->execute($term);
my ($id, $type, $lsid, $desc, $auth, $email) = $sth->fetchrow_array;
if ($id){
@@ -492,7 +506,12 @@
my ($self, %args) = @_;
return (0, "WRONG ONTOLOGY!",'') unless ($self->ontology eq 'namespace');
my $term = $args{term};
- my $sth = $self->dbh->prepare("select namespace_id, namespace_type, namespace_lsid,description, authority, contact_email from namespace where namespace_type = ?");
+ my $sth;
+ if ($term =~ /^urn\:lsid/){
+ $sth = $self->dbh->prepare("select namespace_id, namespace_type, namespace_lsid,description, authority, contact_email from namespace where namespace_lsid = ?");
+ } else {
+ $sth = $self->dbh->prepare("select namespace_id, namespace_type, namespace_lsid,description, authority, contact_email from namespace where namespace_type = ?");
+ }
$sth->execute($term);
my ($id, $type, $lsid,$desc, $auth, $email) = $sth->fetchrow_array;
if ($id){
@@ -854,27 +873,27 @@
my $OS = MOBY::OntologyServer->new(ontology => 'relationship');
my $reluri = $OS->getRelationshipURI($ontology, $relationship); # get the URI for that relationship type if it ins't already a URI
$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 $termthingy(keys %IDS){ # start parsing through the current list (hash keys)
- $debug && _LOG("testing $relationship of $termthingy\n");
- next if ($IDS{$termthingy} eq "tested"); # if it has been tested already then move on
- my $lsids = $self->Relationships(term => $termthingy, relationship => $relationship, direction => $direction); # get the related terms for this type; this should return a single hash value
- if ($IDS{$termthingy} =~ /root/){ # here is where we remove self
- delete $IDS{$termthingy};
- $debug && _LOG("deleting $termthingy\n");
- } else {
- $debug && _LOG("marking $termthingy as TESTED\n");
- $IDS{$termthingy} = "tested"; # mark the current one as now being "done"
- }
- #${$lsids}{relationshiptype}=[lsid, lsid, lsid];
- foreach my $lsid(@{$lsids->{$relationship}}){ # go through the related terms
- $debug && _LOG("found $lsid as relationship");
- next if (defined $IDS{$lsid}); # if we have already seen that term, skip it
- $debug && _LOG("setting $lsid as untested\n");
- $IDS{$lsid} = "untested" # otherwise add it to the list and loop again.
- }
- }
- }
+ while (grep /untested/, (values %IDS)){ # now, while there are untested services in our list...
+ foreach my $termthingy(keys %IDS){ # start parsing through the current list (hash keys)
+ $debug && _LOG("testing $relationship of $termthingy\n");
+ next if ($IDS{$termthingy} eq "tested"); # if it has been tested already then move on
+ my $lsids = $self->Relationships(term => $termthingy, relationship => $relationship, direction => $direction); # get the related terms for this type; this should return a single hash value
+ if ($IDS{$termthingy} =~ /root/){ # here is where we remove self
+ delete $IDS{$termthingy};
+ $debug && _LOG("deleting $termthingy\n");
+ } else {
+ $debug && _LOG("marking $termthingy as TESTED\n");
+ $IDS{$termthingy} = "tested"; # mark the current one as now being "done"
+ }
+ #${$lsids}{relationshiptype}=[lsid, lsid, lsid];
+ foreach my $lsid(@{$lsids->{$relationship}}){ # go through the related terms
+ $debug && _LOG("found $lsid as relationship");
+ next if (defined $IDS{$lsid}); # if we have already seen that term, skip it
+ $debug && _LOG("setting $lsid as untested\n");
+ $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
}
More information about the MOBY-guts
mailing list