#$Id: OntologyServer.pm,v 1.3 2008/09/02 13:14:18 kawas Exp $
# 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@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;

use vars qw /$VERSION/;
$VERSION = sprintf "%d.%02d", q$Revision: 1.3 $ =~ /: (\d+)\.(\d+)/;

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' );
	return (0, undef, undef) unless $term;

	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",
			''
		);
	}
}

=head2 objectInfo

=cut

sub objectInfo{
	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' );
	return (0, undef, undef) unless $term;

	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 ($row->{object_lsid})
	{ # if it is in there, then it has been discovered regardless of being foreign or not
		return $row;
	} elsif ( _isForeignLSID($term) ) { # if not in our ontology, but is a foreign LSID, then pass it back verbatim
		return {object_lsid => $term,
			object_type => $term,
			description => "LSID $term does not exist in the biomoby.org Object Class system\n",
			authority => "",
			contact_email => "",
		       };
	} else { # under all other circumstances (i.e. not a term, or a non-existent biomoby LSID) then fail
		return {object_lsid => "",
			object_type => "",
			description => "LSID $term does not exist in the biomoby.org Object Class system\n",
			authority => "",
			contact_email => "",
		       };
	}
}


=head2 serviceInfo

=cut

sub serviceInfo{
	my ( $self, %args ) = @_;

	$CONFIG ||= MOBY::Config->new;    # exported by Config.pm
	my $adaptor = $CONFIG->getDataAdaptor( datasource => 'mobyservice' );

	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 'service' );
	return (0, undef, undef) unless $term;

	my $result;
	
	$result = $adaptor->query_service(type => $term);
	my $row = shift(@$result);

	if ($row->{service_lsid})
	{ # if it is in there, then it has been discovered regardless of being foreign or not
		return $row;
	} elsif ( _isForeignLSID($term) ) { # if not in our ontology, but is a foreign LSID, then pass it back verbatim
		return {service_lsid => $term,
			service_type => $term,
			description => "LSID $term does not exist in the biomoby.org Object Class system\n",
			authority => "",
			contact_email => "",
		       };
	} else { # under all other circumstances (i.e. not a term, or a non-existent biomoby LSID) then fail
		return {service_lsid => "",
			service_type => "",
			description => "LSID $term does not exist in the biomoby.org Object Class system\n",
			authority => "",
			contact_email => "",
		       };
	}
}

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 $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 );
	}
	my $LSID = $self->setURI( $term );
	unless ($LSID) { return ( 0, "Failed during creation of an 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 $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", "" ) }

	$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, "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 = $ISA->{lsid};
		# 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->{articleName} 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 );
	}
	return (0, undef, undef) unless $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 =$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};
	return (0, undef, undef) unless $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/){    # if it is an LSID, barf
		return ( 0, "can't create a term from an lsid!", $term );
	}
	my $LSID = $self->setURI( $term );
	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->new_query_service();

	my %response;
	foreach (@$types) {
		$response{ $_->{'service_type'} } = [$_->{'description'}, $_->{'service_lsid'}, $_->{'contact_email'}, $_->{'authority'}, $_->{'parent_type'}, $_->{'parent_lsid'}]; #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 RelationshipsDEPRECATED

=cut

sub RelationshipsDEPRECATED {

	# 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]]
}


=head2 Relationships

=cut

sub Relationships {
  my ($self, %args) = @_;
  my %results;
  
  my $term         = $args{term};
  my $ontology     = $args{ontology} ? $args{ontology} : $self->ontology;
  my $direction    = $args{direction} ? $args{direction} : 'root';
  $direction = $direction eq 'root'? 'root' : 'leaves'; # map anything else to 'leaves'
  my $relationship  = $args{relationship};
  my $expand       = $args{expand} ? 1 : 0;
  
  # in order to make this function also usable for 'traverseDAG'
  # we need a more precise definition what to expand. Note that
  # the default settings assure the behaviour of the old 'expand' param.
  #  1. expand along the isa relationship?
  my $isaExpand    = $args{isaExpand} ? $args{isaExpand} : $expand;
  #  2. expand along the inclusion relationship types (has/hasa),
  #     i.e. get inclusions of inclusions?
  #     (Note: this is set when called by 'traverseDAG')
  my $incExpand   = $args{incExpand} ? $args{incExpand} : 0;
  #  3. explore inclusion relationships for complete isa hierarchy?
  #     (Note: this was fix behaviour of the old 'expand',
  #      but is not used by traverseDAG)
  my $mapIncToIsa = $args{mapIncToIsa} ? $args{mapIncToIsa} : $expand;

  # first of all, get ID of query entity,
  # internally, we will operate on pure IDs
  # as long as possible...
  $CONFIG ||= MOBY::Config->new;     # exported by Config.pm
  my $datasource = "moby$ontology";  # like mobyobject, or mobyservice
  my $adaptor = $CONFIG->getDataAdaptor( datasource => $datasource );
  my $queryId;
  my $query_method = "query_$ontology";
  my $result = $adaptor->$query_method(type => $term);
  my $row = shift @$result;
  $queryId = $row->{"${ontology}_id"};

  return {} unless $queryId;

  # get all relationships in the database in one query
  my $relHash = $adaptor->get_all_relationships(direction=>$direction,ontology=>$ontology);

  # find out which relationships to return
  # use keys of %$relHash, because these are lsids:

  # initialize to return all relationships (becomes effective if eg. 'all' was used)
  my @relList = keys %$relHash;
  if ( (not $relationship) or # ISA (and nothing else) is the default if nothing specified
       ($relationship =~ /isa$/i) ) {
    @relList = grep { /isa$/i } @relList;
  }
  elsif ( $relationship =~ /has(a)?$/i ) {
    # if either has or hasa was specified, use only that
    @relList = grep { /$relationship$/i } @relList;
  }

  # build the isa hierarchy, it's needed in any case...
  my ($isaLsid) = grep { /isa$/i } keys %$relHash; # we need the lsid...
  my $isa_hierarchy = $self->_getIsaHierarchy($relHash->{$isaLsid}, $queryId, $direction, $isaExpand);

  # prepare the hash for storing HAS/HASA relationship details
  my $hasRelDetails;

  # table fields needed to get entity details:
  my @fields = ("${ontology}_lsid","${ontology}_type");

  # nodes to check for has/hasa relationship
  my @checkNodes = ($queryId);
  # mapIncToIsa means that has/hasa has to be checked
  # not only for the query object alone but also for all
  # isa ancestors/descendants
  push @checkNodes, @$isa_hierarchy if $mapIncToIsa;
  
  # the result hash will consist of one list for each included relationship type...
  foreach my $rel ( @relList ) {
    my @entityQueryList = ();  # this collects the unique object ids
    my @entityResultList = (); # this collects ids of objects to add to the result, maybe not unique
    # the latter one is not essential to have, the only benefit is
    # a somehow predictable order in the output...

    # find out which entities we have to include in the result
    # and how these are related to each other;
    # Note: all needed information is present in the relationship hash %$relHash!

    if ( $rel ne $isaLsid ) {
      # either HAS or HASA
      foreach my $node ( @checkNodes ) {
	my $incls = $self->_getInclusions($relHash,$node,[$rel], $incExpand);
	foreach my $triplet ( @$incls ) {
	  my ($inclId, $inclArtName, $inclAssert) = @$triplet;
	  $hasRelDetails->{$inclId}->{$inclAssert} = $inclArtName;  # can be more than one articleName for each included Object
	  push @entityResultList, $inclId;
	}
      }
	# we have the following structure now for the HAS and HASA...
	#       DB<35> x $hasRelDetails
	#	0  HASH(0x95cd1bc)
	#	5371 => HASH(0x95f7fd8)   # object type
	#	10795 => 'Tiny'		  # related to parent by $ rel relationship 
	#	10796 => 'Small'
	#	10797 => 'Aliphatic'
	#	10798 => 'Aromatic'
	#	10799 => 'Non-polar'
	#	10800 => 'Polar'
	#	10801 => 'Charged'
	#	10802 => 'Positive'
	#	10803 => 'Negative'
	#	10804 => 'Hydropathy_KD'
	#	10805 => 'Hydropathy_OHM'
	#	10806 => 'Consensus'

      # set up list of unique object ids for the database lookup
      @entityQueryList = keys %$hasRelDetails;
    }
    else {
      # ISA
      @entityQueryList = @$isa_hierarchy;  # isa hierarchy is guaranteed to be unique...
      @entityResultList = @$isa_hierarchy; # ... but still both variables have to be set
    }
    
    # now it's time to move away from pure ids, retrieve details from database:
    my $details = $adaptor->get_details_for_id_list($ontology, \@fields, \@entityQueryList);
    my $newstructure;
    # enhance details with information about relationships and build result hash
    foreach my $entityId (@entityResultList) {
      # add articleName slot if necessary
      next if $details->{$entityId}->{'articleName'};  # we've already processed this one
      if ( exists $hasRelDetails->{$entityId} ) {  # the only things that have RelDetails are HASA/HAS EntityIDs
	foreach my $assert ( keys %{$hasRelDetails->{$entityId}} ) {
	  # THIS DATA STRUCTURE IS WRONG - IT ASSUMES ONE ARTICLE NAME FOR EACH CONTAINED OBJECT TYPE
	  # NEEDS TO BE REVERSED!
	  my $articleName = $hasRelDetails->{$entityId}->{$assert};
	  my $objectTypeLSID = $details->{entityId}->{object_lsid};
	  $details->{$entityId}->{'articleName'}->{$articleName} = "Related_by";  # I know, this is a very goofy data structure.  What we really
				# want are keys $details->{entitId}->{articleName}
				# so taht we can see how often that object is included
				# by a has or hasa relationship
	}
      }
      elsif ( $ontology eq 'object') {  # if it doesn't have a RelDetail, and it is the object ontology we are querying, then its an ISA
	# for isa, articleName is the empty string
	$details->{$entityId}->{'articleName'} = '';
      }

      # map ontology specific field names to commons slots:
      # 1. 'object_lsid'/'service_lsid' -> 'lsid'
      $details->{$entityId}->{'lsid'} = $details->{$entityId}->{"${ontology}_lsid"} 
	unless exists $details->{$entityId}->{'lsid'}; # do just once foreach object!
      delete $details->{$entityId}->{"${ontology}_lsid"}; # remove redundant slot
      # 2. 'object_type'/'service_type' -> 'term'
      $details->{$entityId}->{'term'} = $details->{$entityId}->{"${ontology}_type"}
	unless exists $details->{$entityId}->{'term'}; # do just once foreach object!
      delete $details->{$entityId}->{"${ontology}_type"}; # remove redundant slot

      # finally, add record to the result hash
      push @{ $results{$rel} }, $details->{$entityId};
    }
  }
  return \%results;
}

sub _getIsaHierarchy {
  # Finds out the isa hierarchy for the query entity, that is
  # the parent (the one which it inherits from) if direction is 'root' or
  # the children (one or more which inherit from it) if direction is 'leaves'.
  # If 'expand' is set all deeper levels (ancestors or descendants if you like)
  # are also included.
  # Note 1: this implementation relies on pure single inheritance!
  # Note 2: we can use the same method for both directions only because the
  #         provided isaHash is built with the direction in mind, make sure
  #         to have direction consistent!

  # returned is a reference to a flat list
  
  my ($self, $isaHash, $query, $direction, $expand) = @_;

  my @hierarchy = ();
  if ( exists $isaHash->{$query} ) {
    if ( $direction eq 'root' ) {
      # push the parent entity
      push @hierarchy, $isaHash->{$query}; # relies on single inheritance!
    }
    elsif ( $direction eq 'leaves' ) {
      # push the direct children
      push @hierarchy, @{$isaHash->{$query}};
    }
    else {
      # it has to be either 'root' or 'leaves'
      warn "_getIsaHierarchy was called with wrong direction indicator,
            use either 'root' or 'leaves'!\n";
      return [];
    }
    if ( $expand ) {
      my @firstLevel = @hierarchy;
      foreach my $entity ( @firstLevel ) {
	my $deeperLevels = $self->_getIsaHierarchy($isaHash, $entity, $direction, 1);
	push @hierarchy, @$deeperLevels;
      }
    }
    return \@hierarchy;
  }
  else {
    # important: anchor the recursion!
    return [];
  }
}

sub _getInclusions {

  # Finds out the objects related to the query by one of the inclusion
  # relationships (HAS or HASA). This is the HAS/HASA-analogue to
  # _getIsaHierarchy, but is more complicated, because the values in
  # the provided relationship hash ($relHash) are not simple ids but
  # triplets ("relationship records") in the format of:
  # [id of relationship partner, articleName, assertion id]
  # On the other hand, direction does not matter here, because
  # we have to deal with multi relationships in any case.
  # Like for ISA, be aware that the relationship hash '$relHash'
  # is built direction dependant. Make sure to use it consistently!

  # Note: third argument is a listref of relationship types, that is
  # it could be called with HAS and HASA (expected are lsids) at
  # the same time and in this way merge both inclusion relationship
  # types. However, this usage is not used currently and not tested!
  
  # Returned is a reference to a list with each element being
  # a triplet (listref to a relationship record) as explained above.
  
  my ($self, $relHash, $query, $relList, $expand) = @_;

  my %nodeCheckDone; # for avoiding multiple check of one node (if expand is set)
  my @allInclusions = ();
  foreach my $relType ( @$relList ) {
    # 'root' means: include all relationships where query is the
    # containing (outer) object;
    # eg. if A HAS B, and A is query, include this record
    if ( exists $relHash->{$relType}->{$query} ) {
      my $relRecords = $relHash->{$relType}->{$query};
      foreach my $record ( @$relRecords ) {
	push @allInclusions, $record;
	if ( $expand ) {
	  my ($incId, $artName, $assert) = @$record;
	  if ( not exists $nodeCheckDone{$incId} ) {
	    my $deeperInclusions = $self->_getInclusions($relHash, $incId, $relList, 1);
	    push @allInclusions, @$deeperInclusions;
	    $nodeCheckDone{$incId}++;
	  }
	}
      }
    }
  }
  return \@allInclusions; # empty if nothing found, this anchors the recursion
}

=head2 setURI

=cut

sub setURI {
	my ( $self, $id ) = @_;
	my $URI;

my ($sec,$min,$hour,$mday,$month,$year, $wday,$yday,$dst) =gmtime(time);
my $date = sprintf ("%04d-%02d-%02dT%02d-%02d-%02dZ",$year+1900,$month+1,$mday,$hour,$min,$sec);

	# $id = lc($id);
	if ( $self->ontology eq 'object' ) {
		$URI = "urn:lsid:biomoby.org:objectclass:$id:$date";
	} elsif ( $self->ontology eq 'namespace' ) {
		$URI = "urn:lsid:biomoby.org:namespacetype:$id:$date";
	} elsif ( $self->ontology eq 'service' ) {
		$URI = "urn:lsid:biomoby.org:servicetype:$id:$date";
	} elsif ( $self->ontology eq 'relationship' ) {
		$URI = "urn:lsid:biomoby.org:relationshiptype:$id";  # dont' add version info here
	} 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; # search term not in db!
  return {} unless $term =~ /^urn\:lsid/;    # now its a URI

  my $result = {};
  # get the types of relationships for the object/service ontology
  my $relTypeHash = $self->getRelationshipTypes( ontology => $ontology );
  my $relHash = $self->Relationships( term => $term,
				  direction => $direction,
				  ontology => $ontology,
				  isaExpand => 1,
				  incExpand => 1,
				  mapIncToIsa => 0,
				  relationship => 'all');
  foreach my $relType ( keys %$relTypeHash ) {
    $result->{$relType} = [];
    my %tmpHash; # avoid doubles!
    my $relList = $relHash->{$relType};
    foreach my $rel ( @$relList ) {
      $tmpHash{$rel->{'lsid'}}++;
    }
    @{$result->{$relType}} = keys %tmpHash;
  }
  return $result;
}

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;