lib/MOBY/OntologyServer.pm

   1 #$Id: OntologyServer.pm,v 1.95 2006/02/07 18:22:00 mwilkinson Exp $
   2 # this module needs to talk to the 'real' ontology
   3 # server as well as the MOBY Central database
   4 # in order to ensure that they are both in sync
   5
   6 =head1 NAME
   7
   8 MOBY::OntologyServer - A way for MOBY Central to query the
   9 object, service, namespace, and relationship ontologies
  10
  11 =cut
  12
  13 =head1 SYNOPSIS
  14
  15  use MOBY::OntologyServer;
  16  my $OS = MOBY::OntologyServer->new(ontology => "object");
  17
  18  my ($success, $message, $existingURI) = $OS->objectExists(term => "Object");
  19
  20  if ($success){
  21      print "object exists and it has the LSID $existingURI\n";
  22  } else {
  23     print "object does not exist; additional message from server: $message\n";
  24  }
  25
  26
  27 =cut
  28
  29 =head1 DESCRIPTION
  30
  31 Swappable interface to ontologies.  It should deal with LSID's 100%
  32 of the time, and also deal with MOBY-specific common names for objects,
  33 services, namespaces, and relationship types.
  34
  35
  36
  37 =head1 AUTHORS
  38
  39 Mark Wilkinson (markw@illuminae.com)
  40
  41 BioMOBY Project:  http://www.biomoby.org
  42
  43
  44 =cut
  45
  46 =head1 METHODS
  47
  48
  49 =head2 new
  50
  51  Title     :    new
  52  Usage     :    my $OS = MOBY::OntologyServer->new(%args)
  53  Function  :
  54  Returns   :    MOBY::OntologyServer object
  55  Args      :    ontology => [object || service || namespace || relationship]
  56                 database => mysql databasename that holds the ontologies
  57                 host =>  mysql hostname
  58                 username => mysql username
  59                 password => mysql password
  60                 port => mysql port
  61                 dbh => pre-existing database handle to a mysql database
  62
  63 =cut
  64
  65 package MOBY::OntologyServer;
  66 use strict;
  67 use Carp;
  68 use vars qw($AUTOLOAD);
  69 use DBI;
  70 use DBD::mysql;
  71 use MOBY::Config;
  72 my $debug = 0;
  73 {
  74
  75         #Encapsulated class data
  76         #___________________________________________________________
  77         #ATTRIBUTES
  78         my %_attr_data =    #                                   DEFAULT         ACCESSIBILITY
  79           (
  80                 ontology => [ undef, 'read/write' ],
  81                 database => [ undef, 'read/write' ],
  82                 host     => [ undef, 'read/write' ],
  83                 username => [ undef, 'read/write' ],
  84                 password => [ undef, 'read/write' ],
  85                 port     => [ undef, 'read/write' ],
  86                 dbh      => [ undef, 'read/write' ],
  87           );
  88
  89         #_____________________________________________________________
  90         # METHODS, to operate on encapsulated class data
  91         # Is a specified object attribute accessible in a given mode
  92         sub _accessible {
  93                 my ( $self, $attr, $mode ) = @_;
  94                 $_attr_data{$attr}[1] =~ /$mode/;
  95         }
  96
  97         # Classwide default value for a specified object attribute
  98         sub _default_for {
  99                 my ( $self, $attr ) = @_;
 100                 $_attr_data{$attr}[0];
 101         }
 102
 103         # List of names of all specified object attributes
 104         sub _standard_keys {
 105                 keys %_attr_data;
 106         }
 107 }
 108
 109 sub new {
 110         my ( $caller, %args ) = @_;
 111         my $caller_is_obj = ref($caller);
 112         my $class         = $caller_is_obj || $caller;
 113         my $self          = bless {}, $class;
 114         foreach my $attrname ( $self->_standard_keys ) {
 115                 if ( exists $args{$attrname} && defined $args{$attrname} ) {
 116                         $self->{$attrname} = $args{$attrname};
 117                 } elsif ($caller_is_obj) {
 118                         $self->{$attrname} = $caller->{$attrname};
 119                 } else {
 120                         $self->{$attrname} = $self->_default_for($attrname);
 121                 }
 122         }
 123         $self->ontology eq 'object'       && $self->database('mobyobject');
 124         $self->ontology eq 'namespace'    && $self->database('mobynamespace');
 125         $self->ontology eq 'service'      && $self->database('mobyservice');
 126         $self->ontology eq 'relationship' && $self->database('mobyrelationship');
 127
 128         #print STDERR "\n\nCONFIG object is $CONFIG\n\n";
 129         $CONFIG ||= MOBY::Config->new;
 130
 131 #print STDERR "got username ",($CONFIG->{mobycentral}->{username})," for mobycentral\n";
 132         $self->username( $CONFIG->{ $self->database }->{username} )
 133           unless $self->username;
 134         $self->password( $CONFIG->{ $self->database }->{password} )
 135           unless $self->password;
 136         $self->port( $CONFIG->{ $self->database }->{port} ) unless $self->port;
 137         $self->host( $CONFIG->{ $self->database }->{url} )  unless $self->host;
 138         my $host = $self->host ? $self->host : $ENV{MOBY_CENTRAL_URL};
 139         chomp $host;
 140         my $username =
 141           $self->username ? $self->username : $ENV{MOBY_CENTRAL_DBUSER};
 142         chomp $username;
 143         my $password =
 144           $self->password ? $self->password : $ENV{MOBY_CENTRAL_DBPASS};
 145         chomp $password if $password;
 146         $password =~ s/\s//g if $password;
 147         my $port = $self->port ? $self->port : $ENV{MOBY_CENTRAL_DBPORT};
 148         chomp $port;
 149         my ($dsn) =
 150             "DBI:mysql:"
 151           . ( $CONFIG->{ $self->database }->{dbname} ) . ":"
 152           . ($host) . ":"
 153           . ($port);
 154
 155         #print STDERR "\n\nDSN was $dsn\n\n";
 156         my $dbh;
 157
 158 #       $debug && &_LOG("connecting to db with params ",$self->database, $self->username, $self->password,"\n");
 159         if ( defined $password ) {
 160                 $dbh = DBI->connect( $dsn, $username, $password, { RaiseError => 1 } )
 161                   or die "can't connect to database";
 162         } else {
 163                 $dbh = DBI->connect( $dsn, $username, undef, { RaiseError => 1 } )
 164                   or die "can't connect to database";
 165         }
 166
 167         #       $debug && &_LOG("CONNECTED!\n");
 168         if ($dbh) {
 169                 $self->dbh($dbh);
 170                 return $self;
 171         } else {
 172                 return undef;
 173         }
 174 }
 175
 176 =head2 objectExists
 177
 178  moby:newterm will return (0, $message, $MOBYLSID)
 179  newterm will return (0, $message, $MOBYLSID
 180  oldterm will return (1, $message, undef)
 181  newLSID will return (0, $desc, $lsid)
 182
 183
 184 =cut
 185
 186 sub objectExists {
 187         my ( $self, %args ) = @_;
 188
 189         $CONFIG ||= MOBY::Config->new;    # exported by Config.pm
 190         my $adaptor = $CONFIG->getDataAdaptor( datasource => 'mobyobject' );
 191
 192         my $term = $args{term};
 193         $term =~ s/^moby://;    # if the term is namespaced, then remove that
 194         my $sth;
 195         return ( 0, "WRONG ONTOLOGY!", '' ) unless ( $self->ontology eq 'object' );
 196         return (0, undef, undef) unless $term;
 197
 198         my $result;
 199
 200         $result = $adaptor->query_object(type => $term);
 201
 202         my $row = shift(@$result);
 203         my $lsid = $row->{object_lsid};
 204         my $type = $row->{object_type};
 205         my $desc = $row->{description};
 206         my $auth = $row->{authority};
 207         my $email = $row->{contact_email};
 208
 209         if ($lsid)
 210         { # if it is in there, then it has been discovered regardless of being foreign or not
 211                 return ( 1, $desc, $lsid );
 212         } elsif ( _isForeignLSID($term) )
 213         { # if not in our ontology, but is a foreign LSID, then pass it back verbatim
 214                 return (
 215                         0,
 216 "LSID $term does not exist in the biomoby.org Object Class system\n",
 217                         $term
 218                 );
 219         } else { # under all other circumstances (i.e. not a term, or a non-existent biomoby LSID) then fail
 220                 return (
 221                         0,
 222 "Object type $term does not exist in the biomoby.org Object Class system\n",
 223                         ''
 224                 );
 225         }
 226 }
 227
 228 =head2 objectInfo
 229
 230 =cut
 231
 232 sub objectInfo{
 233         my ( $self, %args ) = @_;
 234
 235         $CONFIG ||= MOBY::Config->new;    # exported by Config.pm
 236         my $adaptor = $CONFIG->getDataAdaptor( datasource => 'mobyobject' );
 237
 238         my $term = $args{term};
 239         $term =~ s/^moby://;    # if the term is namespaced, then remove that
 240         my $sth;
 241         return ( 0, "WRONG ONTOLOGY!", '' ) unless ( $self->ontology eq 'object' );
 242         return (0, undef, undef) unless $term;
 243
 244         my $result;
 245
 246         $result = $adaptor->query_object(type => $term);
 247         my $row = shift(@$result);
 248         #my $lsid = $row->{object_lsid};
 249         #my $type = $row->{object_type};
 250         #my $desc = $row->{description};
 251         #my $auth = $row->{authority};
 252         #my $email = $row->{contact_email};
 253         #
 254         if ($row->{object_lsid})
 255         { # if it is in there, then it has been discovered regardless of being foreign or not
 256                 return $row;
 257         } elsif ( _isForeignLSID($term) ) { # if not in our ontology, but is a foreign LSID, then pass it back verbatim
 258                 return {object_lsid => $term,
 259                         object_type => $term,
 260                         description => "LSID $term does not exist in the biomoby.org Object Class system\n",
 261                         authority => "",
 262                         contact_email => "",
 263                        };
 264         } else { # under all other circumstances (i.e. not a term, or a non-existent biomoby LSID) then fail
 265                 return {object_lsid => "",
 266                         object_type => "",
 267                         description => "LSID $term does not exist in the biomoby.org Object Class system\n",
 268                         authority => "",
 269                         contact_email => "",
 270                        };
 271         }
 272 }
 273
 274
 275 =head2 serviceInfo
 276
 277 =cut
 278
 279 sub serviceInfo{
 280         my ( $self, %args ) = @_;
 281
 282         $CONFIG ||= MOBY::Config->new;    # exported by Config.pm
 283         my $adaptor = $CONFIG->getDataAdaptor( datasource => 'mobyservice' );
 284
 285         my $term = $args{term};
 286         $term =~ s/^moby://;    # if the term is namespaced, then remove that
 287         my $sth;
 288         return ( 0, "WRONG ONTOLOGY!", '' ) unless ( $self->ontology eq 'service' );
 289         return (0, undef, undef) unless $term;
 290
 291         my $result;
 292
 293         $result = $adaptor->query_service(type => $term);
 294         my $row = shift(@$result);
 295
 296         if ($row->{service_lsid})
 297         { # if it is in there, then it has been discovered regardless of being foreign or not
 298                 return $row;
 299         } elsif ( _isForeignLSID($term) ) { # if not in our ontology, but is a foreign LSID, then pass it back verbatim
 300                 return {service_lsid => $term,
 301                         service_type => $term,
 302                         description => "LSID $term does not exist in the biomoby.org Object Class system\n",
 303                         authority => "",
 304                         contact_email => "",
 305                        };
 306         } else { # under all other circumstances (i.e. not a term, or a non-existent biomoby LSID) then fail
 307                 return {service_lsid => "",
 308                         service_type => "",
 309                         description => "LSID $term does not exist in the biomoby.org Object Class system\n",
 310                         authority => "",
 311                         contact_email => "",
 312                        };
 313         }
 314 }
 315
 316 sub _isMOBYLSID {
 317         my ($lsid) = @_;
 318         return 1 if $lsid =~ /^urn\:lsid\:biomoby.org/;
 319         return 0;
 320 }
 321
 322 sub _isForeignLSID {
 323         my ($lsid) = @_;
 324         return 0 if $lsid =~ /^urn\:lsid\:biomoby.org/;
 325         return 1;
 326 }
 327
 328 =head2 createObject
 329
 330 =cut
 331
 332 sub createObject {
 333         my ( $self, %args ) = @_;
 334         $CONFIG ||= MOBY::Config->new;    # exported by Config.pm
 335         my $adaptor = $CONFIG->getDataAdaptor( datasource => 'mobyobject' );
 336         return ( 0, "WRONG ONTOLOGY!", '' ) unless ( $self->ontology eq 'object' );
 337         return ( 0, "requires a object type node", '' ) unless ( $args{node} );
 338         return ( 0, "requires an authURI ",        '' ) unless ( $args{authority} );
 339         return ( 0, "requires a contact email address", '' )
 340           unless ( $args{contact_email} );
 341         return ( 0, "requires a object description", '' )
 342           unless ( $args{description} );
 343         my $term = $args{node};
 344
 345         my $result;
 346         $result = $adaptor->query_object(type => $term);
 347         my $row = shift(@$result);
 348         my $lsid = $row->{object_lsid};
 349         my $type = $row->{object_type};
 350         my $desc = $row->{description};
 351         my $auth = $row->{authority};
 352         my $email = $row->{contact_email};
 353
 354         if ($lsid) {    # if it is in there, then the object exists
 355                 return ( 0, "This term already exists: $lsid", $lsid );
 356         }
 357         my $LSID = $self->setURI( $term );
 358         unless ($LSID) { return ( 0, "Failed during creation of an LSID", '' ) }
 359         $args{description}   =~ s/^\s+(.*?)\s+$/$1/s;
 360         $args{node}          =~ s/^\s+(.*?)\s+$/$1/s;
 361         $args{contact_email} =~ s/^\s+(.*?)\s+$/$1/s;
 362         $args{authority}     =~ s/^\s+(.*?)\s+$/$1/s;
 363
 364         my $insertid = $adaptor->insert_object(object_type => $args{'node'},
 365                                                 object_lsid => $LSID,
 366                                                 description => $args{'description'},
 367                                                 authority => $args{'authority'},
 368                                                 contact_email => $args{'contact_email'});
 369         unless ( $insertid ) {
 370                 return ( 0, "Object creation failed for unknown reasons", '' );
 371         }
 372         return ( 1, "Object creation succeeded", $LSID );
 373 }
 374
 375 =head2 retrieveObject
 376
 377 =cut
 378
 379 sub retrieveObject {
 380         my ( $self, %args ) = @_;
 381         $CONFIG ||= MOBY::Config->new;    # exported by Config.pm
 382         my $adaptor = $CONFIG->getDataAdaptor( datasource => 'mobyobject' );
 383         my $term = $args{'type'};
 384         $term ||=$args{'node'};
 385
 386         return ( 0, "WRONG ONTOLOGY!", '' ) unless ( $self->ontology eq 'object' );
 387         return ( 0, "requires a object type node as an argument", '' )
 388           unless ( $term );
 389         my $LSID =
 390           ( $term =~ /urn\:lsid/ )
 391           ? $term
 392           : $self->getObjectURI($term);
 393         unless ($LSID) { return ( 0, "Failed during creation of an LSID", '' ) }
 394         my $result = $adaptor->query_object(type => $LSID);
 395         my $row = shift(@$result);
 396         my $type = $row->{object_type};
 397         my $lsid = $row->{object_lsid};
 398         my $desc = $row->{description};
 399         my $auth = $row->{authority};
 400         my $contact = $row->{contact_email};
 401
 402         unless ($lsid) { return ( 0, "Object doesn't exist in ontology", "" ) }
 403
 404         $result = $adaptor->get_object_relationships(type => $lsid);
 405         my %rel;
 406         foreach my $row (@$result)
 407         {
 408         my $relationship_type = $row->{relationship_type};
 409         my $objectlsid = $row->{object_lsid};
 410         my $article = $row->{object2_articlename};
 411         my $contact = $row->{contact_email};
 412         my $def = $row->{definition};
 413         my $auth = $row->{authority};
 414         my $type = $row->{object_type};
 415
 416         push @{ $rel{$relationship_type} }, [ $objectlsid, $article, $type, $def, $auth, $contact ];
 417         }
 418         return {
 419                          objectType     => $type,
 420                          objectLSID    => $lsid,
 421                          description   => $desc,
 422                          contactEmail  => $contact,
 423                          authURI       => $auth,
 424                          Relationships => \%rel
 425         };
 426 }
 427
 428 =head2 deprecateObject
 429
 430 =cut
 431
 432 sub deprecateObject {
 433         my ( $self, %args ) = @_;
 434         $CONFIG ||= MOBY::Config->new;    # exported by Config.pm
 435         my $adaptor = $CONFIG->getDataAdaptor( datasource => 'mobyobject' );
 436
 437         return ( 0, "WRONG ONTOLOGY", '' ) unless ( $self->ontology eq 'object' );
 438         my $term = $args{term};
 439
 440 #    if ($term =~ /^urn:lsid/ && !($term =~ /^urn:lsid:biomoby.org:objectclass/)){
 441 #        return (0, "can't delete from external ontology", $term);
 442 #    }
 443         my $LSID;
 444         unless ( $term =~ /urn\:lsid/ ) { $LSID = $self->getObjectURI($term) } else { $LSID = $term }
 445         return ( 0, q{Object type $term cannot be resolved to an LSID}, "" )
 446           unless $LSID;
 447
 448         my $result = $adaptor->query_object(type => $LSID);
 449         my $row = shift(@$result);
 450         my $id = $row->{object_id};
 451         my $lsid = $row->{object_lsid};
 452
 453         # object1_id ISA object2_id?
 454         my $isa = $adaptor->query_object_term2term(type => $lsid);
 455         my $isas = shift @$isa;
 456         if ( $isas->{object1_id}) {
 457                 return ( 0,
 458                                  qq{Object type $term has object dependencies in the ontology},
 459                                  $lsid );
 460         }
 461
 462         my ($err, $errstr) = $adaptor->delete_object(type => $lsid);
 463         if ( $err ) {
 464                 return ( 0, "Delete from Object Class table failed: $errstr",
 465                                  $lsid );
 466         }
 467         return ( 1, "Object $term Deleted", $lsid );
 468 }
 469
 470 =head2 deleteObject
 471
 472 =cut
 473
 474 sub deleteObject {
 475         my $self = shift;
 476         $self->deprecateObject(@_);
 477 }
 478
 479 =head2 relationshipExists
 480
 481 =cut
 482
 483 sub relationshipExists {
 484
 485         # term => $term
 486         # ontology => $ontology
 487         my ( $self, %args ) = @_;
 488         $CONFIG ||= MOBY::Config->new;    # exported by Config.pm
 489         my $adaptor = $CONFIG->getDataAdaptor( datasource => 'mobyrelationship' );
 490         return ( 0, "WRONG ONTOLOGY!", '' )
 491           unless ( $self->ontology eq 'relationship' );
 492         my $term = lc( $args{term} );
 493         $term =~ s/^moby://;    # if the term is namespaced, then remove that
 494         my $ont = $args{ontology};
 495         return ( 0, "requires both term and ontology arguments\n", '' )
 496           unless ( defined($term) && defined($ont) );
 497         my $result;
 498         if ( $term =~ /^urn\:lsid/ ) {
 499
 500         $result = $adaptor->query_relationship(
 501                                         type => $term,
 502                                         ontology => $ont);
 503
 504         } else {
 505
 506         $result = $adaptor->query_relationship(type => $term, ontology => $ont);
 507
 508         }
 509         my $row = shift(@$result);
 510         my $lsid = $row->{relationship_lsid};
 511         my $type = $row->{relationship_type};
 512         my $desc = $row->{description};
 513         my $auth = $row->{authority};
 514         my $email = $row->{contact_email};
 515         if ($lsid) {
 516                 return ( 1, $desc, $lsid, $type, $auth, $email );
 517         } else {
 518                 return (
 519                         0,"Relationship Type $term does not exist in the biomoby.org Relationship Type system\n",
 520                         '', '', '', ''
 521                 );
 522         }
 523 }
 524
 525 =head2 addObjectRelationship
 526
 527 =cut
 528
 529 sub addObjectRelationship {
 530
 531         # adds a  relationship
 532         #subject_node => $term,
 533         #relationship => $reltype,
 534         #object_node => $objectType,
 535         #articleName => $articleName,
 536         #authority => $auth,
 537         #contact_email => $email
 538         my ( $self, %args ) = @_;
 539         $CONFIG ||= MOBY::Config->new;    # exported by Config.pm
 540         my $adaptor = $CONFIG->getDataAdaptor( datasource => 'mobyobject' );
 541
 542         return ( 0, "WRONG ONTOLOGY!", '' ) unless ( $self->ontology eq 'object' );
 543
 544         my $result = $adaptor->query_object(type => $args{subject_node});
 545         my $row = shift(@$result);
 546         my $subj_lsid = $row->{object_lsid};
 547         return ( 0, qq{Object type $args{subject_node} does not exist in the ontology}, '' )
 548           unless defined $subj_lsid;
 549
 550         $result = $adaptor->query_object(type => $args{object_node});
 551         $row = shift(@$result);
 552         my $obj_lsid = $row->{object_lsid};
 553         return ( 0,qq{Object type $args{object_node} does not exist in the ontology},'' )
 554           unless defined $obj_lsid;
 555         my $isa = $adaptor->query_object_term2term(type => $subj_lsid);
 556         my $isarow = shift @$isa;
 557         if ( $isarow->{object_lsid} ) {
 558                 return (
 559                         0,
 560                         qq{Object type $args{subject_node} has existing object dependencies in the ontology.  It cannot be changed.},
 561                         $subj_lsid
 562                 );
 563         }
 564         my $OE = MOBY::OntologyServer->new( ontology => 'relationship' );
 565         my ( $success, $desc, $rel_lsid ) = $OE->relationshipExists(
 566                 term => $args{relationship},
 567                 ontology => 'object' );
 568         ($success) || return ( 0,
 569                         qq{Relationship $args{relationship} does not exist in the ontology},
 570                         '' );
 571
 572         # need to ensure that identical article names dont' end up at the same level
 573         my $articleNameInvalid = &_testIdenticalArticleName(term => $subj_lsid, articleName => $args{articleName});
 574         return (0, "Object will have conflicting articleName ".($args{articleName}), '') if $articleNameInvalid;
 575
 576         my $insertid = $adaptor->insert_object_term2term(relationship_type => $rel_lsid,
 577                                                          object1_type => $subj_lsid,
 578                                                          object2_type => $obj_lsid,
 579                                                          object2_articlename => $args{articleName});
 580
 581
 582         if ($insertid ) {
 583                 return ( 1, "Object relationsihp created successfully", '' );
 584         } else {
 585                 return ( 0, "Object relationship creation failed for unknown reasons",
 586                                  '' );
 587         }
 588 }
 589
 590 sub _testIdenticalArticleName {
 591         my (%args)= @_;
 592         my $term = $args{term};
 593         my $articleName = $args{articleName};
 594         my $foundCommonArticleNameFlag = 0;
 595         # need to first traverse down the ISA pathway to root
 596         # then for each ISA test the hAS and HASA's for their articlenames and see if they are the same
 597         # case insensitive?
 598         my $OS = MOBY::OntologyServer->new(ontology => 'object');
 599         my $OSrel = MOBY::OntologyServer->new(ontology => 'relationship');
 600         my ($exists1, $desc, $isalsid) = $OSrel->relationshipExists(term => 'isa', ontology => 'object');
 601         my ($exists2, $desc2, $hasalsid) = $OSrel->relationshipExists(term => 'hasa', ontology => 'object');
 602         my ($exists3, $desc3, $haslsid) = $OSrel->relationshipExists(term => 'has', ontology => 'object');
 603
 604         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....
 605                 # check the hasa relationships for common articleName
 606         $foundCommonArticleNameFlag += _compareArticleNames(OS => $OS, type => $args{term}, relationship => $hasalsid, targetArticleName => $articleName);
 607                 # check the has relationships for common articleName
 608         $foundCommonArticleNameFlag += _compareArticleNames(OS => $OS, type => $args{term}, relationship => $haslsid, targetArticleName => $articleName);
 609
 610         # now get all of its inherited parents
 611         my $relationships = $OS->Relationships(
 612                 ontology => 'object',
 613                 term => $args{term},
 614                 relationship => $isalsid,
 615                 direction => 'root',
 616                 expand =>  1);
 617          #relationships{relationship} = [[lsid1,articleNmae], [lsid2, articleName], [lsid3, articleName]]
 618         my ($isa) = keys(%$relationships);  # can only be one key returned, and must be isa in this case
 619         my @ISAlist;
 620         (@ISAlist = @{$relationships->{$isa}}) if ($relationships->{$isa}) ;
 621         # for each of the inherited parents, check their articleNames
 622         foreach my $ISA(@ISAlist){  # $ISA = [lsid, articleName] (but articleName shuld be null anyway in this case)
 623                 my $what_it_is = $ISA->{lsid};
 624                 # check the hasa relationships for common articleName
 625                 $foundCommonArticleNameFlag += _compareArticleNames(OS => $OS, type => $what_it_is, relationship => $hasalsid, targetArticleName => $articleName);
 626                 # check the has relationships for common articleName
 627                 $foundCommonArticleNameFlag += _compareArticleNames(OS => $OS, type => $what_it_is, relationship => $haslsid, targetArticleName => $articleName);
 628         }
 629         return $foundCommonArticleNameFlag;
 630 }
 631
 632 sub _compareArticleNames {
 633         my (%args) = @_;
 634         my $OS =  $args{OS};
 635         my $what_it_is = $args{type};
 636         my $lsid = $args{relationship};
 637         my $targetArticleName = $args{targetArticleName};
 638         my $foundCommonArticleNameFlag = 0;
 639         my $contents = $OS->Relationships(
 640                 ontology => 'object',
 641                 term => $what_it_is,
 642                 relationship => $lsid,
 643                 direction => 'root',
 644                 );
 645         if ($contents){
 646                 #$hasarelationships{relationship} = [[lsid1,articleNmae], [lsid2, articleName], [lsid3, articleName]]
 647                my ($content) = keys(%$contents);
 648                if ($contents->{$content}){
 649                         my @CONTENTlist = @{$contents->{$content}};
 650                         foreach my $CONTAINED(@CONTENTlist){
 651                                 $foundCommonArticleNameFlag = 1 if ($CONTAINED->{articleName} eq $targetArticleName); #->[1] is the articleName field
 652                         }
 653                }
 654         }
 655         return $foundCommonArticleNameFlag;
 656 }
 657
 658 =head2 addServiceRelationship
 659
 660 =cut
 661
 662 sub addServiceRelationship {
 663
 664         # adds an ISA relationship
 665         # fail if another object is in relation to this objevt
 666         #subject_node => $term,
 667         #relationship => $relationship,
 668         #predicate_node => $pred
 669         #authority => $auth,
 670         #contact_email => $email);
 671         my ( $self, %args ) = @_;
 672         $CONFIG ||= MOBY::Config->new;    # exported by Config.pm
 673         my $adaptor = $CONFIG->getDataAdaptor( datasource => 'mobyservice' );
 674
 675         return ( 0, "WRONG ONTOLOGY!", '' ) unless ( $self->ontology eq 'service' );
 676
 677         my $result = $adaptor->query_service(type => $args{subject_node});
 678         my $row = shift(@$result);
 679         my $sbj_lsid = $row->{service_lsid};
 680
 681         return (0,
 682                 qq{Service type $args{subject_node} has object dependencies in the ontology.  It can not be changed},
 683                 $sbj_lsid
 684           ) unless defined $sbj_lsid;
 685
 686         my $isa = $adaptor->query_service_term2term(service2_id => $sbj_lsid);
 687         my $isarow = shift @$isa;
 688         if ( $isarow->{service_lsid} ) {
 689                 return (
 690                         0,
 691                         qq{Service type $args{subject_node} has object dependencies in the ontology.  It can not be changed},
 692                         $sbj_lsid
 693                 );
 694         }
 695         $result = $adaptor->query_service(type => $args{object_node});
 696         $row = shift(@$result);
 697         my $obj_lsid = $row->{service_lsid};
 698         # get ID of the related service
 699
 700         defined $obj_lsid
 701           || return ( 0,
 702                   qq{Service $args{object_node} does not exist in the service ontology},
 703                   '' );
 704         my $OE = MOBY::OntologyServer->new( ontology => 'relationship' );
 705         my ( $success, $desc, $rel_lsid ) = $OE->relationshipExists(
 706                 term => $args{relationship},
 707                 ontology => 'service' );
 708         ($success)
 709           || return ( 0,
 710                         qq{Relationship $args{relationship} does not exist in the ontology},
 711                         '' );
 712
 713         my $insertid = $adaptor->insert_service_term2term(relationship_type => $rel_lsid,
 714                                                           service1_type => $sbj_lsid,
 715                                                           service2_type => $obj_lsid);
 716         if ( defined($insertid)) {
 717                 return ( 1, "Service relationship created successfully", '' );
 718         } else {
 719                 return ( 0, "Service relationship creation failed for unknown reasons",
 720                                  '' );
 721         }
 722 }
 723
 724 =head2 serviceExists
 725
 726 =cut
 727
 728 sub serviceExists {
 729         my ( $self, %args ) = @_;
 730         $CONFIG ||= MOBY::Config->new;    # exported by Config.pm
 731         my $adaptor = $CONFIG->getDataAdaptor( datasource => 'mobyservice' );
 732
 733         return ( 0, "WRONG ONTOLOGY!", '' ) unless ( $self->ontology eq 'service' );
 734         my $term = $args{term};
 735         $term =~ s/^moby://;    # if the term is namespaced, then remove that
 736         if ( $term =~ /^urn:lsid/
 737                  && !( $term =~ /^urn:lsid:biomoby.org:servicetype/ ) )
 738         {
 739                 return ( 1, "external ontology", $term );
 740         }
 741         return (0, undef, undef) unless $term;
 742
 743         my $result;
 744         $result = $adaptor->query_service(type => $term);
 745         my $row = shift(@$result);
 746         my $id = $row->{service_id};
 747         my $type = $row->{service_type};
 748         my $lsid = $row->{service_lsid};
 749         my $desc = $row->{description};
 750         my $auth = $row->{authority};
 751         my $email = $row->{contact_email};
 752
 753         if ($id) {
 754                 return ( 1, $desc, $lsid );
 755         } else {
 756                 return (
 757                         0,
 758 "Service Type $term does not exist in the biomoby.org Service Type ontology\n",
 759                         ''
 760                 );
 761         }
 762 }
 763
 764 =head2 createServiceType
 765
 766 =cut
 767
 768 sub createServiceType {
 769         my ( $self, %args ) = @_;
 770         $CONFIG ||= MOBY::Config->new;    # exported by Config.pm
 771         my $adaptor = $CONFIG->getDataAdaptor( datasource => 'mobyservice' );
 772
 773         #node => $term,
 774         #descrioption => $desc,
 775         #authority => $auth,
 776         #contact_email => $email);
 777         return ( 0, "WRONG ONTOLOGY!", '' ) unless ( $self->ontology eq 'service' );
 778         return ( 0, "requires a object type node", '' ) unless ( $args{node} );
 779         return ( 0, "requires an authURI ",        '' ) unless ( $args{authority} );
 780         return ( 0, "requires a contact email address", '' )
 781           unless ( $args{contact_email} );
 782         return ( 0, "requires a object description", '' )
 783           unless ( $args{description} );
 784         my $term = $args{node};
 785         if ( $term =~ /^urn:lsid/
 786                  && !( $term =~ /^urn:lsid:biomoby.org:servicetype/ ) )
 787         {    # if it is an LSID, but not a MOBY LSID, than barf
 788                 return ( 0, "can't create a term in a non-MOBY ontology!", $term );
 789         }
 790
 791         my $LSID =$self->setURI( $args{'node'} );
 792         unless ($LSID) { return ( 0, "Failed during creation of an LSID", '' ) }
 793
 794         my $insertid = $adaptor->insert_service(service_type => $args{'node'},
 795                                                 service_lsid => $LSID,
 796                                                 description => $args{'description'},
 797                                                 authority => $args{'authority'},
 798                                                 contact_email => $args{'contact_email'});
 799
 800         unless ( $insertid ) {
 801                 return ( 0, "Service creation failed for unknown reasons", '' );
 802         }
 803         return ( 1, "Service creation succeeded", $LSID );
 804 }
 805
 806 =head2 deleteServiceType
 807
 808 =cut
 809
 810 sub deleteServiceType {
 811         my ( $self, %args ) = @_;
 812         $CONFIG ||= MOBY::Config->new;    # exported by Config.pm
 813         my $adaptor = $CONFIG->getDataAdaptor( datasource => 'mobyservice' );
 814
 815         return ( 0, "WRONG ONTOLOGY!", '' ) unless ( $self->ontology eq 'service' );
 816         my $term = $args{term};
 817         if ( $term =~ /^urn:lsid/
 818                  && !( $term =~ /^urn:lsid:biomoby.org:servicetype/ ) )
 819         {
 820                 return ( 0, "can't delete from external ontology", $term );
 821         }
 822         my $LSID;
 823         unless ( $term =~ /^urn:lsid:biomoby.org:servicetype/ ) {
 824                 $LSID = $self->getServiceURI($term);
 825         } else {
 826                 $LSID = $term;
 827         }
 828         return (
 829                 0, q{Service type $term cannot be resolved to an LSID in the MOBY ontologies},""
 830           ) unless $LSID;
 831
 832         my $result = $adaptor->query_service(type => $LSID);
 833         my $row = shift(@$result);
 834         my $lsid = $row->{service_lsid};
 835
 836         if ( !defined $lsid ) {
 837                 return ( 0, q{Service type $term does not exist in the ontology},
 838                                  $lsid );
 839         }
 840
 841         # service1_id ISA service2_id?
 842         my $isa = $adaptor->query_service_term2term(type => $lsid);
 843         my $isas = shift(@$isa);
 844
 845         if ( $isas->{service1_id} ) {
 846                 return ( 0, qq{Service type $term has dependencies in the ontology},
 847                                  $lsid );
 848         }
 849         my ($err, $errstr) = $adaptor->delete_service(type => $lsid);
 850
 851         if ( $err ) {
 852                 return ( 0, "Delete from Service Type table failed: $errstr",
 853                                  $lsid );
 854         }
 855
 856         return ( 1, "Service Type $term Deleted", $lsid );
 857 }
 858
 859 =head2 namespaceExists
 860
 861 =cut
 862
 863 sub namespaceExists {
 864         my ( $self, %args ) = @_;
 865         $CONFIG ||= MOBY::Config->new;    # exported by Config.pm
 866         my $adaptor = $CONFIG->getDataAdaptor( datasource => 'mobynamespace' );
 867
 868         return ( 0, "WRONG ONTOLOGY!", '' )
 869           unless ( $self->ontology eq 'namespace' );
 870         my $term = $args{term};
 871         return (0, undef, undef) unless $term;
 872         $term =~ s/^moby://;    # if the term is namespaced, then remove that
 873         if ( $term =~ /^urn:lsid/
 874                  && !( $term =~ /^urn:lsid:biomoby.org:namespacetype/ ) )
 875         {
 876                 return ( 1, "external ontology", $term );
 877         }
 878         my $result;
 879         $result = $adaptor->query_namespace(type => $term);
 880         my $row = shift(@$result);
 881         my $id = $row->{namespace_id};
 882         my $type = $row->{namespace_type};
 883         my $lsid = $row->{namespace_lsid};
 884         my $desc = $row->{description};
 885         my $auth = $row->{authority};
 886         my $email = $row->{contact_email};
 887
 888         if ($id) {
 889                 return ( 1, $desc, $lsid );
 890         } else {
 891                 return (
 892                         0,
 893 "Namespace Type $term does not exist in the biomoby.org Namespace Type ontology\n",
 894                         ''
 895                 );
 896         }
 897 }
 898
 899 =head2 createNamespace
 900
 901 =cut
 902
 903 sub createNamespace {
 904         my ( $self, %args ) = @_;
 905         $CONFIG ||= MOBY::Config->new;    # exported by Config.pm
 906         my $adaptor = $CONFIG->getDataAdaptor( datasource => 'mobynamespace' );
 907         #node => $term,
 908         #descrioption => $desc,
 909         #authority => $auth,
 910         #contact_email => $email);
 911         return ( 0, "WRONG ONTOLOGY!", '' )
 912           unless ( $self->ontology eq 'namespace' );
 913         return ( 0, "requires a namespace type node", '' ) unless ( $args{node} );
 914         return ( 0, "requires an authURI ", '' ) unless ( $args{authority} );
 915         return ( 0, "requires a contact email address", '' )
 916           unless ( $args{contact_email} );
 917         return ( 0, "requires a object description", '' )
 918           unless ( $args{description} );
 919         my $term = $args{node};
 920         if ( $term =~ /^urn:lsid/){    # if it is an LSID, barf
 921                 return ( 0, "can't create a term from an lsid!", $term );
 922         }
 923         my $LSID = $self->setURI( $term );
 924         unless ($LSID) { return ( 0, "Failed during creation of an LSID", '' ) }
 925
 926         my $insertid = $adaptor->insert_namespace(namespace_type => $args{'node'},
 927                                                 namespace_lsid => $LSID,
 928                                                 description => $args{'description'},
 929                                                 authority => $args{'authority'},
 930                                                 contact_email => $args{'contact_email'});
 931
 932         unless ( $insertid ) {
 933                 return ( 0, "Namespace creation failed for unknown reasons", '' );
 934         }
 935         return ( 1, "Namespace creation succeeded", $LSID );
 936 }
 937
 938 =head2 deleteNamespace
 939
 940 =cut
 941
 942 sub deleteNamespace {
 943         my ( $self, %args ) = @_;
 944         $CONFIG ||= MOBY::Config->new;    # exported by Config.pm
 945         my $adaptor = $CONFIG->getDataAdaptor( datasource => 'mobynamespace' );
 946         return ( 0, "WRONG ONTOLOGY!", '' )
 947           unless ( $self->ontology eq 'namespace' );
 948         my $term = $args{term};
 949         my $LSID;
 950         unless ( $term =~ /urn\:lsid/ ) { $LSID = $self->getNamespaceURI($term) } else { $LSID = $term }
 951         return ( 0, q{Namespace type $term cannot be resolved to an LSID}, "" )
 952           unless $LSID;
 953         if ( $term =~ /^urn:lsid/
 954                  && !( $term =~ /^urn:lsid:biomoby.org:namespacetype/ ) )
 955         {
 956                 return ( 0, "cannot delete a term from an external ontology", $term );
 957         }
 958
 959         my $result = $adaptor->query_namespace(type => $LSID);
 960         my $row = shift(@$result);
 961         my $lsid = $row->{namespace_lsid};
 962
 963         unless ($lsid) {
 964                 return ( 0, q{Namespace type $term does not exist in the ontology},
 965                                  $lsid );
 966         }
 967
 968         # service1_id ISA service2_id?
 969         my $isa = $adaptor->query_namespace_term2term(type => $lsid);
 970         my $isas = shift @$isa;
 971
 972         if ($isas->{namespace1_id} ) {
 973                 return ( 0, qq{Namespace type $term has dependencies in the ontology},
 974                                  $lsid );
 975         }
 976
 977         my ($err, $errstr) = $adaptor->delete_namespace(type => $lsid);
 978
 979         if ( $err ) {
 980                 return ( 0, "Delete from namespace table failed: $errstr",
 981                                  $lsid );
 982         }
 983
 984         #($err, $errstr) = $adaptor->delete_namespace_term2term(namespace1_id => $lsid);
 985         #
 986         #if ( $err ) {
 987         #       return (
 988         #                0,
 989         #                "Delete from namespace term2term table failed: $errstr",
 990         #                $lsid
 991         #       );
 992         #}
 993         return ( 1, "Namespace Type $term Deleted", $lsid );
 994 }
 995
 996 =head2 retrieveAllServiceTypes
 997
 998 =cut
 999
1000 sub retrieveAllServiceTypes {
1001         my ($self) = @_;
1002         $CONFIG ||= MOBY::Config->new;    # exported by Config.pm
1003         my $adaptor = $CONFIG->getDataAdaptor( datasource => 'mobyservice' );
1004         my $types = $adaptor->query_service();
1005
1006         my %response;
1007         foreach (@$types) {
1008                 $response{ $_->{service_type} } = [$_->{description}, $_->{service_lsid}, $_->{contact_email}, $_->{authority}]; #UNCOMMENT
1009         }
1010         return \%response;
1011 }
1012
1013 =head2 retrieveAllNamespaceTypes
1014
1015 =cut
1016
1017 sub retrieveAllNamespaceTypes {
1018         my ($self) = @_;
1019         $CONFIG ||= MOBY::Config->new;    # exported by Config.pm
1020         my $adaptor = $CONFIG->getDataAdaptor( datasource => 'mobynamespace' );
1021         my $types = $adaptor->query_namespace();
1022
1023         my %response;
1024         foreach (@$types) {
1025                 $response{ $_->{namespace_type} } = [$_->{description}, $_->{namespace_lsid}, $_->{authority}, $_->{contact_email}];
1026         }
1027         return \%response;
1028 }
1029
1030 =head2 retrieveAllObjectClasses
1031
1032 =cut
1033
1034 sub retrieveAllObjectClasses {
1035         my ($self) = @_;
1036         $CONFIG ||= MOBY::Config->new;    # exported by Config.pm
1037         my $adaptor = $CONFIG->getDataAdaptor( datasource => 'mobyobject' );
1038         my $types = $adaptor->query_object();
1039
1040         my %response;
1041         foreach (@$types) {
1042                 $response{ $_->{object_type} } = [$_->{description}, $_->{object_lsid}];
1043         }
1044         return \%response;
1045 }
1046 *retrieveAllObjectTypes = \&retrieveAllObjectClasses;
1047 *retrieveAllObjectTypes = \&retrieveAllObjectClasses;
1048
1049 =head2 getObjectCommonName
1050
1051 =cut
1052
1053 sub getObjectCommonName {
1054         my ( $self, $URI ) = @_;
1055         $CONFIG ||= MOBY::Config->new;    # exported by Config.pm
1056         my $adaptor = $CONFIG->getDataAdaptor( datasource => 'mobyobject' );
1057         return undef unless $URI =~ /urn\:lsid/;
1058         my $result = $adaptor->query_object(type => $URI);
1059         my $row = shift(@$result);
1060         my $name = $row->{object_type};
1061
1062         return $name ? $name : $URI;
1063 }
1064
1065 =head2 getNamespaceCommonName
1066
1067 =cut
1068
1069 sub getNamespaceCommonName {
1070         my ( $self, $URI ) = @_;
1071         $CONFIG ||= MOBY::Config->new;    # exported by Config.pm
1072         my $adaptor = $CONFIG->getDataAdaptor( datasource => 'mobynamespace' );
1073         return undef unless $URI =~ /urn\:lsid/;
1074         my $result = $adaptor->query_namespace(type => $URI);
1075         my $row = shift(@$result);
1076         my $name = $row->{namespace_type};
1077
1078         return $name ? $name : $URI;
1079 }
1080
1081 =head2 getServiceCommonName
1082
1083 =cut
1084
1085 sub getServiceCommonName {
1086         my ( $self, $URI ) = @_;
1087         $CONFIG ||= MOBY::Config->new;    # exported by Config.pm
1088         my $adaptor = $CONFIG->getDataAdaptor( datasource => 'mobyservice' );
1089         return undef unless $URI =~ /urn\:lsid/;
1090         my $result = $adaptor->query_service(type => $URI);
1091         my $row = shift(@$result);
1092         my $name = $row->{service_type};
1093
1094         return $name ? $name : $URI;
1095 }
1096
1097 =head2 getServiceURI
1098
1099 =cut
1100
1101 sub getServiceURI {
1102         my ( $self, $term ) = @_;
1103         $CONFIG ||= MOBY::Config->new;    # exported by Config.pm
1104         my $adaptor = $CONFIG->getDataAdaptor( datasource => 'mobyservice' );
1105         return $term if $term =~ /urn\:lsid/;
1106
1107         my $result = $adaptor->query_service(type => $term);
1108         my $row = shift(@$result);
1109         my $id = $row->{service_lsid};
1110
1111         return $id;
1112 }
1113
1114 =head2 getObjectURI
1115
1116 =cut
1117
1118 sub getObjectURI {
1119         my ( $self, $term ) = @_;
1120         $CONFIG ||= MOBY::Config->new;    # exported by Config.pm
1121         my $adaptor = $CONFIG->getDataAdaptor( datasource => 'mobyobject' );
1122         return $term if $term =~ /urn\:lsid/;
1123
1124         my $result = $adaptor->query_object(type => $term);
1125         my $row = shift(@$result);
1126         my $id = $row->{object_lsid};
1127
1128         return $id;
1129 }
1130
1131 =head2 getNamespaceURI
1132
1133 =cut
1134
1135 sub getNamespaceURI {
1136         my ( $self, $term ) = @_;
1137         $CONFIG ||= MOBY::Config->new;    # exported by Config.pm
1138         my $adaptor = $CONFIG->getDataAdaptor( datasource => 'mobynamespace' );
1139
1140         return $term if $term =~ /urn\:lsid/;
1141
1142         my $result = $adaptor->query_namespace(type => $term);
1143         my $row = shift(@$result);
1144         my $id = $row->{namespace_lsid};
1145
1146         return $id;
1147 }
1148
1149 =head2 getRelationshipURI
1150
1151 consumes ontology (object/service)
1152 consumes relationship term as term or LSID
1153
1154 =cut
1155
1156 sub getRelationshipURI {
1157         my ( $self, $ontology, $term ) = @_;
1158         $CONFIG ||= MOBY::Config->new;    # exported by Config.pm
1159         my $adaptor = $CONFIG->getDataAdaptor( datasource => 'mobyrelationship' );
1160
1161         return $term if $term =~ /urn\:lsid/;
1162
1163         my $result = $adaptor->query_relationship(type => $term, ontology => $ontology);
1164         my $row = shift(@$result);
1165         my $id = $row->{relationship_lsid};
1166
1167         return $id;
1168 }
1169
1170 =head2 getRelationshipTypes
1171
1172 =cut
1173
1174 sub getRelationshipTypes {
1175         my ( $self, %args ) = @_;
1176         $CONFIG ||= MOBY::Config->new;    # exported by Config.pm
1177         my $adaptor = $CONFIG->getDataAdaptor( datasource => 'mobyrelationship' );
1178
1179         my $ontology = $args{'ontology'};
1180         my $OS = MOBY::OntologyServer->new( ontology => "relationship" );
1181
1182         my $defs = $adaptor->query_relationship(ontology => $ontology);
1183
1184         my %result;
1185         foreach ( @$defs ) {
1186                 $result{ $_->{relationship_lsid} } = [ $_->{relationship_type}, $_->{authority}, $_->{description} ];
1187         }
1188         return \%result;
1189 }
1190
1191 =head2 RelationshipsDEPRECATED
1192
1193 =cut
1194
1195 sub RelationshipsDEPRECATED {
1196
1197         # this entire subroutine assumes that there is NOT multiple parenting!!
1198         my ( $self, %args ) = @_;
1199         my $ontology     = $args{ontology} ? $args{ontology} : $self->ontology;
1200         my $term         = $args{term};
1201         my $relationship = $args{relationship};
1202         my $direction    = $args{direction} ? $args{direction} : 'root';
1203         my $expand       = $args{expand} ? 1 : 0;
1204         return
1205           unless (    $ontology
1206                            && $term
1207                            && ( ( $ontology eq 'service' ) || ( $ontology eq 'object' ) ) );
1208
1209         # convert $term into an LSID if it isn't already
1210         if ( $ontology eq 'service' ) {
1211                 $term = $self->getServiceURI($term);
1212                 $relationship ||="isa";
1213                 my $OS = MOBY::OntologyServer->new(ontology => 'relationship');
1214                 $relationship = $OS->getRelationshipURI("service", $relationship);
1215         } elsif ( $ontology eq 'object' ) {
1216                 $term = $self->getObjectURI($term);
1217                 $relationship ||="isa";
1218                 my $OS = MOBY::OntologyServer->new(ontology => 'relationship');
1219                 $relationship = $OS->getRelationshipURI("object", $relationship);
1220         }
1221         my %results;
1222         while (    ( $term ne 'urn:lsid:biomoby.org:objectclass:Object' )
1223                         && ( $term ne 'urn:lsid:biomoby.org:servicetype:Service' ) )
1224         {
1225                 my $defs = $self->_doRelationshipsQuery(
1226                                                         $ontology,
1227                                                         $term,
1228                                                         $relationship,
1229                                                         $direction );
1230                 return {[]} unless $defs; # somethig has gone terribly wrong!
1231                 my $lsid;
1232                 my $rel;
1233                 my $articleName;
1234                 foreach ( @{$defs} ) {
1235                         $lsid = $_->[0];
1236                         $rel  = $_->[1];
1237                         $articleName = $_->[2];
1238                         $articleName ||="";
1239                         $debug
1240                           && _LOG("\t\tADDING RELATIONSHIP $_    :    $lsid to $rel\n");
1241                         push @{ $results{$rel} }, [$lsid, $articleName];
1242                 }
1243                 last unless ($expand);
1244                 last unless ( $direction eq "root" ); # if we aren't going to root, then be careful or we'll loop infnitely
1245                 $term = $lsid; # this entire subroutine assumes that there is NOT multiple parenting...
1246         }
1247         return \%results;    #results(relationship} = [[lsid1,articleNmae], [lsid2, articleName], [lsid3, articleName]]
1248 }
1249
1250
1251 =head2 Relationships
1252
1253 =cut
1254
1255 sub Relationships {
1256
1257         # this entire subroutine assumes that there is NOT multiple parenting!!
1258         my ( $self, %args ) = @_;
1259         my $ontology     = $args{ontology} ? $args{ontology} : $self->ontology;
1260         my $term         = $args{term};
1261         my $relationship = $args{relationship};
1262         my $direction    = $args{direction} ? $args{direction} : 'root';
1263         my $expand       = $args{expand} ? 1 : 0;
1264         return
1265           unless (    $ontology
1266                            && $term
1267                            && ( ( $ontology eq 'service' ) || ( $ontology eq 'object' ) ) );
1268
1269         # convert $term into an LSID if it isn't already
1270         if ( $ontology eq 'service' ) {
1271                 $term = $self->getServiceURI($term);
1272                 $relationship ||="isa";
1273                 my $OS = MOBY::OntologyServer->new(ontology => 'relationship');
1274                 $relationship = $OS->getRelationshipURI("service", $relationship);
1275         } elsif ( $ontology eq 'object' ) {
1276                 $term = $self->getObjectURI($term);
1277                 $relationship ||="isa";
1278                 my $OS = MOBY::OntologyServer->new(ontology => 'relationship');
1279                 $relationship = $OS->getRelationshipURI("object", $relationship);
1280         }
1281         my %results = [];
1282         while ($term
1283                 && (!($term =~/urn\:lsid\:biomoby.org\:objectclass\:Object\:/ ))
1284                 && (!($term =~ /urn\:lsid\:biomoby.org\:servicetype\:Service\:/ ) ))
1285         {
1286                 my $defs = $self->_doRelationshipsQuery($ontology,$term,$relationship,$direction );
1287                 next unless $defs; # somethig has gone terribly wrong!
1288                 my $lsid;
1289                 my $rel;
1290                 my $articleName;
1291                 foreach ( @{$defs} ) {
1292                         $lsid = $_->[0];
1293                         $rel  = $_->[1];
1294                         $articleName = $_->[2];
1295                         $articleName ||="";
1296                         if ($ontology eq 'object'){
1297                                 my $info = $self->objectInfo(term => $lsid);  # we need to get the term name, and that doesn't come from here
1298                                 my $term = $info->{object_type};
1299                                 push @{ $results{$rel} }, {lsid => $lsid, articleName => $articleName, term => $term};
1300                         } else {
1301                                 my $info = $self->serviceInfo(term => $lsid);  # we need to get the term name, and that doesn't come from here
1302                                 my $term = $info->{service_type};
1303                                 push @{ $results{$rel} }, {lsid => $lsid, term => $term};
1304                         }
1305                 }
1306                 last unless ($expand);
1307                 last unless ( $direction eq "root" ); # if we aren't going to root, then be careful or we'll loop infnitely
1308                 $term = $lsid; # this entire subroutine assumes that there is NOT multiple parenting...
1309         }
1310         return \%results;
1311 }
1312
1313 sub _doRelationshipsQuery {
1314         my ( $self, $ontology, $term, $relationship, $direction ) = @_;
1315         $CONFIG ||= MOBY::Config->new;    # exported by Config.pm
1316         my $datasource = "moby$ontology";  # like mobyobject, or mobyservice
1317         my $adaptor = $CONFIG->getDataAdaptor( datasource => $datasource );
1318         my $defs;
1319         # query returns a reference to an array containing array references
1320         $defs = $adaptor->get_relationship(direction => $direction,
1321                                            ontology => $ontology,
1322                                            term => $term,
1323                                            relationship => $relationship);
1324         # a very long piece of SQL statements have been refactored into Moby::Adaptor::moby::queryapi::mysql.pm
1325         return $defs;
1326 }
1327
1328 =head2 setURI
1329
1330 =cut
1331
1332 sub setURI {
1333         my ( $self, $id ) = @_;
1334         my $URI;
1335
1336 my ($sec,$min,$hour,$mday,$month,$year, $wday,$yday,$dst) =gmtime(time);
1337 my $date = sprintf ("%02d-%02d-%02dT%02d-%02d-%02dZ",$year+1900,$month+1,$mday,$hour,$min,$sec);
1338
1339         # $id = lc($id);
1340         if ( $self->ontology eq 'object' ) {
1341                 $URI = "urn:lsid:biomoby.org:objectclass:$id:$date";
1342         } elsif ( $self->ontology eq 'namespace' ) {
1343                 $URI = "urn:lsid:biomoby.org:namespacetype:$id:$date";
1344         } elsif ( $self->ontology eq 'service' ) {
1345                 $URI = "urn:lsid:biomoby.org:servicetype:$id:$date";
1346         } elsif ( $self->ontology eq 'relationship' ) {
1347                 $URI = "urn:lsid:biomoby.org:relationshiptype:$id";  # dont' add version info here
1348         } else {
1349                 $URI = 0;
1350         }
1351         return $URI;
1352 }
1353
1354 =head2 traverseDAG
1355
1356 =cut
1357
1358 sub traverseDAG {
1359         my ( $self, $term, $direction ) = @_;
1360         my $ontology = $self->ontology;
1361         return {} unless $ontology;
1362         return {} unless $term;
1363         $direction = "root" unless ($direction);
1364         return {} unless ( ( $direction eq 'root' ) || ( $direction eq 'leaves' ) );
1365         if ( $ontology eq 'service' ) {
1366                 $term = $self->getServiceURI($term);
1367         } elsif ( $ontology eq 'object' ) {
1368                 $term = $self->getObjectURI($term);
1369         }
1370         return {} unless $term =~ /^urn\:lsid/;    # now its a URI
1371         my $relhash = $self->getRelationshipTypes( ontology => $ontology );    # get teh types of relationships for the object/service ontology
1372         return {} unless $relhash;
1373         my @rels = keys %{$relhash};    #@rels is the list of relationship types for that ontology
1374         my %relationships;
1375         foreach my $relationship (@rels) {
1376                 my %IDS;
1377                 my $OS = MOBY::OntologyServer->new( ontology => 'relationship' );
1378                 my $reluri =
1379                   $OS->getRelationshipURI( $ontology, $relationship )
1380                   ;   # get the URI for that relationship type if it ins't already a URI
1381                 $IDS{$term} = "untestedroot";   # mark the one in-hand as being untested
1382                 while ( grep /untested/, ( values %IDS ) )
1383                 {    # now, while there are untested services in our list...
1384                         foreach my $termthingy ( keys %IDS )
1385                         {    # start parsing through the current list (hash keys)
1386                                 $debug && _LOG("testing $relationship of $termthingy\n");
1387                                 next
1388                                   if ( $IDS{$termthingy} eq "tested" )
1389                                   ;    # if it has been tested already then move on
1390                                 my $lsids = $self->Relationships(
1391                                         term         => $termthingy,
1392                                         relationship => $relationship,
1393                                         direction    => $direction
1394                                   )
1395                                   ; # get the related terms for this type; this should return a single hash value
1396                                 if ( $IDS{$termthingy} =~ /root/ )
1397                                 {    # here is where we remove self
1398                                         delete $IDS{$termthingy};
1399                                         $debug && _LOG("deleting $termthingy\n");
1400                                 } else {
1401                                         $debug && _LOG("marking $termthingy as TESTED\n");
1402                                         $IDS{$termthingy} =
1403                                           "tested";    # mark the current one as now being "done"
1404                                 }
1405
1406                                 #${$lsids}{relationshiptype}=[lsid, lsid, lsid];
1407                                 foreach my $lsid_article ( @{ $lsids->{$relationship} } )
1408                                 {                  # go through the related terms
1409                                         my $lsid = $lsid_article->{lsid},
1410                                         my $article = $lsid_article->{articleName};
1411                                         $debug && _LOG("found $lsid as relationship");
1412                                         next
1413                                           if ( defined $IDS{$lsid} )
1414                                           ;            # if we have already seen that term, skip it
1415                                         $debug && _LOG("setting $lsid as untested\n");
1416                                         $IDS{$lsid} =
1417                                           "untested"  # otherwise add it to the list and loop again.
1418                                 }
1419                         }
1420                 }
1421                 my @IDS = keys %IDS;
1422                 $relationships{$relationship} =
1423                   \@IDS;    # and associate them all with the current relationship type
1424         }
1425         return \%relationships;
1426 }
1427
1428 sub _LOG {
1429         return unless $debug;
1430
1431         #print join "\n", @_;
1432         #print  "\n---\n";
1433         #return;
1434         open LOG, ">>/tmp/OntologyServer.txt" or die "can't open logfile $!\n";
1435         print LOG join "\n", @_;
1436         print LOG "\n---\n";
1437         close LOG;
1438 }
1439 sub DESTROY { }
1440
1441 sub AUTOLOAD {
1442         no strict "refs";
1443         my ( $self, $newval ) = @_;
1444         $AUTOLOAD =~ /.*::(\w+)/;
1445         my $attr = $1;
1446         if ( $self->_accessible( $attr, 'write' ) ) {
1447                 *{$AUTOLOAD} = sub {
1448                         if ( defined $_[1] ) { $_[0]->{$attr} = $_[1] }
1449                         return $_[0]->{$attr};
1450                 };    ### end of created subroutine
1451 ###  this is called first time only
1452                 if ( defined $newval ) {
1453                         $self->{$attr} = $newval;
1454                 }
1455                 return $self->{$attr};
1456         } elsif ( $self->_accessible( $attr, 'read' ) ) {
1457                 *{$AUTOLOAD} = sub {
1458                         return $_[0]->{$attr};
1459                 };    ### end of created subroutine
1460                 return $self->{$attr};
1461         }
1462
1463         # Must have been a mistake then...
1464         croak "No such method: $AUTOLOAD";
1465 }
1466 1;