[MOBY-guts] biomoby commit
Eddie Kawas
kawas at pub.open-bio.org
Tue Sep 20 21:16:34 UTC 2005
kawas
Tue Sep 20 17:16:34 EDT 2005
Update of /home/repository/moby/moby-live/Perl/MOBY
In directory pub.open-bio.org:/tmp/cvs-serv6465
Modified Files:
OntologyServer.pm
Log Message:
added the suggestions asked for by martin.
Code that has been added is commented out until a decision is made on whether to support the changes.
Code marked by:
#UNCOMMENT denotes code that should be uncommented to add functionality
#COMMENT/REMOVE denotes code that should be removed in conjunction with the additions.
Lines subject to removal: 927
Lines subject to addition: 928
moby-live/Perl/MOBY OntologyServer.pm,1.83,1.84
===================================================================
RCS file: /home/repository/moby/moby-live/Perl/MOBY/OntologyServer.pm,v
retrieving revision 1.83
retrieving revision 1.84
diff -u -r1.83 -r1.84
--- /home/repository/moby/moby-live/Perl/MOBY/OntologyServer.pm 2005/08/30 14:52:15 1.83
+++ /home/repository/moby/moby-live/Perl/MOBY/OntologyServer.pm 2005/09/20 21:16:34 1.84
@@ -1,1315 +1,1316 @@
-#$Id$
-# this module needs to talk to the 'real' ontology
-# server as well as the MOBY Central database
-# in order to ensure that they are both in sync
-
-=head1 NAME
-
-MOBY::OntologyServer - A way for MOBY Central to query the
-object, service, namespace, and relationship ontologies
-
-=cut
-
-=head1 SYNOPSIS
-
- use MOBY::OntologyServer;
- my $OS = MOBY::OntologyServer->new(ontology => "object");
-
- my ($success, $message, $existingURI) = $OS->objectExists(term => "Object");
-
- if ($success){
- print "object exists and it has the LSID $existingURI\n";
- } else {
- print "object does not exist; additional message from server: $message\n";
- }
-
-
-=cut
-
-=head1 DESCRIPTION
-
-Swappable interface to ontologies. It should deal with LSID's 100%
-of the time, and also deal with MOBY-specific common names for objects,
-services, namespaces, and relationship types.
-
-
-
-=head1 AUTHORS
-
-Mark Wilkinson (markw at illuminae.com)
-
-BioMOBY Project: http://www.biomoby.org
-
-
-=cut
-
-=head1 METHODS
-
-
-=head2 new
-
- Title : new
- Usage : my $OS = MOBY::OntologyServer->new(%args)
- Function :
- Returns : MOBY::OntologyServer object
- Args : ontology => [object || service || namespace || relationship]
- database => mysql databasename that holds the ontologies
- host => mysql hostname
- username => mysql username
- password => mysql password
- port => mysql port
- dbh => pre-existing database handle to a mysql database
-
-=cut
-
-package MOBY::OntologyServer;
-use strict;
-use Carp;
-use vars qw($AUTOLOAD);
-use DBI;
-use DBD::mysql;
-use MOBY::Config;
-my $debug = 0;
-{
-
- #Encapsulated class data
- #___________________________________________________________
- #ATTRIBUTES
- my %_attr_data = # DEFAULT ACCESSIBILITY
- (
- ontology => [ undef, 'read/write' ],
- database => [ undef, 'read/write' ],
- host => [ undef, 'read/write' ],
- username => [ undef, 'read/write' ],
- password => [ undef, 'read/write' ],
- port => [ undef, 'read/write' ],
- dbh => [ undef, 'read/write' ],
- );
-
- #_____________________________________________________________
- # METHODS, to operate on encapsulated class data
- # Is a specified object attribute accessible in a given mode
- sub _accessible {
- my ( $self, $attr, $mode ) = @_;
- $_attr_data{$attr}[1] =~ /$mode/;
- }
-
- # Classwide default value for a specified object attribute
- sub _default_for {
- my ( $self, $attr ) = @_;
- $_attr_data{$attr}[0];
- }
-
- # List of names of all specified object attributes
- sub _standard_keys {
- keys %_attr_data;
- }
-}
-
-sub new {
- my ( $caller, %args ) = @_;
- my $caller_is_obj = ref($caller);
- my $class = $caller_is_obj || $caller;
- my $self = bless {}, $class;
- foreach my $attrname ( $self->_standard_keys ) {
- if ( exists $args{$attrname} && defined $args{$attrname} ) {
- $self->{$attrname} = $args{$attrname};
- } elsif ($caller_is_obj) {
- $self->{$attrname} = $caller->{$attrname};
- } else {
- $self->{$attrname} = $self->_default_for($attrname);
- }
- }
- $self->ontology eq 'object' && $self->database('mobyobject');
- $self->ontology eq 'namespace' && $self->database('mobynamespace');
- $self->ontology eq 'service' && $self->database('mobyservice');
- $self->ontology eq 'relationship' && $self->database('mobyrelationship');
-
- #print STDERR "\n\nCONFIG object is $CONFIG\n\n";
- $CONFIG ||= MOBY::Config->new;
-
-#print STDERR "got username ",($CONFIG->{mobycentral}->{username})," for mobycentral\n";
- $self->username( $CONFIG->{ $self->database }->{username} )
- unless $self->username;
- $self->password( $CONFIG->{ $self->database }->{password} )
- unless $self->password;
- $self->port( $CONFIG->{ $self->database }->{port} ) unless $self->port;
- $self->host( $CONFIG->{ $self->database }->{url} ) unless $self->host;
- my $host = $self->host ? $self->host : $ENV{MOBY_CENTRAL_URL};
- chomp $host;
- my $username =
- $self->username ? $self->username : $ENV{MOBY_CENTRAL_DBUSER};
- chomp $username;
- my $password =
- $self->password ? $self->password : $ENV{MOBY_CENTRAL_DBPASS};
- chomp $password if $password;
- $password =~ s/\s//g if $password;
- my $port = $self->port ? $self->port : $ENV{MOBY_CENTRAL_DBPORT};
- chomp $port;
- my ($dsn) =
- "DBI:mysql:"
- . ( $CONFIG->{ $self->database }->{dbname} ) . ":"
- . ($host) . ":"
- . ($port);
-
- #print STDERR "\n\nDSN was $dsn\n\n";
- my $dbh;
-
-# $debug && &_LOG("connecting to db with params ",$self->database, $self->username, $self->password,"\n");
- if ( defined $password ) {
- $dbh = DBI->connect( $dsn, $username, $password, { RaiseError => 1 } )
- or die "can't connect to database";
- } else {
- $dbh = DBI->connect( $dsn, $username, undef, { RaiseError => 1 } )
- or die "can't connect to database";
- }
-
- # $debug && &_LOG("CONNECTED!\n");
- if ($dbh) {
- $self->dbh($dbh);
- return $self;
- } else {
- return undef;
- }
-}
-
-=head2 objectExists
-
- moby:newterm will return (0, $message, $MOBYLSID)
- newterm will return (0, $message, $MOBYLSID
- oldterm will return (1, $message, undef)
- newLSID will return (0, $desc, $lsid)
-=cut
-
-sub objectExists {
- my ( $self, %args ) = @_;
-
- $CONFIG ||= MOBY::Config->new; # exported by Config.pm
- my $adaptor = $CONFIG->getDataAdaptor( datasource => 'mobyobject' );
-
- my $term = $args{term};
- $term =~ s/^moby://; # if the term is namespaced, then remove that
- my $sth;
- return ( 0, "WRONG ONTOLOGY!", '' ) unless ( $self->ontology eq 'object' );
-
- my $result;
-
- $result = $adaptor->query_object(type => $term);
-
- my $row = shift(@$result);
- my $lsid = $row->{object_lsid};
- my $type = $row->{object_type};
- my $desc = $row->{description};
- my $auth = $row->{authority};
- my $email = $row->{contact_email};
-
- if ($lsid)
- { # if it is in there, then it has been discovered regardless of being foreign or not
- return ( 1, $desc, $lsid );
- } elsif ( _isForeignLSID($term) )
- { # if not in our ontology, but is a foreign LSID, then pass it back verbatim
- return (
- 0,
-"LSID $term does not exist in the biomoby.org Object Class system\n",
- $term
- );
- } else { # under all other circumstances (i.e. not a term, or a non-existent biomoby LSID) then fail
- return (
- 0,
-"Object type $term does not exist in the biomoby.org Object Class system\n",
- ''
- );
- }
-}
-
-sub _isMOBYLSID {
- my ($lsid) = @_;
- return 1 if $lsid =~ /^urn\:lsid\:biomoby.org/;
- return 0;
-}
-
-sub _isForeignLSID {
- my ($lsid) = @_;
- return 0 if $lsid =~ /^urn\:lsid\:biomoby.org/;
- return 1;
-}
-
-=head2 createObject
-
-=cut
-
-sub createObject {
- my ( $self, %args ) = @_;
- $CONFIG ||= MOBY::Config->new; # exported by Config.pm
- my $adaptor = $CONFIG->getDataAdaptor( datasource => 'mobyobject' );
- return ( 0, "WRONG ONTOLOGY!", '' ) unless ( $self->ontology eq 'object' );
- return ( 0, "requires a object type node", '' ) unless ( $args{node} );
- return ( 0, "requires an authURI ", '' ) unless ( $args{authority} );
- return ( 0, "requires a contact email address", '' )
- unless ( $args{contact_email} );
- return ( 0, "requires a object description", '' )
- unless ( $args{description} );
- my $term = $args{node};
-
- my $LSID =
- ( $args{'node'} =~ /urn\:lsid/ )
- ? $args{'node'}
- : $self->setURI( $args{'node'} );
- unless ($LSID) { return ( 0, "Failed during creation of an LSID", '' ) }
- my $result;
- $result = $adaptor->query_object(type => $term);
- my $row = shift(@$result);
- my $lsid = $row->{object_lsid};
- my $type = $row->{object_type};
- my $desc = $row->{description};
- my $auth = $row->{authority};
- my $email = $row->{contact_email};
-
- 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;
- $args{authority} =~ s/^\s+(.*?)\s+$/$1/s;
-
- my $insertid = $adaptor->insert_object(object_type => $args{'node'},
- object_lsid => $LSID,
- description => $args{'description'},
- authority => $args{'authority'},
- contact_email => $args{'contact_email'});
- unless ( $insertid ) {
- return ( 0, "Object creation failed for unknown reasons", '' );
- }
- return ( 1, "Object creation succeeded", $LSID );
-}
-
-=head2 retrieveObject
-
-=cut
-
-sub retrieveObject {
- my ( $self, %args ) = @_;
- $CONFIG ||= MOBY::Config->new; # exported by Config.pm
- my $adaptor = $CONFIG->getDataAdaptor( datasource => 'mobyobject' );
- my $term = $args{'type'};
- $term ||=$args{'node'};
-
- return ( 0, "WRONG ONTOLOGY!", '' ) unless ( $self->ontology eq 'object' );
- return ( 0, "requires a object type node as an argument", '' )
- unless ( $term );
- my $LSID =
- ( $term =~ /urn\:lsid/ )
- ? $term
- : $self->getObjectURI($term);
- unless ($LSID) { return ( 0, "Failed during creation of an LSID", '' ) }
- my $result = $adaptor->query_object(type => $LSID);
- my $row = shift(@$result);
-# my $id = $row->{object_id};
- my $type = $row->{object_type};
- my $lsid = $row->{object_lsid};
- my $desc = $row->{description};
- my $auth = $row->{authority};
- my $contact = $row->{contact_email};
-
- unless ($lsid) { return ( 0, "Object doesn't exist in ontology", "" ) }
-
- # my $OS = MOBY::OntologyServer->new(ontology => "relationship");
-
- $result = $adaptor->get_object_relationships(type => $lsid);
- my %rel;
- foreach my $row (@$result)
- {
- my $relationship_type = $row->{relationship_type};
- my $objectlsid = $row->{object_lsid};
- my $article = $row->{object2_articlename};
- my $contact = $row->{contact_email};
- my $def = $row->{definition};
- my $auth = $row->{authority};
- my $type = $row->{object_type};
-
- push @{ $rel{$relationship_type} }, [ $objectlsid, $article, $type, $def, $auth, $contact ];
- }
- return {
- objectType => $type,
- objectLSID => $lsid,
- description => $desc,
- contactEmail => $contact,
- authURI => $auth,
- Relationships => \%rel
- };
-}
-
-=head2 deprecateObject
-
-=cut
-
-sub deprecateObject {
- my ( $self, %args ) = @_;
- $CONFIG ||= MOBY::Config->new; # exported by Config.pm
- my $adaptor = $CONFIG->getDataAdaptor( datasource => 'mobyobject' );
-
- return ( 0, "WRONG ONTOLOGY", '' ) unless ( $self->ontology eq 'object' );
- my $term = $args{term};
-
-# if ($term =~ /^urn:lsid/ && !($term =~ /^urn:lsid:biomoby.org:objectclass/)){
-# return (0, "can't delete from external ontology", $term);
-# }
- my $LSID;
- unless ( $term =~ /urn\:lsid/ ) { $LSID = $self->getObjectURI($term) } else { $LSID = $term }
- return ( 0, q{Object type $term cannot be resolved to an LSID}, "" )
- unless $LSID;
-
- my $result = $adaptor->query_object(type => $LSID);
- my $row = shift(@$result);
- my $id = $row->{object_id};
- my $lsid = $row->{object_lsid};
-
- # object1_id ISA object2_id?
- my $isa = $adaptor->query_object_term2term(type => $lsid);
- my $isas = shift @$isa;
- if ( $isas->{object1_id}) {
- return ( 0,
- qq{Object type $term has object dependencies in the ontology},
- $lsid );
- }
-
- my ($err, $errstr) = $adaptor->delete_object(type => $lsid);
- if ( $err ) {
- return ( 0, "Delete from Object Class table failed: $errstr",
- $lsid );
- }
- return ( 1, "Object $term Deleted", $lsid );
-}
-
-=head2 deleteObject
-
-=cut
-
-sub deleteObject {
- my $self = shift;
- $self->deprecateObject(@_);
-}
-
-=head2 relationshipExists
-
-=cut
-
-sub relationshipExists {
-
- # term => $term
- # ontology => $ontology
- my ( $self, %args ) = @_;
- $CONFIG ||= MOBY::Config->new; # exported by Config.pm
- my $adaptor = $CONFIG->getDataAdaptor( datasource => 'mobyrelationship' );
- return ( 0, "WRONG ONTOLOGY!", '' )
- unless ( $self->ontology eq 'relationship' );
- my $term = lc( $args{term} );
- $term =~ s/^moby://; # if the term is namespaced, then remove that
- my $ont = $args{ontology};
- return ( 0, "requires both term and ontology arguments\n", '' )
- unless ( defined($term) && defined($ont) );
- my $result;
- if ( $term =~ /^urn\:lsid/ ) {
-
- $result = $adaptor->query_relationship(
- type => $term,
- ontology => $ont);
-
- } else {
-
- $result = $adaptor->query_relationship(type => $term, ontology => $ont);
-
- }
- my $row = shift(@$result);
- my $lsid = $row->{relationship_lsid};
- my $type = $row->{relationship_type};
- my $desc = $row->{description};
- my $auth = $row->{authority};
- my $email = $row->{contact_email};
- if ($lsid) {
- return ( 1, $desc, $lsid, $type, $auth, $email );
- } else {
- return (
- 0,"Relationship Type $term does not exist in the biomoby.org Relationship Type system\n",
- '', '', '', ''
- );
- }
-}
-
-=head2 addObjectRelationship
-
-=cut
-
-sub addObjectRelationship {
-
- # adds a relationship
- #subject_node => $term,
- #relationship => $reltype,
- #object_node => $objectType,
- #articleName => $articleName,
- #authority => $auth,
- #contact_email => $email
- my ( $self, %args ) = @_;
- $CONFIG ||= MOBY::Config->new; # exported by Config.pm
- my $adaptor = $CONFIG->getDataAdaptor( datasource => 'mobyobject' );
-
- return ( 0, "WRONG ONTOLOGY!", '' ) unless ( $self->ontology eq 'object' );
-
- my $result = $adaptor->query_object(type => $args{subject_node});
- my $row = shift(@$result);
- my $subj_lsid = $row->{object_lsid};
- return ( 0, qq{Object type $args{subject_node} does not exist in the ontology}, '' )
- unless defined $subj_lsid;
-
- $result = $adaptor->query_object(type => $args{object_node});
- $row = shift(@$result);
- my $obj_lsid = $row->{object_lsid};
- return ( 0,qq{Object type $args{object_node} does not exist in the ontology},'' )
- unless defined $obj_lsid;
- my $isa = $adaptor->query_object_term2term(type => $subj_lsid);
- my $isarow = shift @$isa;
- if ( $isarow->{object_lsid} ) {
- return (
- 0,
- qq{Object type $args{subject_node} has existing object dependencies in the ontology. It cannot be changed.},
- $subj_lsid
- );
- }
- my $OE = MOBY::OntologyServer->new( ontology => 'relationship' );
- my ( $success, $desc, $rel_lsid ) = $OE->relationshipExists(
- term => $args{relationship},
- ontology => 'object' );
- ($success) || return ( 0,
- qq{Relationship $args{relationship} does not exist in the ontology},
- '' );
-
- # need to ensure that identical article names dont' end up at the same level
- my $articleNameInvalid = &_testIdenticalArticleName(term => $subj_lsid, articleName => $args{articleName});
- return (0, "Object will have conflicting articleName ".($args{articleName}), '') if $articleNameInvalid;
-
- my $insertid = $adaptor->insert_object_term2term(relationship_type => $rel_lsid,
- object1_type => $subj_lsid,
- object2_type => $obj_lsid,
- object2_articlename => $args{articleName});
-
-
- if ($insertid ) {
- return ( 1, "Object relationsihp created successfully", '' );
- } else {
- return ( 0, "Object relationship creation failed for unknown reasons",
- '' );
- }
-}
-
-sub _testIdenticalArticleName {
- my (%args)= @_;
- my $term = $args{term};
- my $articleName = $args{articleName};
- my $foundCommonArticleNameFlag = 0;
- # need to first traverse down the ISA pathway to root
- # then for each ISA test the hAS and HASA's for their articlenames and see if they are the same
- # case insensitive?
- my $OS = MOBY::OntologyServer->new(ontology => 'object');
- my $OSrel = MOBY::OntologyServer->new(ontology => 'relationship');
- my ($exists1, $desc, $isalsid) = $OSrel->relationshipExists(term => 'isa', ontology => 'object');
- my ($exists2, $desc2, $hasalsid) = $OSrel->relationshipExists(term => 'hasa', ontology => 'object');
- my ($exists3, $desc3, $haslsid) = $OSrel->relationshipExists(term => 'has', ontology => 'object');
-
- return 1 unless ($exists1 && $exists2 && $exists3); # this is bad, since it returns boolean suggesting that it found a common articlename rather than finding that a given relationship doesn't exist, but... hey....
- # check the hasa relationships for common articleName
- $foundCommonArticleNameFlag += _compareArticleNames(OS => $OS, type => $args{term}, relationship => $hasalsid, targetArticleName => $articleName);
- # check the has relationships for common articleName
- $foundCommonArticleNameFlag += _compareArticleNames(OS => $OS, type => $args{term}, relationship => $haslsid, targetArticleName => $articleName);
-
- # now get all of its inherited parents
- my $relationships = $OS->Relationships(
- ontology => 'object',
- term => $args{term},
- 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;
- # check the hasa relationships for common articleName
- $foundCommonArticleNameFlag += _compareArticleNames(OS => $OS, type => $what_it_is, relationship => $hasalsid, targetArticleName => $articleName);
- # check the has relationships for common articleName
- $foundCommonArticleNameFlag += _compareArticleNames(OS => $OS, type => $what_it_is, relationship => $haslsid, targetArticleName => $articleName);
- }
- return $foundCommonArticleNameFlag;
-}
-
-sub _compareArticleNames {
- my (%args) = @_;
- my $OS = $args{OS};
- my $what_it_is = $args{type};
- my $lsid = $args{relationship};
- my $targetArticleName = $args{targetArticleName};
- my $foundCommonArticleNameFlag = 0;
- my $contents = $OS->Relationships(
- ontology => 'object',
- term => $what_it_is,
- relationship => $lsid,
- direction => 'root',
- );
- if ($contents){
- #$hasarelationships{relationship} = [[lsid1,articleNmae], [lsid2, articleName], [lsid3, articleName]]
- my ($content) = keys(%$contents);
- if ($contents->{$content}){
- my @CONTENTlist = @{$contents->{$content}};
- foreach my $CONTAINED(@CONTENTlist){
- $foundCommonArticleNameFlag = 1 if ($CONTAINED->[1] eq $targetArticleName); #->[1] is the articleName field
- }
- }
- }
- return $foundCommonArticleNameFlag;
-}
-
-=head2 addServiceRelationship
-
-=cut
-
-sub addServiceRelationship {
-
- # adds an ISA relationship
- # fail if another object is in relation to this objevt
- #subject_node => $term,
- #relationship => $relationship,
- #predicate_node => $pred
- #authority => $auth,
- #contact_email => $email);
- my ( $self, %args ) = @_;
- $CONFIG ||= MOBY::Config->new; # exported by Config.pm
- my $adaptor = $CONFIG->getDataAdaptor( datasource => 'mobyservice' );
-
- return ( 0, "WRONG ONTOLOGY!", '' ) unless ( $self->ontology eq 'service' );
-
- my $result = $adaptor->query_service(type => $args{subject_node});
- my $row = shift(@$result);
- my $sbj_lsid = $row->{service_lsid};
-
- return (0,
- qq{Service type $args{subject_node} has object dependencies in the ontology. It can not be changed},
- $sbj_lsid
- ) unless defined $sbj_lsid;
-
- my $isa = $adaptor->query_service_term2term(service2_id => $sbj_lsid);
- my $isarow = shift @$isa;
- if ( $isarow->{service_lsid} ) {
- return (
- 0,
- qq{Service type $args{subject_node} has object dependencies in the ontology. It can not be changed},
- $sbj_lsid
- );
- }
- $result = $adaptor->query_service(type => $args{object_node});
- $row = shift(@$result);
- my $obj_lsid = $row->{service_lsid};
- # get ID of the related service
-
- defined $obj_lsid
- || return ( 0,
- qq{Service $args{object_node} does not exist in the service ontology},
- '' );
- my $OE = MOBY::OntologyServer->new( ontology => 'relationship' );
- my ( $success, $desc, $rel_lsid ) = $OE->relationshipExists(
- term => $args{relationship},
- ontology => 'service' );
- ($success)
- || return ( 0,
- qq{Relationship $args{relationship} does not exist in the ontology},
- '' );
-
- my $insertid = $adaptor->insert_service_term2term(relationship_type => $rel_lsid,
- service1_type => $sbj_lsid,
- service2_type => $obj_lsid);
- if ( defined($insertid)) {
- return ( 1, "Service relationship created successfully", '' );
- } else {
- return ( 0, "Service relationship creation failed for unknown reasons",
- '' );
- }
-}
-
-=head2 serviceExists
-
-=cut
-
-sub serviceExists {
- my ( $self, %args ) = @_;
- $CONFIG ||= MOBY::Config->new; # exported by Config.pm
- my $adaptor = $CONFIG->getDataAdaptor( datasource => 'mobyservice' );
-
- return ( 0, "WRONG ONTOLOGY!", '' ) unless ( $self->ontology eq 'service' );
- my $term = $args{term};
- $term =~ s/^moby://; # if the term is namespaced, then remove that
- if ( $term =~ /^urn:lsid/
- && !( $term =~ /^urn:lsid:biomoby.org:servicetype/ ) )
- {
- return ( 1, "external ontology", $term );
- }
- my $result;
- $result = $adaptor->query_service(type => $term);
- my $row = shift(@$result);
- my $id = $row->{service_id};
- my $type = $row->{service_type};
- my $lsid = $row->{service_lsid};
- my $desc = $row->{description};
- my $auth = $row->{authority};
- my $email = $row->{contact_email};
-
- if ($id) {
- return ( 1, $desc, $lsid );
- } else {
- return (
- 0,
-"Service Type $term does not exist in the biomoby.org Service Type ontology\n",
- ''
- );
- }
-}
-
-=head2 createServiceType
-
-=cut
-
-sub createServiceType {
- my ( $self, %args ) = @_;
- $CONFIG ||= MOBY::Config->new; # exported by Config.pm
- my $adaptor = $CONFIG->getDataAdaptor( datasource => 'mobyservice' );
-
- #node => $term,
- #descrioption => $desc,
- #authority => $auth,
- #contact_email => $email);
- return ( 0, "WRONG ONTOLOGY!", '' ) unless ( $self->ontology eq 'service' );
- return ( 0, "requires a object type node", '' ) unless ( $args{node} );
- return ( 0, "requires an authURI ", '' ) unless ( $args{authority} );
- 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:servicetype/ ) )
- { # 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", '' ) }
-
- my $insertid = $adaptor->insert_service(service_type => $args{'node'},
- service_lsid => $LSID,
- description => $args{'description'},
- authority => $args{'authority'},
- contact_email => $args{'contact_email'});
-
- unless ( $insertid ) {
- return ( 0, "Service creation failed for unknown reasons", '' );
- }
- return ( 1, "Service creation succeeded", $LSID );
-}
-
-=head2 deleteServiceType
-
-=cut
-
-sub deleteServiceType {
- my ( $self, %args ) = @_;
- $CONFIG ||= MOBY::Config->new; # exported by Config.pm
- my $adaptor = $CONFIG->getDataAdaptor( datasource => 'mobyservice' );
-
- return ( 0, "WRONG ONTOLOGY!", '' ) unless ( $self->ontology eq 'service' );
- my $term = $args{term};
- if ( $term =~ /^urn:lsid/
- && !( $term =~ /^urn:lsid:biomoby.org:servicetype/ ) )
- {
- return ( 0, "can't delete from external ontology", $term );
- }
- my $LSID;
- unless ( $term =~ /^urn:lsid:biomoby.org:servicetype/ ) {
- $LSID = $self->getServiceURI($term);
- } else {
- $LSID = $term;
- }
- return (
- 0, q{Service type $term cannot be resolved to an LSID in the MOBY ontologies},""
- ) unless $LSID;
-
- my $result = $adaptor->query_service(type => $LSID);
- my $row = shift(@$result);
- my $lsid = $row->{service_lsid};
-
- if ( !defined $lsid ) {
- return ( 0, q{Service type $term does not exist in the ontology},
- $lsid );
- }
-
- # service1_id ISA service2_id?
- my $isa = $adaptor->query_service_term2term(type => $lsid);
- my $isas = shift(@$isa);
-
- if ( $isas->{service1_id} ) {
- return ( 0, qq{Service type $term has dependencies in the ontology},
- $lsid );
- }
- my ($err, $errstr) = $adaptor->delete_service(type => $lsid);
-
- if ( $err ) {
- return ( 0, "Delete from Service Type table failed: $errstr",
- $lsid );
- }
-
- return ( 1, "Service Type $term Deleted", $lsid );
-}
-
-=head2 namespaceExists
-
-=cut
-
-sub namespaceExists {
- my ( $self, %args ) = @_;
- $CONFIG ||= MOBY::Config->new; # exported by Config.pm
- my $adaptor = $CONFIG->getDataAdaptor( datasource => 'mobynamespace' );
-
- return ( 0, "WRONG ONTOLOGY!", '' )
- unless ( $self->ontology eq 'namespace' );
- my $term = $args{term};
- $term =~ s/^moby://; # if the term is namespaced, then remove that
- if ( $term =~ /^urn:lsid/
- && !( $term =~ /^urn:lsid:biomoby.org:namespacetype/ ) )
- {
- return ( 1, "external ontology", $term );
- }
- my $result;
- $result = $adaptor->query_namespace(type => $term);
- my $row = shift(@$result);
- my $id = $row->{namespace_id};
- my $type = $row->{namespace_type};
- my $lsid = $row->{namespace_lsid};
- my $desc = $row->{description};
- my $auth = $row->{authority};
- my $email = $row->{contact_email};
-
- if ($id) {
- return ( 1, $desc, $lsid );
- } else {
- return (
- 0,
-"Namespace Type $term does not exist in the biomoby.org Namespace Type ontology\n",
- ''
- );
- }
-}
-
-=head2 createNamespace
-
-=cut
-
-sub createNamespace {
- my ( $self, %args ) = @_;
- $CONFIG ||= MOBY::Config->new; # exported by Config.pm
- my $adaptor = $CONFIG->getDataAdaptor( datasource => 'mobynamespace' );
- #node => $term,
- #descrioption => $desc,
- #authority => $auth,
- #contact_email => $email);
- return ( 0, "WRONG ONTOLOGY!", '' )
- unless ( $self->ontology eq 'namespace' );
- return ( 0, "requires a namespace type node", '' ) unless ( $args{node} );
- return ( 0, "requires an authURI ", '' ) unless ( $args{authority} );
- 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:namespacetype/ ) )
- { # 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", '' ) }
-
- my $insertid = $adaptor->insert_namespace(namespace_type => $args{'node'},
- namespace_lsid => $LSID,
- description => $args{'description'},
- authority => $args{'authority'},
- contact_email => $args{'contact_email'});
-
- unless ( $insertid ) {
- return ( 0, "Namespace creation failed for unknown reasons", '' );
- }
- return ( 1, "Namespace creation succeeded", $LSID );
-}
-
-=head2 deleteNamespace
-
-=cut
-
-sub deleteNamespace {
- my ( $self, %args ) = @_;
- $CONFIG ||= MOBY::Config->new; # exported by Config.pm
- my $adaptor = $CONFIG->getDataAdaptor( datasource => 'mobynamespace' );
- return ( 0, "WRONG ONTOLOGY!", '' )
- unless ( $self->ontology eq 'namespace' );
- my $term = $args{term};
- my $LSID;
- unless ( $term =~ /urn\:lsid/ ) { $LSID = $self->getNamespaceURI($term) } else { $LSID = $term }
- return ( 0, q{Namespace type $term cannot be resolved to an LSID}, "" )
- unless $LSID;
- if ( $term =~ /^urn:lsid/
- && !( $term =~ /^urn:lsid:biomoby.org:namespacetype/ ) )
- {
- return ( 0, "cannot delete a term from an external ontology", $term );
- }
-
- my $result = $adaptor->query_namespace(type => $LSID);
- my $row = shift(@$result);
- my $lsid = $row->{namespace_lsid};
-
- unless ($lsid) {
- return ( 0, q{Namespace type $term does not exist in the ontology},
- $lsid );
- }
-
- # service1_id ISA service2_id?
- my $isa = $adaptor->query_namespace_term2term(type => $lsid);
- my $isas = shift @$isa;
-
- if ($isas->{namespace1_id} ) {
- return ( 0, qq{Namespace type $term has dependencies in the ontology},
- $lsid );
- }
-
- my ($err, $errstr) = $adaptor->delete_namespace(type => $lsid);
-
- if ( $err ) {
- return ( 0, "Delete from namespace table failed: $errstr",
- $lsid );
- }
-
- #($err, $errstr) = $adaptor->delete_namespace_term2term(namespace1_id => $lsid);
- #
- #if ( $err ) {
- # return (
- # 0,
- # "Delete from namespace term2term table failed: $errstr",
- # $lsid
- # );
- #}
- return ( 1, "Namespace Type $term Deleted", $lsid );
-}
-
-=head2 retrieveAllServiceTypes
-
-=cut
-
-sub retrieveAllServiceTypes {
- my ($self) = @_;
- $CONFIG ||= MOBY::Config->new; # exported by Config.pm
- my $adaptor = $CONFIG->getDataAdaptor( datasource => 'mobyservice' );
- my $types = $adaptor->query_service();
-
- my %response;
- foreach (@$types) {
- $response{ $_->{service_type} } = [$_->{description}, $_->{service_lsid}];
- }
- return \%response;
-}
-
-=head2 retrieveAllNamespaceTypes
-
-=cut
-
-sub retrieveAllNamespaceTypes {
- my ($self) = @_;
- $CONFIG ||= MOBY::Config->new; # exported by Config.pm
- my $adaptor = $CONFIG->getDataAdaptor( datasource => 'mobynamespace' );
- my $types = $adaptor->query_namespace();
-
- my %response;
- foreach (@$types) {
- $response{ $_->{namespace_type} } = [$_->{description}, $_->{namespace_lsid}, $_->{authority}, $_->{contact_email}];
- }
- return \%response;
-}
-
-=head2 retrieveAllObjectClasses
-
-=cut
-
-sub retrieveAllObjectClasses {
- my ($self) = @_;
- $CONFIG ||= MOBY::Config->new; # exported by Config.pm
- my $adaptor = $CONFIG->getDataAdaptor( datasource => 'mobyobject' );
- my $types = $adaptor->query_object();
-
- my %response;
- foreach (@$types) {
- $response{ $_->{object_type} } = [$_->{description}, $_->{object_lsid}];
- }
- return \%response;
-}
-*retrieveAllObjectTypes = \&retrieveAllObjectClasses;
-*retrieveAllObjectTypes = \&retrieveAllObjectClasses;
-
-=head2 getObjectCommonName
-
-=cut
-
-sub getObjectCommonName {
- my ( $self, $URI ) = @_;
- $CONFIG ||= MOBY::Config->new; # exported by Config.pm
- my $adaptor = $CONFIG->getDataAdaptor( datasource => 'mobyobject' );
- return undef unless $URI =~ /urn\:lsid/;
- my $result = $adaptor->query_object(type => $URI);
- my $row = shift(@$result);
- my $name = $row->{object_type};
-
- return $name ? $name : $URI;
-}
-
-=head2 getNamespaceCommonName
-
-=cut
-
-sub getNamespaceCommonName {
- my ( $self, $URI ) = @_;
- $CONFIG ||= MOBY::Config->new; # exported by Config.pm
- my $adaptor = $CONFIG->getDataAdaptor( datasource => 'mobynamespace' );
- return undef unless $URI =~ /urn\:lsid/;
- my $result = $adaptor->query_namespace(type => $URI);
- my $row = shift(@$result);
- my $name = $row->{namespace_type};
-
- return $name ? $name : $URI;
-}
-
-=head2 getServiceCommonName
-
-=cut
-
-sub getServiceCommonName {
- my ( $self, $URI ) = @_;
- $CONFIG ||= MOBY::Config->new; # exported by Config.pm
- my $adaptor = $CONFIG->getDataAdaptor( datasource => 'mobyservice' );
- return undef unless $URI =~ /urn\:lsid/;
- my $result = $adaptor->query_service(type => $URI);
- my $row = shift(@$result);
- my $name = $row->{service_type};
-
- return $name ? $name : $URI;
-}
-
-=head2 getServiceURI
-
-=cut
-
-sub getServiceURI {
- my ( $self, $term ) = @_;
- $CONFIG ||= MOBY::Config->new; # exported by Config.pm
- my $adaptor = $CONFIG->getDataAdaptor( datasource => 'mobyservice' );
- return $term if $term =~ /urn\:lsid/;
-
- my $result = $adaptor->query_service(type => $term);
- my $row = shift(@$result);
- my $id = $row->{service_lsid};
-
- return $id;
-}
-
-=head2 getObjectURI
-
-=cut
-
-sub getObjectURI {
- my ( $self, $term ) = @_;
- $CONFIG ||= MOBY::Config->new; # exported by Config.pm
- my $adaptor = $CONFIG->getDataAdaptor( datasource => 'mobyobject' );
- return $term if $term =~ /urn\:lsid/;
-
- my $result = $adaptor->query_object(type => $term);
- my $row = shift(@$result);
- my $id = $row->{object_lsid};
-
- return $id;
-}
-
-=head2 getNamespaceURI
-
-=cut
-
-sub getNamespaceURI {
- my ( $self, $term ) = @_;
- $CONFIG ||= MOBY::Config->new; # exported by Config.pm
- my $adaptor = $CONFIG->getDataAdaptor( datasource => 'mobynamespace' );
-
- return $term if $term =~ /urn\:lsid/;
-
- my $result = $adaptor->query_namespace(type => $term);
- my $row = shift(@$result);
- my $id = $row->{namespace_lsid};
-
- return $id;
-}
-
-=head2 getRelationshipURI
-
-consumes ontology (object/service)
-consumes relationship term as term or LSID
-
-=cut
-
-sub getRelationshipURI {
- my ( $self, $ontology, $term ) = @_;
- $CONFIG ||= MOBY::Config->new; # exported by Config.pm
- my $adaptor = $CONFIG->getDataAdaptor( datasource => 'mobyrelationship' );
-
- return $term if $term =~ /urn\:lsid/;
-
- my $result = $adaptor->query_relationship(type => $term, ontology => $ontology);
- my $row = shift(@$result);
- my $id = $row->{relationship_lsid};
-
- return $id;
-}
-
-=head2 getRelationshipTypes
-
-=cut
-
-sub getRelationshipTypes {
- my ( $self, %args ) = @_;
- $CONFIG ||= MOBY::Config->new; # exported by Config.pm
- my $adaptor = $CONFIG->getDataAdaptor( datasource => 'mobyrelationship' );
-
- my $ontology = $args{'ontology'};
- my $OS = MOBY::OntologyServer->new( ontology => "relationship" );
-
- my $defs = $adaptor->query_relationship(ontology => $ontology);
-
- my %result;
- foreach ( @$defs ) {
- $result{ $_->{relationship_lsid} } = [ $_->{relationship_type}, $_->{authority}, $_->{description} ];
- }
- return \%result;
-}
-
-=head2 Relationships
-
-=cut
-
-sub Relationships {
-
- # this entire subroutine assumes that there is NOT multiple parenting!!
- my ( $self, %args ) = @_;
- my $ontology = $args{ontology} ? $args{ontology} : $self->ontology;
- my $term = $args{term};
- my $relationship = $args{relationship};
- my $direction = $args{direction} ? $args{direction} : 'root';
- my $expand = $args{expand} ? 1 : 0;
- return
- unless ( $ontology
- && $term
- && ( ( $ontology eq 'service' ) || ( $ontology eq 'object' ) ) );
-
- # convert $term into an LSID if it isn't already
- if ( $ontology eq 'service' ) {
- $term = $self->getServiceURI($term);
- $relationship ||="isa";
- my $OS = MOBY::OntologyServer->new(ontology => 'relationship');
- $relationship = $OS->getRelationshipURI("service", $relationship);
- } elsif ( $ontology eq 'object' ) {
- $term = $self->getObjectURI($term);
- $relationship ||="isa";
- my $OS = MOBY::OntologyServer->new(ontology => 'relationship');
- $relationship = $OS->getRelationshipURI("object", $relationship);
- }
- my %results;
- while ( ( $term ne 'urn:lsid:biomoby.org:objectclass:Object' )
- && ( $term ne 'urn:lsid:biomoby.org:servicetype:Service' ) )
- {
- my $defs = $self->_doRelationshipsQuery( $ontology, $term,
- $relationship, $direction );
- return {[]} unless $defs; # somethig has gone terribly wrong!
- my $lsid;
- my $rel;
- my $articleName;
- foreach ( @{$defs} ) {
- $lsid = $_->[0];
- $rel = $_->[1];
- $articleName = $_->[2];
- $articleName ||="";
- $debug
- && _LOG("\t\tADDING RELATIONSHIP $_ : $lsid to $rel\n");
- push @{ $results{$rel} }, [$lsid, $articleName];
- }
- last unless ($expand);
- last unless ( $direction eq "root" ); # if we aren't going to root, then be careful or we'll loop infnitely
- $term = $lsid; # this entire subroutine assumes that there is NOT multiple parenting...
- }
- return \%results; #results(relationship} = [[lsid1,articleNmae], [lsid2, articleName], [lsid3, articleName]]
-}
-
-sub _doRelationshipsQuery {
- my ( $self, $ontology, $term, $relationship, $direction ) = @_;
- $CONFIG ||= MOBY::Config->new; # exported by Config.pm
- my $datasource = "moby$ontology"; # like mobyobject, or mobyservice
- my $adaptor = $CONFIG->getDataAdaptor( datasource => $datasource );
- my $defs;
- # query returns a reference to an array containing array references
- $defs = $adaptor->get_relationship(direction => $direction,
- ontology => $ontology,
- term => $term,
- relationship => $relationship);
- # a very long piece of SQL statements have been refactored into Moby::Adaptor::moby::queryapi::mysql.pm
- return $defs;
-}
-
-=head2 setURI
-
-=cut
-
-sub setURI {
- my ( $self, $id ) = @_;
- my $URI;
-
- # $id = lc($id);
- if ( $self->ontology eq 'object' ) {
- $URI = "urn:lsid:biomoby.org:objectclass:$id";
- } elsif ( $self->ontology eq 'namespace' ) {
- $URI = "urn:lsid:biomoby.org:namespacetype:$id";
- } elsif ( $self->ontology eq 'service' ) {
- $URI = "urn:lsid:biomoby.org:servicetype:$id";
- } elsif ( $self->ontology eq 'relationship' ) {
- $URI = "urn:lsid:biomoby.org:relationshiptype:$id";
- } else {
- $URI = 0;
- }
- return $URI;
-}
-
-=head2 traverseDAG
-
-=cut
-
-sub traverseDAG {
- my ( $self, $term, $direction ) = @_;
- my $ontology = $self->ontology;
- return {} unless $ontology;
- return {} unless $term;
- $direction = "root" unless ($direction);
- return {} unless ( ( $direction eq 'root' ) || ( $direction eq 'leaves' ) );
- 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 ); # get teh types of relationships for the object/service ontology
- return {} unless $relhash;
- my @rels = keys %{$relhash}; #@rels is the list of relationship types for that ontology
- my %relationships;
- foreach my $relationship (@rels) {
- my %IDS;
- 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_article ( @{ $lsids->{$relationship} } )
- { # go through the related terms
- my ($lsid, $article) = @{$lsid_article};
- $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
- }
- return \%relationships;
-}
-
-sub _LOG {
- return unless $debug;
-
- #print join "\n", @_;
- #print "\n---\n";
- #return;
- open LOG, ">>/tmp/OntologyServer.txt" or die "can't open logfile $!\n";
- print LOG join "\n", @_;
- print LOG "\n---\n";
- close LOG;
-}
-sub DESTROY { }
-
-sub AUTOLOAD {
- no strict "refs";
- my ( $self, $newval ) = @_;
- $AUTOLOAD =~ /.*::(\w+)/;
- my $attr = $1;
- if ( $self->_accessible( $attr, 'write' ) ) {
- *{$AUTOLOAD} = sub {
- if ( defined $_[1] ) { $_[0]->{$attr} = $_[1] }
- return $_[0]->{$attr};
- }; ### end of created subroutine
-### this is called first time only
- if ( defined $newval ) {
- $self->{$attr} = $newval;
- }
- return $self->{$attr};
- } elsif ( $self->_accessible( $attr, 'read' ) ) {
- *{$AUTOLOAD} = sub {
- return $_[0]->{$attr};
- }; ### end of created subroutine
- return $self->{$attr};
- }
-
- # Must have been a mistake then...
- croak "No such method: $AUTOLOAD";
-}
-1;
+#$Id$
+# this module needs to talk to the 'real' ontology
+# server as well as the MOBY Central database
+# in order to ensure that they are both in sync
+
+=head1 NAME
+
+MOBY::OntologyServer - A way for MOBY Central to query the
+object, service, namespace, and relationship ontologies
+
+=cut
+
+=head1 SYNOPSIS
+
+ use MOBY::OntologyServer;
+ my $OS = MOBY::OntologyServer->new(ontology => "object");
+
+ my ($success, $message, $existingURI) = $OS->objectExists(term => "Object");
+
+ if ($success){
+ print "object exists and it has the LSID $existingURI\n";
+ } else {
+ print "object does not exist; additional message from server: $message\n";
+ }
+
+
+=cut
+
+=head1 DESCRIPTION
+
+Swappable interface to ontologies. It should deal with LSID's 100%
+of the time, and also deal with MOBY-specific common names for objects,
+services, namespaces, and relationship types.
+
+
+
+=head1 AUTHORS
+
+Mark Wilkinson (markw at illuminae.com)
+
+BioMOBY Project: http://www.biomoby.org
+
+
+=cut
+
+=head1 METHODS
+
+
+=head2 new
+
+ Title : new
+ Usage : my $OS = MOBY::OntologyServer->new(%args)
+ Function :
+ Returns : MOBY::OntologyServer object
+ Args : ontology => [object || service || namespace || relationship]
+ database => mysql databasename that holds the ontologies
+ host => mysql hostname
+ username => mysql username
+ password => mysql password
+ port => mysql port
+ dbh => pre-existing database handle to a mysql database
+
+=cut
+
+package MOBY::OntologyServer;
+use strict;
+use Carp;
+use vars qw($AUTOLOAD);
+use DBI;
+use DBD::mysql;
+use MOBY::Config;
+my $debug = 0;
+{
+
+ #Encapsulated class data
+ #___________________________________________________________
+ #ATTRIBUTES
+ my %_attr_data = # DEFAULT ACCESSIBILITY
+ (
+ ontology => [ undef, 'read/write' ],
+ database => [ undef, 'read/write' ],
+ host => [ undef, 'read/write' ],
+ username => [ undef, 'read/write' ],
+ password => [ undef, 'read/write' ],
+ port => [ undef, 'read/write' ],
+ dbh => [ undef, 'read/write' ],
+ );
+
+ #_____________________________________________________________
+ # METHODS, to operate on encapsulated class data
+ # Is a specified object attribute accessible in a given mode
+ sub _accessible {
+ my ( $self, $attr, $mode ) = @_;
+ $_attr_data{$attr}[1] =~ /$mode/;
+ }
+
+ # Classwide default value for a specified object attribute
+ sub _default_for {
+ my ( $self, $attr ) = @_;
+ $_attr_data{$attr}[0];
+ }
+
+ # List of names of all specified object attributes
+ sub _standard_keys {
+ keys %_attr_data;
+ }
+}
+
+sub new {
+ my ( $caller, %args ) = @_;
+ my $caller_is_obj = ref($caller);
+ my $class = $caller_is_obj || $caller;
+ my $self = bless {}, $class;
+ foreach my $attrname ( $self->_standard_keys ) {
+ if ( exists $args{$attrname} && defined $args{$attrname} ) {
+ $self->{$attrname} = $args{$attrname};
+ } elsif ($caller_is_obj) {
+ $self->{$attrname} = $caller->{$attrname};
+ } else {
+ $self->{$attrname} = $self->_default_for($attrname);
+ }
+ }
+ $self->ontology eq 'object' && $self->database('mobyobject');
+ $self->ontology eq 'namespace' && $self->database('mobynamespace');
+ $self->ontology eq 'service' && $self->database('mobyservice');
+ $self->ontology eq 'relationship' && $self->database('mobyrelationship');
+
+ #print STDERR "\n\nCONFIG object is $CONFIG\n\n";
+ $CONFIG ||= MOBY::Config->new;
+
+#print STDERR "got username ",($CONFIG->{mobycentral}->{username})," for mobycentral\n";
+ $self->username( $CONFIG->{ $self->database }->{username} )
+ unless $self->username;
+ $self->password( $CONFIG->{ $self->database }->{password} )
+ unless $self->password;
+ $self->port( $CONFIG->{ $self->database }->{port} ) unless $self->port;
+ $self->host( $CONFIG->{ $self->database }->{url} ) unless $self->host;
+ my $host = $self->host ? $self->host : $ENV{MOBY_CENTRAL_URL};
+ chomp $host;
+ my $username =
+ $self->username ? $self->username : $ENV{MOBY_CENTRAL_DBUSER};
+ chomp $username;
+ my $password =
+ $self->password ? $self->password : $ENV{MOBY_CENTRAL_DBPASS};
+ chomp $password if $password;
+ $password =~ s/\s//g if $password;
+ my $port = $self->port ? $self->port : $ENV{MOBY_CENTRAL_DBPORT};
+ chomp $port;
+ my ($dsn) =
+ "DBI:mysql:"
+ . ( $CONFIG->{ $self->database }->{dbname} ) . ":"
+ . ($host) . ":"
+ . ($port);
+
+ #print STDERR "\n\nDSN was $dsn\n\n";
+ my $dbh;
+
+# $debug && &_LOG("connecting to db with params ",$self->database, $self->username, $self->password,"\n");
+ if ( defined $password ) {
+ $dbh = DBI->connect( $dsn, $username, $password, { RaiseError => 1 } )
+ or die "can't connect to database";
+ } else {
+ $dbh = DBI->connect( $dsn, $username, undef, { RaiseError => 1 } )
+ or die "can't connect to database";
+ }
+
+ # $debug && &_LOG("CONNECTED!\n");
+ if ($dbh) {
+ $self->dbh($dbh);
+ return $self;
+ } else {
+ return undef;
+ }
+}
+
+=head2 objectExists
+
+ moby:newterm will return (0, $message, $MOBYLSID)
+ newterm will return (0, $message, $MOBYLSID
+ oldterm will return (1, $message, undef)
+ newLSID will return (0, $desc, $lsid)
+=cut
+
+sub objectExists {
+ my ( $self, %args ) = @_;
+
+ $CONFIG ||= MOBY::Config->new; # exported by Config.pm
+ my $adaptor = $CONFIG->getDataAdaptor( datasource => 'mobyobject' );
+
+ my $term = $args{term};
+ $term =~ s/^moby://; # if the term is namespaced, then remove that
+ my $sth;
+ return ( 0, "WRONG ONTOLOGY!", '' ) unless ( $self->ontology eq 'object' );
+
+ my $result;
+
+ $result = $adaptor->query_object(type => $term);
+
+ my $row = shift(@$result);
+ my $lsid = $row->{object_lsid};
+ my $type = $row->{object_type};
+ my $desc = $row->{description};
+ my $auth = $row->{authority};
+ my $email = $row->{contact_email};
+
+ if ($lsid)
+ { # if it is in there, then it has been discovered regardless of being foreign or not
+ return ( 1, $desc, $lsid );
+ } elsif ( _isForeignLSID($term) )
+ { # if not in our ontology, but is a foreign LSID, then pass it back verbatim
+ return (
+ 0,
+"LSID $term does not exist in the biomoby.org Object Class system\n",
+ $term
+ );
+ } else { # under all other circumstances (i.e. not a term, or a non-existent biomoby LSID) then fail
+ return (
+ 0,
+"Object type $term does not exist in the biomoby.org Object Class system\n",
+ ''
+ );
+ }
+}
+
+sub _isMOBYLSID {
+ my ($lsid) = @_;
+ return 1 if $lsid =~ /^urn\:lsid\:biomoby.org/;
+ return 0;
+}
+
+sub _isForeignLSID {
+ my ($lsid) = @_;
+ return 0 if $lsid =~ /^urn\:lsid\:biomoby.org/;
+ return 1;
+}
+
+=head2 createObject
+
+=cut
+
+sub createObject {
+ my ( $self, %args ) = @_;
+ $CONFIG ||= MOBY::Config->new; # exported by Config.pm
+ my $adaptor = $CONFIG->getDataAdaptor( datasource => 'mobyobject' );
+ return ( 0, "WRONG ONTOLOGY!", '' ) unless ( $self->ontology eq 'object' );
+ return ( 0, "requires a object type node", '' ) unless ( $args{node} );
+ return ( 0, "requires an authURI ", '' ) unless ( $args{authority} );
+ return ( 0, "requires a contact email address", '' )
+ unless ( $args{contact_email} );
+ return ( 0, "requires a object description", '' )
+ unless ( $args{description} );
+ my $term = $args{node};
+
+ my $LSID =
+ ( $args{'node'} =~ /urn\:lsid/ )
+ ? $args{'node'}
+ : $self->setURI( $args{'node'} );
+ unless ($LSID) { return ( 0, "Failed during creation of an LSID", '' ) }
+ my $result;
+ $result = $adaptor->query_object(type => $term);
+ my $row = shift(@$result);
+ my $lsid = $row->{object_lsid};
+ my $type = $row->{object_type};
+ my $desc = $row->{description};
+ my $auth = $row->{authority};
+ my $email = $row->{contact_email};
+
+ 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;
+ $args{authority} =~ s/^\s+(.*?)\s+$/$1/s;
+
+ my $insertid = $adaptor->insert_object(object_type => $args{'node'},
+ object_lsid => $LSID,
+ description => $args{'description'},
+ authority => $args{'authority'},
+ contact_email => $args{'contact_email'});
+ unless ( $insertid ) {
+ return ( 0, "Object creation failed for unknown reasons", '' );
+ }
+ return ( 1, "Object creation succeeded", $LSID );
+}
+
+=head2 retrieveObject
+
+=cut
+
+sub retrieveObject {
+ my ( $self, %args ) = @_;
+ $CONFIG ||= MOBY::Config->new; # exported by Config.pm
+ my $adaptor = $CONFIG->getDataAdaptor( datasource => 'mobyobject' );
+ my $term = $args{'type'};
+ $term ||=$args{'node'};
+
+ return ( 0, "WRONG ONTOLOGY!", '' ) unless ( $self->ontology eq 'object' );
+ return ( 0, "requires a object type node as an argument", '' )
+ unless ( $term );
+ my $LSID =
+ ( $term =~ /urn\:lsid/ )
+ ? $term
+ : $self->getObjectURI($term);
+ unless ($LSID) { return ( 0, "Failed during creation of an LSID", '' ) }
+ my $result = $adaptor->query_object(type => $LSID);
+ my $row = shift(@$result);
+# my $id = $row->{object_id};
+ my $type = $row->{object_type};
+ my $lsid = $row->{object_lsid};
+ my $desc = $row->{description};
+ my $auth = $row->{authority};
+ my $contact = $row->{contact_email};
+
+ unless ($lsid) { return ( 0, "Object doesn't exist in ontology", "" ) }
+
+ # my $OS = MOBY::OntologyServer->new(ontology => "relationship");
+
+ $result = $adaptor->get_object_relationships(type => $lsid);
+ my %rel;
+ foreach my $row (@$result)
+ {
+ my $relationship_type = $row->{relationship_type};
+ my $objectlsid = $row->{object_lsid};
+ my $article = $row->{object2_articlename};
+ my $contact = $row->{contact_email};
+ my $def = $row->{definition};
+ my $auth = $row->{authority};
+ my $type = $row->{object_type};
+
+ push @{ $rel{$relationship_type} }, [ $objectlsid, $article, $type, $def, $auth, $contact ];
+ }
+ return {
+ objectType => $type,
+ objectLSID => $lsid,
+ description => $desc,
+ contactEmail => $contact,
+ authURI => $auth,
+ Relationships => \%rel
+ };
+}
+
+=head2 deprecateObject
+
+=cut
+
+sub deprecateObject {
+ my ( $self, %args ) = @_;
+ $CONFIG ||= MOBY::Config->new; # exported by Config.pm
+ my $adaptor = $CONFIG->getDataAdaptor( datasource => 'mobyobject' );
+
+ return ( 0, "WRONG ONTOLOGY", '' ) unless ( $self->ontology eq 'object' );
+ my $term = $args{term};
+
+# if ($term =~ /^urn:lsid/ && !($term =~ /^urn:lsid:biomoby.org:objectclass/)){
+# return (0, "can't delete from external ontology", $term);
+# }
+ my $LSID;
+ unless ( $term =~ /urn\:lsid/ ) { $LSID = $self->getObjectURI($term) } else { $LSID = $term }
+ return ( 0, q{Object type $term cannot be resolved to an LSID}, "" )
+ unless $LSID;
+
+ my $result = $adaptor->query_object(type => $LSID);
+ my $row = shift(@$result);
+ my $id = $row->{object_id};
+ my $lsid = $row->{object_lsid};
+
+ # object1_id ISA object2_id?
+ my $isa = $adaptor->query_object_term2term(type => $lsid);
+ my $isas = shift @$isa;
+ if ( $isas->{object1_id}) {
+ return ( 0,
+ qq{Object type $term has object dependencies in the ontology},
+ $lsid );
+ }
+
+ my ($err, $errstr) = $adaptor->delete_object(type => $lsid);
+ if ( $err ) {
+ return ( 0, "Delete from Object Class table failed: $errstr",
+ $lsid );
+ }
+ return ( 1, "Object $term Deleted", $lsid );
+}
+
+=head2 deleteObject
+
+=cut
+
+sub deleteObject {
+ my $self = shift;
+ $self->deprecateObject(@_);
+}
+
+=head2 relationshipExists
+
+=cut
+
+sub relationshipExists {
+
+ # term => $term
+ # ontology => $ontology
+ my ( $self, %args ) = @_;
+ $CONFIG ||= MOBY::Config->new; # exported by Config.pm
+ my $adaptor = $CONFIG->getDataAdaptor( datasource => 'mobyrelationship' );
+ return ( 0, "WRONG ONTOLOGY!", '' )
+ unless ( $self->ontology eq 'relationship' );
+ my $term = lc( $args{term} );
+ $term =~ s/^moby://; # if the term is namespaced, then remove that
+ my $ont = $args{ontology};
+ return ( 0, "requires both term and ontology arguments\n", '' )
+ unless ( defined($term) && defined($ont) );
+ my $result;
+ if ( $term =~ /^urn\:lsid/ ) {
+
+ $result = $adaptor->query_relationship(
+ type => $term,
+ ontology => $ont);
+
+ } else {
+
+ $result = $adaptor->query_relationship(type => $term, ontology => $ont);
+
+ }
+ my $row = shift(@$result);
+ my $lsid = $row->{relationship_lsid};
+ my $type = $row->{relationship_type};
+ my $desc = $row->{description};
+ my $auth = $row->{authority};
+ my $email = $row->{contact_email};
+ if ($lsid) {
+ return ( 1, $desc, $lsid, $type, $auth, $email );
+ } else {
+ return (
+ 0,"Relationship Type $term does not exist in the biomoby.org Relationship Type system\n",
+ '', '', '', ''
+ );
+ }
+}
+
+=head2 addObjectRelationship
+
+=cut
+
+sub addObjectRelationship {
+
+ # adds a relationship
+ #subject_node => $term,
+ #relationship => $reltype,
+ #object_node => $objectType,
+ #articleName => $articleName,
+ #authority => $auth,
+ #contact_email => $email
+ my ( $self, %args ) = @_;
+ $CONFIG ||= MOBY::Config->new; # exported by Config.pm
+ my $adaptor = $CONFIG->getDataAdaptor( datasource => 'mobyobject' );
+
+ return ( 0, "WRONG ONTOLOGY!", '' ) unless ( $self->ontology eq 'object' );
+
+ my $result = $adaptor->query_object(type => $args{subject_node});
+ my $row = shift(@$result);
+ my $subj_lsid = $row->{object_lsid};
+ return ( 0, qq{Object type $args{subject_node} does not exist in the ontology}, '' )
+ unless defined $subj_lsid;
+
+ $result = $adaptor->query_object(type => $args{object_node});
+ $row = shift(@$result);
+ my $obj_lsid = $row->{object_lsid};
+ return ( 0,qq{Object type $args{object_node} does not exist in the ontology},'' )
+ unless defined $obj_lsid;
+ my $isa = $adaptor->query_object_term2term(type => $subj_lsid);
+ my $isarow = shift @$isa;
+ if ( $isarow->{object_lsid} ) {
+ return (
+ 0,
+ qq{Object type $args{subject_node} has existing object dependencies in the ontology. It cannot be changed.},
+ $subj_lsid
+ );
+ }
+ my $OE = MOBY::OntologyServer->new( ontology => 'relationship' );
+ my ( $success, $desc, $rel_lsid ) = $OE->relationshipExists(
+ term => $args{relationship},
+ ontology => 'object' );
+ ($success) || return ( 0,
+ qq{Relationship $args{relationship} does not exist in the ontology},
+ '' );
+
+ # need to ensure that identical article names dont' end up at the same level
+ my $articleNameInvalid = &_testIdenticalArticleName(term => $subj_lsid, articleName => $args{articleName});
+ return (0, "Object will have conflicting articleName ".($args{articleName}), '') if $articleNameInvalid;
+
+ my $insertid = $adaptor->insert_object_term2term(relationship_type => $rel_lsid,
+ object1_type => $subj_lsid,
+ object2_type => $obj_lsid,
+ object2_articlename => $args{articleName});
+
+
+ if ($insertid ) {
+ return ( 1, "Object relationsihp created successfully", '' );
+ } else {
+ return ( 0, "Object relationship creation failed for unknown reasons",
+ '' );
+ }
+}
+
+sub _testIdenticalArticleName {
+ my (%args)= @_;
+ my $term = $args{term};
+ my $articleName = $args{articleName};
+ my $foundCommonArticleNameFlag = 0;
+ # need to first traverse down the ISA pathway to root
+ # then for each ISA test the hAS and HASA's for their articlenames and see if they are the same
+ # case insensitive?
+ my $OS = MOBY::OntologyServer->new(ontology => 'object');
+ my $OSrel = MOBY::OntologyServer->new(ontology => 'relationship');
+ my ($exists1, $desc, $isalsid) = $OSrel->relationshipExists(term => 'isa', ontology => 'object');
+ my ($exists2, $desc2, $hasalsid) = $OSrel->relationshipExists(term => 'hasa', ontology => 'object');
+ my ($exists3, $desc3, $haslsid) = $OSrel->relationshipExists(term => 'has', ontology => 'object');
+
+ return 1 unless ($exists1 && $exists2 && $exists3); # this is bad, since it returns boolean suggesting that it found a common articlename rather than finding that a given relationship doesn't exist, but... hey....
+ # check the hasa relationships for common articleName
+ $foundCommonArticleNameFlag += _compareArticleNames(OS => $OS, type => $args{term}, relationship => $hasalsid, targetArticleName => $articleName);
+ # check the has relationships for common articleName
+ $foundCommonArticleNameFlag += _compareArticleNames(OS => $OS, type => $args{term}, relationship => $haslsid, targetArticleName => $articleName);
+
+ # now get all of its inherited parents
+ my $relationships = $OS->Relationships(
+ ontology => 'object',
+ term => $args{term},
+ 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;
+ # check the hasa relationships for common articleName
+ $foundCommonArticleNameFlag += _compareArticleNames(OS => $OS, type => $what_it_is, relationship => $hasalsid, targetArticleName => $articleName);
+ # check the has relationships for common articleName
+ $foundCommonArticleNameFlag += _compareArticleNames(OS => $OS, type => $what_it_is, relationship => $haslsid, targetArticleName => $articleName);
+ }
+ return $foundCommonArticleNameFlag;
+}
+
+sub _compareArticleNames {
+ my (%args) = @_;
+ my $OS = $args{OS};
+ my $what_it_is = $args{type};
+ my $lsid = $args{relationship};
+ my $targetArticleName = $args{targetArticleName};
+ my $foundCommonArticleNameFlag = 0;
+ my $contents = $OS->Relationships(
+ ontology => 'object',
+ term => $what_it_is,
+ relationship => $lsid,
+ direction => 'root',
+ );
+ if ($contents){
+ #$hasarelationships{relationship} = [[lsid1,articleNmae], [lsid2, articleName], [lsid3, articleName]]
+ my ($content) = keys(%$contents);
+ if ($contents->{$content}){
+ my @CONTENTlist = @{$contents->{$content}};
+ foreach my $CONTAINED(@CONTENTlist){
+ $foundCommonArticleNameFlag = 1 if ($CONTAINED->[1] eq $targetArticleName); #->[1] is the articleName field
+ }
+ }
+ }
+ return $foundCommonArticleNameFlag;
+}
+
+=head2 addServiceRelationship
+
+=cut
+
+sub addServiceRelationship {
+
+ # adds an ISA relationship
+ # fail if another object is in relation to this objevt
+ #subject_node => $term,
+ #relationship => $relationship,
+ #predicate_node => $pred
+ #authority => $auth,
+ #contact_email => $email);
+ my ( $self, %args ) = @_;
+ $CONFIG ||= MOBY::Config->new; # exported by Config.pm
+ my $adaptor = $CONFIG->getDataAdaptor( datasource => 'mobyservice' );
+
+ return ( 0, "WRONG ONTOLOGY!", '' ) unless ( $self->ontology eq 'service' );
+
+ my $result = $adaptor->query_service(type => $args{subject_node});
+ my $row = shift(@$result);
+ my $sbj_lsid = $row->{service_lsid};
+
+ return (0,
+ qq{Service type $args{subject_node} has object dependencies in the ontology. It can not be changed},
+ $sbj_lsid
+ ) unless defined $sbj_lsid;
+
+ my $isa = $adaptor->query_service_term2term(service2_id => $sbj_lsid);
+ my $isarow = shift @$isa;
+ if ( $isarow->{service_lsid} ) {
+ return (
+ 0,
+ qq{Service type $args{subject_node} has object dependencies in the ontology. It can not be changed},
+ $sbj_lsid
+ );
+ }
+ $result = $adaptor->query_service(type => $args{object_node});
+ $row = shift(@$result);
+ my $obj_lsid = $row->{service_lsid};
+ # get ID of the related service
+
+ defined $obj_lsid
+ || return ( 0,
+ qq{Service $args{object_node} does not exist in the service ontology},
+ '' );
+ my $OE = MOBY::OntologyServer->new( ontology => 'relationship' );
+ my ( $success, $desc, $rel_lsid ) = $OE->relationshipExists(
+ term => $args{relationship},
+ ontology => 'service' );
+ ($success)
+ || return ( 0,
+ qq{Relationship $args{relationship} does not exist in the ontology},
+ '' );
+
+ my $insertid = $adaptor->insert_service_term2term(relationship_type => $rel_lsid,
+ service1_type => $sbj_lsid,
+ service2_type => $obj_lsid);
+ if ( defined($insertid)) {
+ return ( 1, "Service relationship created successfully", '' );
+ } else {
+ return ( 0, "Service relationship creation failed for unknown reasons",
+ '' );
+ }
+}
+
+=head2 serviceExists
+
+=cut
+
+sub serviceExists {
+ my ( $self, %args ) = @_;
+ $CONFIG ||= MOBY::Config->new; # exported by Config.pm
+ my $adaptor = $CONFIG->getDataAdaptor( datasource => 'mobyservice' );
+
+ return ( 0, "WRONG ONTOLOGY!", '' ) unless ( $self->ontology eq 'service' );
+ my $term = $args{term};
+ $term =~ s/^moby://; # if the term is namespaced, then remove that
+ if ( $term =~ /^urn:lsid/
+ && !( $term =~ /^urn:lsid:biomoby.org:servicetype/ ) )
+ {
+ return ( 1, "external ontology", $term );
+ }
+ my $result;
+ $result = $adaptor->query_service(type => $term);
+ my $row = shift(@$result);
+ my $id = $row->{service_id};
+ my $type = $row->{service_type};
+ my $lsid = $row->{service_lsid};
+ my $desc = $row->{description};
+ my $auth = $row->{authority};
+ my $email = $row->{contact_email};
+
+ if ($id) {
+ return ( 1, $desc, $lsid );
+ } else {
+ return (
+ 0,
+"Service Type $term does not exist in the biomoby.org Service Type ontology\n",
+ ''
+ );
+ }
+}
+
+=head2 createServiceType
+
+=cut
+
+sub createServiceType {
+ my ( $self, %args ) = @_;
+ $CONFIG ||= MOBY::Config->new; # exported by Config.pm
+ my $adaptor = $CONFIG->getDataAdaptor( datasource => 'mobyservice' );
+
+ #node => $term,
+ #descrioption => $desc,
+ #authority => $auth,
+ #contact_email => $email);
+ return ( 0, "WRONG ONTOLOGY!", '' ) unless ( $self->ontology eq 'service' );
+ return ( 0, "requires a object type node", '' ) unless ( $args{node} );
+ return ( 0, "requires an authURI ", '' ) unless ( $args{authority} );
+ 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:servicetype/ ) )
+ { # 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", '' ) }
+
+ my $insertid = $adaptor->insert_service(service_type => $args{'node'},
+ service_lsid => $LSID,
+ description => $args{'description'},
+ authority => $args{'authority'},
+ contact_email => $args{'contact_email'});
+
+ unless ( $insertid ) {
+ return ( 0, "Service creation failed for unknown reasons", '' );
+ }
+ return ( 1, "Service creation succeeded", $LSID );
+}
+
+=head2 deleteServiceType
+
+=cut
+
+sub deleteServiceType {
+ my ( $self, %args ) = @_;
+ $CONFIG ||= MOBY::Config->new; # exported by Config.pm
+ my $adaptor = $CONFIG->getDataAdaptor( datasource => 'mobyservice' );
+
+ return ( 0, "WRONG ONTOLOGY!", '' ) unless ( $self->ontology eq 'service' );
+ my $term = $args{term};
+ if ( $term =~ /^urn:lsid/
+ && !( $term =~ /^urn:lsid:biomoby.org:servicetype/ ) )
+ {
+ return ( 0, "can't delete from external ontology", $term );
+ }
+ my $LSID;
+ unless ( $term =~ /^urn:lsid:biomoby.org:servicetype/ ) {
+ $LSID = $self->getServiceURI($term);
+ } else {
+ $LSID = $term;
+ }
+ return (
+ 0, q{Service type $term cannot be resolved to an LSID in the MOBY ontologies},""
+ ) unless $LSID;
+
+ my $result = $adaptor->query_service(type => $LSID);
+ my $row = shift(@$result);
+ my $lsid = $row->{service_lsid};
+
+ if ( !defined $lsid ) {
+ return ( 0, q{Service type $term does not exist in the ontology},
+ $lsid );
+ }
+
+ # service1_id ISA service2_id?
+ my $isa = $adaptor->query_service_term2term(type => $lsid);
+ my $isas = shift(@$isa);
+
+ if ( $isas->{service1_id} ) {
+ return ( 0, qq{Service type $term has dependencies in the ontology},
+ $lsid );
+ }
+ my ($err, $errstr) = $adaptor->delete_service(type => $lsid);
+
+ if ( $err ) {
+ return ( 0, "Delete from Service Type table failed: $errstr",
+ $lsid );
+ }
+
+ return ( 1, "Service Type $term Deleted", $lsid );
+}
+
+=head2 namespaceExists
+
+=cut
+
+sub namespaceExists {
+ my ( $self, %args ) = @_;
+ $CONFIG ||= MOBY::Config->new; # exported by Config.pm
+ my $adaptor = $CONFIG->getDataAdaptor( datasource => 'mobynamespace' );
+
+ return ( 0, "WRONG ONTOLOGY!", '' )
+ unless ( $self->ontology eq 'namespace' );
+ my $term = $args{term};
+ $term =~ s/^moby://; # if the term is namespaced, then remove that
+ if ( $term =~ /^urn:lsid/
+ && !( $term =~ /^urn:lsid:biomoby.org:namespacetype/ ) )
+ {
+ return ( 1, "external ontology", $term );
+ }
+ my $result;
+ $result = $adaptor->query_namespace(type => $term);
+ my $row = shift(@$result);
+ my $id = $row->{namespace_id};
+ my $type = $row->{namespace_type};
+ my $lsid = $row->{namespace_lsid};
+ my $desc = $row->{description};
+ my $auth = $row->{authority};
+ my $email = $row->{contact_email};
+
+ if ($id) {
+ return ( 1, $desc, $lsid );
+ } else {
+ return (
+ 0,
+"Namespace Type $term does not exist in the biomoby.org Namespace Type ontology\n",
+ ''
+ );
+ }
+}
+
+=head2 createNamespace
+
+=cut
+
+sub createNamespace {
+ my ( $self, %args ) = @_;
+ $CONFIG ||= MOBY::Config->new; # exported by Config.pm
+ my $adaptor = $CONFIG->getDataAdaptor( datasource => 'mobynamespace' );
+ #node => $term,
+ #descrioption => $desc,
+ #authority => $auth,
+ #contact_email => $email);
+ return ( 0, "WRONG ONTOLOGY!", '' )
+ unless ( $self->ontology eq 'namespace' );
+ return ( 0, "requires a namespace type node", '' ) unless ( $args{node} );
+ return ( 0, "requires an authURI ", '' ) unless ( $args{authority} );
+ 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:namespacetype/ ) )
+ { # 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", '' ) }
+
+ my $insertid = $adaptor->insert_namespace(namespace_type => $args{'node'},
+ namespace_lsid => $LSID,
+ description => $args{'description'},
+ authority => $args{'authority'},
+ contact_email => $args{'contact_email'});
+
+ unless ( $insertid ) {
+ return ( 0, "Namespace creation failed for unknown reasons", '' );
+ }
+ return ( 1, "Namespace creation succeeded", $LSID );
+}
+
+=head2 deleteNamespace
+
+=cut
+
+sub deleteNamespace {
+ my ( $self, %args ) = @_;
+ $CONFIG ||= MOBY::Config->new; # exported by Config.pm
+ my $adaptor = $CONFIG->getDataAdaptor( datasource => 'mobynamespace' );
+ return ( 0, "WRONG ONTOLOGY!", '' )
+ unless ( $self->ontology eq 'namespace' );
+ my $term = $args{term};
+ my $LSID;
+ unless ( $term =~ /urn\:lsid/ ) { $LSID = $self->getNamespaceURI($term) } else { $LSID = $term }
+ return ( 0, q{Namespace type $term cannot be resolved to an LSID}, "" )
+ unless $LSID;
+ if ( $term =~ /^urn:lsid/
+ && !( $term =~ /^urn:lsid:biomoby.org:namespacetype/ ) )
+ {
+ return ( 0, "cannot delete a term from an external ontology", $term );
+ }
+
+ my $result = $adaptor->query_namespace(type => $LSID);
+ my $row = shift(@$result);
+ my $lsid = $row->{namespace_lsid};
+
+ unless ($lsid) {
+ return ( 0, q{Namespace type $term does not exist in the ontology},
+ $lsid );
+ }
+
+ # service1_id ISA service2_id?
+ my $isa = $adaptor->query_namespace_term2term(type => $lsid);
+ my $isas = shift @$isa;
+
+ if ($isas->{namespace1_id} ) {
+ return ( 0, qq{Namespace type $term has dependencies in the ontology},
+ $lsid );
+ }
+
+ my ($err, $errstr) = $adaptor->delete_namespace(type => $lsid);
+
+ if ( $err ) {
+ return ( 0, "Delete from namespace table failed: $errstr",
+ $lsid );
+ }
+
+ #($err, $errstr) = $adaptor->delete_namespace_term2term(namespace1_id => $lsid);
+ #
+ #if ( $err ) {
+ # return (
+ # 0,
+ # "Delete from namespace term2term table failed: $errstr",
+ # $lsid
+ # );
+ #}
+ return ( 1, "Namespace Type $term Deleted", $lsid );
+}
+
+=head2 retrieveAllServiceTypes
+
+=cut
+
+sub retrieveAllServiceTypes {
+ my ($self) = @_;
+ $CONFIG ||= MOBY::Config->new; # exported by Config.pm
+ my $adaptor = $CONFIG->getDataAdaptor( datasource => 'mobyservice' );
+ my $types = $adaptor->query_service();
+
+ my %response;
+ foreach (@$types) {
+ $response{ $_->{service_type} } = [$_->{description}, $_->{service_lsid}]; #COMMENT/REMOVE
+ #$response{ $_->{service_type} } = [$_->{description}, $_->{service_lsid}, $_->{contact_email}, $_->{authority}]; #UNCOMMENT
+ }
+ return \%response;
+}
+
+=head2 retrieveAllNamespaceTypes
+
+=cut
+
+sub retrieveAllNamespaceTypes {
+ my ($self) = @_;
+ $CONFIG ||= MOBY::Config->new; # exported by Config.pm
+ my $adaptor = $CONFIG->getDataAdaptor( datasource => 'mobynamespace' );
+ my $types = $adaptor->query_namespace();
+
+ my %response;
+ foreach (@$types) {
+ $response{ $_->{namespace_type} } = [$_->{description}, $_->{namespace_lsid}, $_->{authority}, $_->{contact_email}];
+ }
+ return \%response;
+}
+
+=head2 retrieveAllObjectClasses
+
+=cut
+
+sub retrieveAllObjectClasses {
+ my ($self) = @_;
+ $CONFIG ||= MOBY::Config->new; # exported by Config.pm
+ my $adaptor = $CONFIG->getDataAdaptor( datasource => 'mobyobject' );
+ my $types = $adaptor->query_object();
+
+ my %response;
+ foreach (@$types) {
+ $response{ $_->{object_type} } = [$_->{description}, $_->{object_lsid}];
+ }
+ return \%response;
+}
+*retrieveAllObjectTypes = \&retrieveAllObjectClasses;
+*retrieveAllObjectTypes = \&retrieveAllObjectClasses;
+
+=head2 getObjectCommonName
+
+=cut
+
+sub getObjectCommonName {
+ my ( $self, $URI ) = @_;
+ $CONFIG ||= MOBY::Config->new; # exported by Config.pm
+ my $adaptor = $CONFIG->getDataAdaptor( datasource => 'mobyobject' );
+ return undef unless $URI =~ /urn\:lsid/;
+ my $result = $adaptor->query_object(type => $URI);
+ my $row = shift(@$result);
+ my $name = $row->{object_type};
+
+ return $name ? $name : $URI;
+}
+
+=head2 getNamespaceCommonName
+
+=cut
+
+sub getNamespaceCommonName {
+ my ( $self, $URI ) = @_;
+ $CONFIG ||= MOBY::Config->new; # exported by Config.pm
+ my $adaptor = $CONFIG->getDataAdaptor( datasource => 'mobynamespace' );
+ return undef unless $URI =~ /urn\:lsid/;
+ my $result = $adaptor->query_namespace(type => $URI);
+ my $row = shift(@$result);
+ my $name = $row->{namespace_type};
+
+ return $name ? $name : $URI;
+}
+
+=head2 getServiceCommonName
+
+=cut
+
+sub getServiceCommonName {
+ my ( $self, $URI ) = @_;
+ $CONFIG ||= MOBY::Config->new; # exported by Config.pm
+ my $adaptor = $CONFIG->getDataAdaptor( datasource => 'mobyservice' );
+ return undef unless $URI =~ /urn\:lsid/;
+ my $result = $adaptor->query_service(type => $URI);
+ my $row = shift(@$result);
+ my $name = $row->{service_type};
+
+ return $name ? $name : $URI;
+}
+
+=head2 getServiceURI
+
+=cut
+
+sub getServiceURI {
+ my ( $self, $term ) = @_;
+ $CONFIG ||= MOBY::Config->new; # exported by Config.pm
+ my $adaptor = $CONFIG->getDataAdaptor( datasource => 'mobyservice' );
+ return $term if $term =~ /urn\:lsid/;
+
+ my $result = $adaptor->query_service(type => $term);
+ my $row = shift(@$result);
+ my $id = $row->{service_lsid};
+
+ return $id;
+}
+
+=head2 getObjectURI
+
+=cut
+
+sub getObjectURI {
+ my ( $self, $term ) = @_;
+ $CONFIG ||= MOBY::Config->new; # exported by Config.pm
+ my $adaptor = $CONFIG->getDataAdaptor( datasource => 'mobyobject' );
+ return $term if $term =~ /urn\:lsid/;
+
+ my $result = $adaptor->query_object(type => $term);
+ my $row = shift(@$result);
+ my $id = $row->{object_lsid};
+
+ return $id;
+}
+
+=head2 getNamespaceURI
+
+=cut
+
+sub getNamespaceURI {
+ my ( $self, $term ) = @_;
+ $CONFIG ||= MOBY::Config->new; # exported by Config.pm
+ my $adaptor = $CONFIG->getDataAdaptor( datasource => 'mobynamespace' );
+
+ return $term if $term =~ /urn\:lsid/;
+
+ my $result = $adaptor->query_namespace(type => $term);
+ my $row = shift(@$result);
+ my $id = $row->{namespace_lsid};
+
+ return $id;
+}
+
+=head2 getRelationshipURI
+
+consumes ontology (object/service)
+consumes relationship term as term or LSID
+
+=cut
+
+sub getRelationshipURI {
+ my ( $self, $ontology, $term ) = @_;
+ $CONFIG ||= MOBY::Config->new; # exported by Config.pm
+ my $adaptor = $CONFIG->getDataAdaptor( datasource => 'mobyrelationship' );
+
+ return $term if $term =~ /urn\:lsid/;
+
+ my $result = $adaptor->query_relationship(type => $term, ontology => $ontology);
+ my $row = shift(@$result);
+ my $id = $row->{relationship_lsid};
+
+ return $id;
+}
+
+=head2 getRelationshipTypes
+
+=cut
+
+sub getRelationshipTypes {
+ my ( $self, %args ) = @_;
+ $CONFIG ||= MOBY::Config->new; # exported by Config.pm
+ my $adaptor = $CONFIG->getDataAdaptor( datasource => 'mobyrelationship' );
+
+ my $ontology = $args{'ontology'};
+ my $OS = MOBY::OntologyServer->new( ontology => "relationship" );
+
+ my $defs = $adaptor->query_relationship(ontology => $ontology);
+
+ my %result;
+ foreach ( @$defs ) {
+ $result{ $_->{relationship_lsid} } = [ $_->{relationship_type}, $_->{authority}, $_->{description} ];
+ }
+ return \%result;
+}
+
+=head2 Relationships
+
+=cut
+
+sub Relationships {
+
+ # this entire subroutine assumes that there is NOT multiple parenting!!
+ my ( $self, %args ) = @_;
+ my $ontology = $args{ontology} ? $args{ontology} : $self->ontology;
+ my $term = $args{term};
+ my $relationship = $args{relationship};
+ my $direction = $args{direction} ? $args{direction} : 'root';
+ my $expand = $args{expand} ? 1 : 0;
+ return
+ unless ( $ontology
+ && $term
+ && ( ( $ontology eq 'service' ) || ( $ontology eq 'object' ) ) );
+
+ # convert $term into an LSID if it isn't already
+ if ( $ontology eq 'service' ) {
+ $term = $self->getServiceURI($term);
+ $relationship ||="isa";
+ my $OS = MOBY::OntologyServer->new(ontology => 'relationship');
+ $relationship = $OS->getRelationshipURI("service", $relationship);
+ } elsif ( $ontology eq 'object' ) {
+ $term = $self->getObjectURI($term);
+ $relationship ||="isa";
+ my $OS = MOBY::OntologyServer->new(ontology => 'relationship');
+ $relationship = $OS->getRelationshipURI("object", $relationship);
+ }
+ my %results;
+ while ( ( $term ne 'urn:lsid:biomoby.org:objectclass:Object' )
+ && ( $term ne 'urn:lsid:biomoby.org:servicetype:Service' ) )
+ {
+ my $defs = $self->_doRelationshipsQuery( $ontology, $term,
+ $relationship, $direction );
+ return {[]} unless $defs; # somethig has gone terribly wrong!
+ my $lsid;
+ my $rel;
+ my $articleName;
+ foreach ( @{$defs} ) {
+ $lsid = $_->[0];
+ $rel = $_->[1];
+ $articleName = $_->[2];
+ $articleName ||="";
+ $debug
+ && _LOG("\t\tADDING RELATIONSHIP $_ : $lsid to $rel\n");
+ push @{ $results{$rel} }, [$lsid, $articleName];
+ }
+ last unless ($expand);
+ last unless ( $direction eq "root" ); # if we aren't going to root, then be careful or we'll loop infnitely
+ $term = $lsid; # this entire subroutine assumes that there is NOT multiple parenting...
+ }
+ return \%results; #results(relationship} = [[lsid1,articleNmae], [lsid2, articleName], [lsid3, articleName]]
+}
+
+sub _doRelationshipsQuery {
+ my ( $self, $ontology, $term, $relationship, $direction ) = @_;
+ $CONFIG ||= MOBY::Config->new; # exported by Config.pm
+ my $datasource = "moby$ontology"; # like mobyobject, or mobyservice
+ my $adaptor = $CONFIG->getDataAdaptor( datasource => $datasource );
+ my $defs;
+ # query returns a reference to an array containing array references
+ $defs = $adaptor->get_relationship(direction => $direction,
+ ontology => $ontology,
+ term => $term,
+ relationship => $relationship);
+ # a very long piece of SQL statements have been refactored into Moby::Adaptor::moby::queryapi::mysql.pm
+ return $defs;
+}
+
+=head2 setURI
+
+=cut
+
+sub setURI {
+ my ( $self, $id ) = @_;
+ my $URI;
+
+ # $id = lc($id);
+ if ( $self->ontology eq 'object' ) {
+ $URI = "urn:lsid:biomoby.org:objectclass:$id";
+ } elsif ( $self->ontology eq 'namespace' ) {
+ $URI = "urn:lsid:biomoby.org:namespacetype:$id";
+ } elsif ( $self->ontology eq 'service' ) {
+ $URI = "urn:lsid:biomoby.org:servicetype:$id";
+ } elsif ( $self->ontology eq 'relationship' ) {
+ $URI = "urn:lsid:biomoby.org:relationshiptype:$id";
+ } else {
+ $URI = 0;
+ }
+ return $URI;
+}
+
+=head2 traverseDAG
+
+=cut
+
+sub traverseDAG {
+ my ( $self, $term, $direction ) = @_;
+ my $ontology = $self->ontology;
+ return {} unless $ontology;
+ return {} unless $term;
+ $direction = "root" unless ($direction);
+ return {} unless ( ( $direction eq 'root' ) || ( $direction eq 'leaves' ) );
+ 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 ); # get teh types of relationships for the object/service ontology
+ return {} unless $relhash;
+ my @rels = keys %{$relhash}; #@rels is the list of relationship types for that ontology
+ my %relationships;
+ foreach my $relationship (@rels) {
+ my %IDS;
+ 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_article ( @{ $lsids->{$relationship} } )
+ { # go through the related terms
+ my ($lsid, $article) = @{$lsid_article};
+ $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
+ }
+ return \%relationships;
+}
+
+sub _LOG {
+ return unless $debug;
+
+ #print join "\n", @_;
+ #print "\n---\n";
+ #return;
+ open LOG, ">>/tmp/OntologyServer.txt" or die "can't open logfile $!\n";
+ print LOG join "\n", @_;
+ print LOG "\n---\n";
+ close LOG;
+}
+sub DESTROY { }
+
+sub AUTOLOAD {
+ no strict "refs";
+ my ( $self, $newval ) = @_;
+ $AUTOLOAD =~ /.*::(\w+)/;
+ my $attr = $1;
+ if ( $self->_accessible( $attr, 'write' ) ) {
+ *{$AUTOLOAD} = sub {
+ if ( defined $_[1] ) { $_[0]->{$attr} = $_[1] }
+ return $_[0]->{$attr};
+ }; ### end of created subroutine
+### this is called first time only
+ if ( defined $newval ) {
+ $self->{$attr} = $newval;
+ }
+ return $self->{$attr};
+ } elsif ( $self->_accessible( $attr, 'read' ) ) {
+ *{$AUTOLOAD} = sub {
+ return $_[0]->{$attr};
+ }; ### end of created subroutine
+ return $self->{$attr};
+ }
+
+ # Must have been a mistake then...
+ croak "No such method: $AUTOLOAD";
+}
+1;
More information about the MOBY-guts
mailing list