# $Id: RelationshipType.pm 2011-06-06 erick.antezana $
#
# Module  : RelationshipType.pm
# Purpose : Type of relationship in the Ontology: is_a, part_of, etc.
# License : Copyright (c) 2006-2012 by Erick Antezana. All rights reserved.
#           This program is free software; you can redistribute it and/or
#           modify it under the same terms as Perl itself.
# Contact : Erick Antezana <erick.antezana -@- gmail.com>
#
package OBO::Core::RelationshipType;

use Carp;
use strict;
use warnings;

use OBO::Core::Def;
use OBO::Util::Map;
use OBO::Util::SynonymSet;

sub new {
	my $class                   = shift;
	my $self                    = {};

	$self->{ID}                 = undef;                        # required, string (1)
	$self->{IS_ANONYMOUS}       = undef;                        # [1|0], 0 by default
	$self->{NAME}               = undef;                        # string (1)

	$self->{NAMESPACE_SET}      = OBO::Util::Set->new();        # set (0..N)
	$self->{ALT_ID}             = OBO::Util::Set->new();        # set (0..N)
	$self->{BUILTIN}            = undef;                        # [1|0], 0 by default
	$self->{DEF}                = OBO::Core::Def->new();        # (0..1)
	$self->{COMMENT}            = undef;                        # string (0..1)
	$self->{SUBSET_SET}         = OBO::Util::Set->new();        # set of scalars (0..N)
	$self->{SYNONYM_SET}        = OBO::Util::SynonymSet->new(); # set of synonyms (0..N)
	$self->{XREF_SET}           = OBO::Util::DbxrefSet->new();  # set of dbxref's (0..N)
	$self->{DOMAIN}             = OBO::Util::Set->new();        # set of scalars (0..N)
	$self->{RANGE}              = OBO::Util::Set->new();        # set of scalars (0..N)
	$self->{IS_ANTI_SYMMETRIC}  = undef;                        # [1|0], 0 by default
	$self->{IS_CYCLIC}          = undef;                        # [1|0], 0 by default
	$self->{IS_REFLEXIVE}       = undef;                        # [1|0], 0 by default
	$self->{IS_SYMMETRIC}       = undef;                        # [1|0], 0 by default
	$self->{IS_TRANSITIVE}      = undef;                        # [1|0], 0 by default
	$self->{INVERSE_OF}         = undef;                        # string (0..1) # TODO This should be a Set of Relationships...
	$self->{TRANSITIVE_OVER}    = OBO::Util::Set->new();        # set of scalars (0..N)

	$self->{HOLDS_OVER_CHAIN}   = OBO::Util::Map->new();        # map of scalars-->ref's to arrays (0..N)
	$self->{FUNCTIONAL}         = undef;                        # [1|0], 0 by default
	$self->{INVERSE_FUNCTIONAL} = undef;                        # [1|0], 0 by default
	
	$self->{INTERSECTION_OF}    = OBO::Util::Set->new();        # (0..N)
	$self->{UNION_OF}           = OBO::Util::Set->new();        # (0..N)
	$self->{DISJOINT_FROM}      = OBO::Util::Set->new();        # (0..N)

	$self->{CREATED_BY}         = undef;                        # scalar (0..1)
	$self->{CREATION_DATE}      = undef;                        # scalar (0..1)
	$self->{MODIFIED_BY}        = undef;                        # scalar (0..1)
	$self->{MODIFICATION_DATE}  = undef;                        # scalar (0..1)
	$self->{IS_OBSOLETE}        = undef;                        # [1|0], 0 by default
	$self->{REPLACED_BY}        = OBO::Util::Set->new();        # set of scalars (0..N)
	$self->{CONSIDER}           = OBO::Util::Set->new();        # set of scalars (0..N)
	$self->{IS_METADATA_TAG}    = undef;                        # [1|0], 0 by default
	$self->{IS_CLASS_LEVEL}     = undef;                        # [1|0], 0 by default

	bless ($self, $class);
	return $self;
}

=head2 id

  Usage    - print $relationship_type->id()
  Returns  - the relationship type ID
  Args     - the relationship type ID
  Function - gets/sets an ID
  
=cut

sub id {
	if ($_[1]) { $_[0]->{ID} = $_[1] }
	return $_[0]->{ID};
}

=head2 is_anonymous

  Usage    - print $relationship_type->is_anonymous() or $relationship_type->is_anonymous("1")
  Returns  - either 1 (true) or 0 (false)
  Args     - either 1 (true) or 0 (false)
  Function - tells whether this relationship type is anonymous or not.
  
=cut
sub is_anonymous {
	if (defined $_[1] && ($_[1] == 1 || $_[1] == 0)) { $_[0]->{IS_ANONYMOUS} = $_[1] }
    return ($_[0]->{IS_ANONYMOUS} && $_[0]->{IS_ANONYMOUS} == 1)?1:0;
}

=head2 name

  Usage    - print $relationship_type->name()
  Returns  - the name of the relationship type
  Args     - the name of the relationship type
  Function - gets/sets the name of the relationship type
  
=cut

sub name {
	$_[0]->{NAME} = $_[1] if ($_[1]);
	return $_[0]->{NAME};
}

=head2 alt_id

  Usage    - $relationship_type->alt_id() or $relationship_type->alt_id($id1, $id2, $id3, ...)
  Returns  - a set (OBO::Util::Set) with the alternate id(s) of this relationship type
  Args     - the alternate id(s) (string) of this relationship type
  Function - gets/sets the alternate id(s) of this relationship type
  
=cut

sub alt_id {
	my $self = shift;
	if (scalar(@_) > 1) {
   		$self->{ALT_ID}->add_all(@_);
	} elsif (scalar(@_) == 1) {
		$self->{ALT_ID}->add(shift);
	}
	return $self->{ALT_ID};
}

=head2 def

  Usage    - $relationship_type->def() or $relationship_type->def($def)
  Returns  - the definition (OBO::Core::Def) of the relationship type
  Args     - the definition (OBO::Core::Def) of the relationship type
  Function - gets/sets the definition of the relationship type
  
=cut

sub def {
	$_[0]->{DEF} = $_[1] if ($_[1]); 
    return $_[0]->{DEF};
}

=head2 def_as_string

  Usage    - $relationship_type->def_as_string() or $relationship_type->def_as_string("This is a sample", "[APO:ea, PMID:9334324]")
  Returns  - the definition (string) of the relationship type
  Args     - the definition (string) of the relationship type plus the dbxref list describing the source of this definition
  Function - gets/sets the definition of the relationship type
  Remark   - make sure that colons (,) are scaped (\,) when necessary
  
=cut

sub def_as_string {
	my $dbxref_as_string = $_[2];
    if ($_[1] && $dbxref_as_string) {
    	my $def = $_[0]->{DEF};
		$def->text($_[1]);
		my $dbxref_set = OBO::Util::DbxrefSet->new();
		
		my ($e, $entry) = __dbxref($dbxref_set, $dbxref_as_string);
		if ($e == -1) {
			croak "ERROR: Check the 'dbxref' field of '", $entry, "' (term ID = ", $_[0]->id(), ")." ;
		}
		
		$def->dbxref_set($dbxref_set);
	}
	my @result = (); # a Set?
	foreach my $dbxref (sort {lc($a->id()) cmp lc($b->id())} $_[0]->{DEF}->dbxref_set()->get_set()) {
		push @result, $dbxref->as_string();
	}
	my $d = $_[0]->{DEF}->text();
	if (defined $d) {
		return '"'.$_[0]->{DEF}->text().'"'.' ['.join(', ', @result).']';
	} else {
		return '"" ['.join(', ', @result).']';
	}
}

=head2 namespace

  Usage    - $relationship_type->namespace() or $relationship_type->namespace($ns1, $ns2, $ns3, ...)
  Returns  - an array with the namespace to which this relationship type belongs
  Args     - the namespacet(s) to which this relationship type belongs
  Function - gets/sets the namespace(s) to which this relationship type belongs
  
=cut

sub namespace {
	my $self = shift;
	if (scalar(@_) > 1) {
		$self->{NAMESPACE_SET}->add_all(@_);
	} elsif (scalar(@_) == 1) {
		$self->{NAMESPACE_SET}->add(shift);
	}
	return $self->{NAMESPACE_SET}->get_set();
}

=head2 comment

  Usage    - print $relationship_type->comment()
  Returns  - the comment of this relationship type
  Args     - the comment of this relationship type
  Function - gets/sets the comment of this relationship type
  
=cut

sub comment {
    if ($_[1]) { $_[0]->{COMMENT} = $_[1] }
    return $_[0]->{COMMENT};
}

=head2 subset

  Usage    - $relationship_type->subset() or $relationship_type->subset($ss1, $ss2, $ss3, ...)
  Returns  - an array with the subset to which this relationship type belongs
  Args     - the subset(s) to which this relationship type belongs
  Function - gets/sets the subset(s) to which this relationship type belongs
  
=cut
sub subset {
	my $self = shift;
	if (scalar(@_) > 1) {
   		$self->{SUBSET_SET}->add_all(@_);
	} elsif (scalar(@_) == 1) {
		$self->{SUBSET_SET}->add(shift);
	}
	return $self->{SUBSET_SET}->get_set();
}

=head2 synonym_set

  Usage    - $relationship_type->synonym_set() or $relationship_type->synonym_set($synonym1, $synonym2, $synonym3, ...)
  Returns  - an array with the synonym(s) of this relationship type
  Args     - the synonym(s) of this relationship type
  Function - gets/sets the synonym(s) of this relationship type
  Remark1  - if the synonym (text) is already in the set of synonyms of this relationship type, its scope (and their dbxref's) will be updated (provided they have the same synonym type name)
  Remark2  - a synonym text identical to the relationship type name is not added to the set of synonyms of this relationship type
  
=cut

sub synonym_set {
	my $self = shift;
	foreach my $synonym (@_) {
		my $rel_type_name = $self->name();
		if (!defined($rel_type_name)) {
			croak 'The name of this term (', $self->id(), ') is undefined. Add it before adding its synonyms.';
		}
		
		#
		# update the scope (and dbxref's) of a synonym -- if the text and synonym type name are identical in both synonyms
		#
		my $syn_found = 0;
		foreach my $s ($self->{SYNONYM_SET}->get_set()) {
			
			if ($s->def()->text() eq $synonym->def()->text()) {   # if that SYNONYM is already in the set
			
				my $synonym_type_name = $synonym->synonym_type_name();
				my $s_type_name       = $s->synonym_type_name();
				if ($synonym_type_name || $s_type_name) {       # if any of their STN's is defined
					if ($s_type_name && $synonym_type_name && ($s_type_name eq $synonym_type_name)) {   # they should be identical
					
						$s->def()->dbxref_set($synonym->def()->dbxref_set);  # then update its DBXREFs!
						$s->scope($synonym->scope);                          # then update its SCOPE!
					
						$syn_found = 1;
						last;
					}
				} else {
					$s->def()->dbxref_set($synonym->def()->dbxref_set);      # then update its DBXREFs!
					$s->scope($synonym->scope);                              # then update its SCOPE!
				
					$syn_found = 1;
					last;
				}
			}
		}
		
		# do not add 'EXACT' synonyms with the same 'name':
		if (!$syn_found && !($synonym->scope() eq 'EXACT' && $synonym->def()->text() eq $rel_type_name)) {
			$self->{SYNONYM_SET}->add($synonym) || warn "ERROR: the synonym (", $synonym->def()->text(), ") was not added!!"; 
		}
   	}
	return $self->{SYNONYM_SET}->get_set();
}

=head2 synonym_as_string

  Usage    - print $relationship_type->synonym_as_string() or $relationship_type->synonym_as_string("this is a synonym text", "[APO:ea]", "EXACT")
  Returns  - an array with the synonym(s) of this relationship type
  Args     - the synonym text (string), the dbxrefs (string), synonym scope (string) of this relationship type, and optionally the synonym type name (string)
  Function - gets/sets the synonym(s) of this relationship type
  Remark1  - if the synonym (text) is already in the set of synonyms of this relationship type, its scope (and their dbxref's) will be updated (provided they have the same synonym type name)
  Remark2  - a synonym text identical to the relationship type name is not added to the set of synonyms of this relationship type
  
=cut

sub synonym_as_string {
	if ($_[1] && $_[2] && $_[3]) {
		my $synonym = OBO::Core::Synonym->new();
		$synonym->def_as_string($_[1], $_[2]);
		$synonym->scope($_[3]);
		$synonym->synonym_type_name($_[4]); # optional argument
		$_[0]->synonym_set($synonym);
	}
	
	my @sorted_syns = map { $_->[0] }                       # restore original values
					sort { $a->[1] cmp $b->[1] }            # sort
					map  { [$_, lc($_->def_as_string())] }  # transform: value, sortkey
					$_[0]->{SYNONYM_SET}->get_set();
	
	my @result;
	my $s_as_string;
	foreach my $synonym (@sorted_syns) {
		my $syn_scope = $synonym->scope();
		if ($syn_scope) {
			my $syn_type_name = $synonym->synonym_type_name();
			if ($syn_type_name) {
				$s_as_string = ' '.$syn_scope.' '.$syn_type_name;
			} else {
				$s_as_string = ' '.$syn_scope;
			}
		} else {
			# This case should never happen since the SCOPE is mandatory!
			warn "The scope of this synonym is not defined: ", $synonym->def()->text();
		}
		
		push @result, $synonym->def_as_string().$s_as_string;
   	}
	return @result;
}

=head2 xref_set

  Usage    - $relationship_type->xref_set() or $relationship_type->xref_set($dbxref_set)
  Returns  - a Dbxref set with the analogous xref(s) of this relationship type in another vocabulary
  Args     - analogous xref(s) (OBO::Util::DbxrefSet) of this relationship type in another vocabulary
  Function - gets/sets the analogous xref(s) of this relationship type in another vocabulary
  
=cut

sub xref_set {
	$_[0]->{XREF_SET} = $_[1] if ($_[1]);
	return $_[0]->{XREF_SET};
}

=head2 xref_set_as_string

  Usage    - $relationship_type->xref_set_as_string() or $relationship_type->xref_set_as_string("[Reactome:20610, EC:2.3.2.12]")
  Returns  - the dbxref set with the analogous xref(s) of this relationship type; [] if the set is empty
  Args     - the dbxref set with the analogous xref(s) of this relationship type
  Function - gets/sets the dbxref set with the analogous xref(s) of this relationship type
  Remark   - make sure that colons (,) are scaped (\,) when necessary
  
=cut

sub xref_set_as_string {
	my $xref_as_string = $_[1];
	if ($xref_as_string) {
		my $xref_set = $_[0]->{XREF_SET};
		
		my ($e, $entry) = __dbxref($xref_set, $xref_as_string);
		if ($e == -1) {
			croak "ERROR: Check the 'dbxref' field of '", $entry, "' (term ID = ", $_[0]->id(), ")." ;
		}

		$_[0]->{XREF_SET} = $xref_set; # We are overwriting the existing set; otherwise, add the new elements to the existing set!
	}
	my @result = $_[0]->xref_set()->get_set();
}

=head2 domain

  Usage    - print $relationship_type->domain() or $relationship_type->domain($id1, $id2, $id3, ...)
  Returns  - a set (OBO::Util::Set) with the domain(s) to which this relationship type belongs
  Args     - the domain(s) (string) to which this relationship type belongs
  Function - gets/sets the domain(s) to which this relationship type belongs
  
=cut

sub domain {
	my $self = shift;
	if (scalar(@_) > 1) {
   		$self->{DOMAIN}->add_all(@_);
	} elsif (scalar(@_) == 1) {
		$self->{DOMAIN}->add(shift);
	}
	return $self->{DOMAIN};
}

=head2 range

  Usage    - print $relationship_type->range() or $relationship_type->range($id1, $id2, $id3, ...)
  Returns  - a set (OBO::Util::Set) with the range(s) of this relationship type
  Args     - the range(s) (string) of this relationship type
  Function - gets/sets the range(s) of this relationship type
  
=cut

sub range {
	my $self = shift;
	if (scalar(@_) > 1) {
   		$self->{RANGE}->add_all(@_);
	} elsif (scalar(@_) == 1) {
		$self->{RANGE}->add(shift);
	}
	return $self->{RANGE};
}

=head2 inverse_of

  Usage    - $relationship_type->inverse_of() or $relationship_type->inverse_of($inv_rel)
  Returns  - inverse relationship type (OBO::Core::RelationshipType) of this relationship type
  Args     - inverse relationship type (OBO::Core::RelationshipType) of this relationship type
  Function - gets/sets the inverse relationship type of this relationship type
  
=cut

sub inverse_of {
    if ($_[1]) {
		$_[0]->{INVERSE_OF} = $_[1];
		$_[1]->{INVERSE_OF} = $_[0];
		# TODO Test what would happen if we delete any of those two relationships.
	}
    return $_[0]->{INVERSE_OF};
}

=head2 is_cyclic

  Usage    - $relationship_type->is_cyclic()
  Returns  - 1 (true) or 0 (false)
  Args     - 1 (true) or 0 (false)
  Function - tells whether the relationship type is cyclic or not.
  
=cut

sub is_cyclic {
	if (defined $_[1] && ($_[1] == 1 || $_[1] == 0)) { $_[0]->{IS_CYCLIC} = $_[1] }
    return ($_[0]->{IS_CYCLIC} && $_[0]->{IS_CYCLIC} == 1)?1:0;
}

=head2 is_reflexive

  Usage    - $relationship_type->is_reflexive()
  Returns  - 1 (true) or 0 (false)
  Args     - 1 (true) or 0 (false)
  Function - tells whether the relationship type is reflexive or not.
  
=cut

sub is_reflexive {
	if (defined $_[1] && ($_[1] == 1 || $_[1] == 0)) { $_[0]->{IS_REFLEXIVE} = $_[1] }
    return ($_[0]->{IS_REFLEXIVE} && $_[0]->{IS_REFLEXIVE} == 1)?1:0;
}

=head2 is_symmetric

  Usage    - $relationship_type->is_symmetric()
  Returns  - 1 (true) or 0 (false)
  Args     - 1 (true) or 0 (false)
  Function - tells whether the relationship type is symmetric or not.
  
=cut

sub is_symmetric {
	if (defined $_[1] && ($_[1] == 1 || $_[1] == 0)) { $_[0]->{IS_SYMMETRIC} = $_[1] }
    return ($_[0]->{IS_SYMMETRIC} && $_[0]->{IS_SYMMETRIC} == 1)?1:0;
}

=head2 is_anti_symmetric

  Usage    - $relationship_type->is_anti_symmetric()
  Returns  - 1 (true) or 0 (false)
  Args     - 1 (true) or 0 (false)
  Function - tells whether the relationship type is anti symmetric or not.
  
=cut

sub is_anti_symmetric {
	if (defined $_[1] && ($_[1] == 1 || $_[1] == 0)) { $_[0]->{IS_ANTI_SYMMETRIC} = $_[1] }
    return ($_[0]->{IS_ANTI_SYMMETRIC} && $_[0]->{IS_ANTI_SYMMETRIC} == 1)?1:0;
}

=head2 is_transitive

  Usage    - $relationship_type->is_transitive()
  Returns  - 1 (true) or 0 (false)
  Args     - 1 (true) or 0 (false)
  Function - tells whether the relationship type is transitive or not.
  
=cut

sub is_transitive {
	if (defined $_[1] && ($_[1] == 1 || $_[1] == 0)) { $_[0]->{IS_TRANSITIVE} = $_[1] }
    return ($_[0]->{IS_TRANSITIVE} && $_[0]->{IS_TRANSITIVE} == 1)?1:0;
}

=head2 is_metadata_tag

  Usage    - $relationship_type->is_metadata_tag()
  Returns  - 1 (true) or 0 (false)
  Args     - 1 (true) or 0 (false)
  Function - tells whether this relationship type is a metadata tag or not.
  
=cut

sub is_metadata_tag {
	if (defined $_[1] && ($_[1] == 1 || $_[1] == 0)) { $_[0]->{IS_METADATA_TAG} = $_[1] }
    return ($_[0]->{IS_METADATA_TAG} && $_[0]->{IS_METADATA_TAG} == 1)?1:0;
}

=head2 is_class_level

  Usage    - $relationship_type->is_class_level()
  Returns  - 1 (true) or 0 (false)
  Args     - 1 (true) or 0 (false)
  Function - tells whether this relationship type is a class-level relation or not.
  
=cut

sub is_class_level {
	if (defined $_[1] && ($_[1] == 1 || $_[1] == 0)) { $_[0]->{IS_CLASS_LEVEL} = $_[1] }
    return ($_[0]->{IS_CLASS_LEVEL} && $_[0]->{IS_CLASS_LEVEL} == 1)?1:0;
}

=head2 transitive_over

  Usage    - $relationship_type->transitive_over() or $relationship_type->transitive_over($id1, $id2, $id3, ...)
  Returns  - a set (OBO::Util::Set) with the relationship type(s) for which this relationship type is(are) transitive over
  Args     - the relationship type(s) (string) with which this one is transitive over
  Function - gets/sets the set of the relationship type(s) for which this relationship type is(are) transitive over
  
=cut

sub transitive_over {
	my $self = shift;
	if (scalar(@_) > 1) {
   		$self->{TRANSITIVE_OVER}->add_all(@_);
	} elsif (scalar(@_) == 1) {
		$self->{TRANSITIVE_OVER}->add(shift);
	}
	return $self->{TRANSITIVE_OVER};
}

=head2 holds_over_chain

  Usage    - $relationship_type->holds_over_chain() or $relationship_type->holds_over_chain($rt1, $rt2)
  Returns  - an array of pairs (string) with the relationship type identifiers for which this relationship type holds over a chain
  Args     - the relationship type identifiers (string) with which this one holds over a chain
  Function - gets/sets the set of the relationship types for which this relationship type holds over a chain
  
=cut

sub holds_over_chain {
	my $self = shift;
	my $composition_symbol = '&&';
	if (scalar(@_) == 2) {
		my $key = $_[0].$composition_symbol.$_[1]; # R<-R1&&R2
		$self->{HOLDS_OVER_CHAIN}->put($key, \@_);
	}
	return $self->{HOLDS_OVER_CHAIN}->values();
}

=head2 functional

  Usage    - $relationship_type->functional() or $relationship_type->functional(1) or $relationship_type->functional(0)
  Returns  - tells if this relationship type is functional; false by default
  Args     - 1 (true) or 0 (false)
  Function - gets/sets the value indicating whether this relationship type is functional
  
=cut

sub functional {
	if (defined $_[1] && ($_[1] == 1 || $_[1] == 0)) { $_[0]->{FUNCTIONAL} = $_[1] }
    return ($_[0]->{FUNCTIONAL} && $_[0]->{FUNCTIONAL} == 1)?1:0;
}

=head2 inverse_functional

  Usage    - $relationship_type->inverse_functional() or $relationship_type->inverse_functional(1) or $relationship_type->inverse_functional(0)
  Returns  - tells if this relationship type is inverse functional; false by default
  Args     - 1 (true) or 0 (false)
  Function - gets/sets the value indicating whether this relationship type is inverse functional
  
=cut

sub inverse_functional {
	if (defined $_[1] && ($_[1] == 1 || $_[1] == 0)) { $_[0]->{INVERSE_FUNCTIONAL} = $_[1] }
    return ($_[0]->{INVERSE_FUNCTIONAL} && $_[0]->{INVERSE_FUNCTIONAL} == 1)?1:0;
}

=head2 intersection_of
        
  Usage    - $relationship_type->intersection_of() or $relationship_type->intersection_of($t1, $t2, $r1, ...)
  Returns  - an array with the terms/relations which define this relationship type
  Args     - a set (strings) of terms/relations which define this relationship type
  Function - gets/sets the set of terms/relatonships defining this relationship type
        
=cut
sub intersection_of {
	my $self = shift;
	if (scalar(@_) > 1) {
		$self->{INTERSECTION_OF}->add_all(@_);
	} elsif (scalar(@_) == 1) {
		$self->{INTERSECTION_OF}->add(shift);
	}
	return $self->{INTERSECTION_OF}->get_set();
}

=head2 union_of
        
  Usage    - $relationship_type->union_of() or $relationship_type->union_of($t1, $t2, $r1, ...)
  Returns  - an array with the terms/relations which define this relationship type
  Args     - a set (strings) of terms/relations which define this relationship type
  Function - gets/sets the set of terms/relatonships defining this relationship type
        
=cut    
sub union_of {
	my $self = shift;
	if (scalar(@_) > 1) {
		$self->{UNION_OF}->add_all(@_);
	} elsif (scalar(@_) == 1) { 
		$self->{UNION_OF}->add(shift);
	}
	return $self->{UNION_OF}->get_set();
} 

=head2 disjoint_from

  Usage    - $relationship_type->disjoint_from() or $relationship_type->disjoint_from($disjoint_term_id1, $disjoint_term_id2, $disjoint_term_id3, ...)
  Returns  - the disjoint relationship type id(s) (string(s)) from this one
  Args     - the relationship type id(s) (string) that is (are) disjoint from this one
  Function - gets/sets the disjoint relationship type(s) from this one
  
=cut
sub disjoint_from {
	my $self = shift;
	if (scalar(@_) > 1) {
   		$self->{DISJOINT_FROM}->add_all(@_);
	} elsif (scalar(@_) == 1) {
		$self->{DISJOINT_FROM}->add(shift);
	}
	return $self->{DISJOINT_FROM}->get_set();
}

=head2 created_by

  Usage    - print $relationship_type->created_by() or $relationship_type->created_by("erick_antezana")
  Returns  - name (string) of the creator of the relationship type, may be a short username, initials or ID
  Args     - name (string) of the creator of the relationship type, may be a short username, initials or ID
  Function - gets/sets the name of the creator of the relationship type
  
=cut
sub created_by {
	$_[0]->{CREATED_BY} = $_[1] if ($_[1]);
	return $_[0]->{CREATED_BY};
}

=head2 creation_date

  Usage    - print $relationship_type->creation_date() or $relationship_type->creation_date("2010-04-13T01:32:36Z")
  Returns  - date (string) of creation of the relationship type specified in ISO 8601 format
  Args     - date (string) of creation of the relationship type specified in ISO 8601 format
  Function - gets/sets the date of creation of the relationship type
  
=cut
sub creation_date {
	$_[0]->{CREATION_DATE} = $_[1] if ($_[1]);
	return $_[0]->{CREATION_DATE};
}

=head2 modified_by

  Usage    - print $relationship_type->modified_by() or $relationship_type->modified_by("erick_antezana")
  Returns  - name (string) of the modificator of the relationship type, may be a short username, initials or ID
  Args     - name (string) of the modificator of the relationship type, may be a short username, initials or ID
  Function - gets/sets the name of the modificator of the relationship type
  
=cut
sub modified_by {
	$_[0]->{MODIFIED_BY} = $_[1] if ($_[1]);
	return $_[0]->{MODIFIED_BY};
}

=head2 modification_date

  Usage    - print $relationship_type->modification_date() or $relationship_type->modification_date("2010-04-13T01:32:36Z")
  Returns  - date (string) of modification of the relationship type specified in ISO 8601 format
  Args     - date (string) of modification of the relationship type specified in ISO 8601 format
  Function - gets/sets the date of modification of the relationship type
  
=cut
sub modification_date {
	$_[0]->{MODIFICATION_DATE} = $_[1] if ($_[1]);
	return $_[0]->{MODIFICATION_DATE};
}

=head2 is_obsolete

  Usage    - print $relationship_type->is_obsolete()
  Returns  - either 1 (true) or 0 (false)
  Args     - either 1 (true) or 0 (false)
  Function - tells whether the relationship type is obsolete or not. 'false' by default.
  
=cut

sub is_obsolete {
	if (defined $_[1] && ($_[1] == 1 || $_[1] == 0)) { $_[0]->{IS_OBSOLETE} = $_[1] }
    return ($_[0]->{IS_OBSOLETE} && $_[0]->{IS_OBSOLETE} == 1)?1:0;
}

=head2 replaced_by

  Usage    - $relationship_type->replaced_by() or $relationship_type->replaced_by($id1, $id2, $id3, ...)
  Returns  - a set (OBO::Util::Set) with the id(s) of the replacing relationship type(s)
  Args     - the the id(s) of the replacing relationship type(s) (string)
  Function - gets/sets the the id(s) of the replacing relationship type(s)
  
=cut

sub replaced_by {
	my $self = shift;
	if (scalar(@_) > 1) {
   		$self->{REPLACED_BY}->add_all(@_);
	} elsif (scalar(@_) == 1) {
		$self->{REPLACED_BY}->add(shift);
	}
	return $self->{REPLACED_BY};
}

=head2 consider

  Usage    - $relationship_type->consider() or $relationship_type->consider($id1, $id2, $id3, ...)
  Returns  - a set (OBO::Util::Set) with the appropiate substitute(s) for an obsolete relationship type
  Args     - the appropiate substitute(s) for an obsolete relationship type (string)
  Function - gets/sets the appropiate substitute(s) for this obsolete relationship type
  
=cut

sub consider {
	my $self = shift;
	if (scalar(@_) > 1) {
   		$self->{CONSIDER}->add_all(@_);
	} elsif (scalar(@_) == 1) {
		$self->{CONSIDER}->add(shift);
	}
	return $self->{CONSIDER};
}

=head2 builtin

  Usage    - $relationship_type->builtin() or $relationship_type->builtin(1) or $relationship_type->builtin(0)
  Returns  - tells if this relationship type is builtin to the OBO format; false by default
  Args     - 1 (true) or 0 (false)
  Function - gets/sets the value indicating whether this relationship type is builtin to the OBO format
  
=cut

sub builtin {
	if (defined $_[1] && ($_[1] == 1 || $_[1] == 0)) { $_[0]->{BUILTIN} = $_[1] }
    return ($_[0]->{BUILTIN} && $_[0]->{BUILTIN} == 1)?1:0;
}

=head2 equals

  Usage    - print $relationship_type->equals($another_relationship_type)
  Returns  - either 1 (true) or 0 (false)
  Args     - the relationship type (OBO::Core::RelationshipType) to compare with
  Function - tells whether this relationship type is equal to the parameter
  
=cut

sub equals  {
	my $result = 0;

   	if ($_[1] && eval { $_[1]->isa('OBO::Core::RelationshipType') }) {
		my $self_id   = $_[0]->{'ID'};
		my $target_id = $_[1]->{'ID'};
		
		croak 'The ID of this relationship type is not defined.' if (!defined($self_id));
		croak 'The ID of the target relationship type is not defined.' if (!defined($target_id));
		
		$result = ($self_id eq $target_id);
	} else {
		croak "An unrecognized object type (not a OBO::Core::RelationshipType) was found: '", $_[1], "'";
	}
	return $result;
}

sub __dbxref () {
	caller eq __PACKAGE__ or croak "You cannot call this (__dbxref) prived method!";
	#
	# $_[0] ==> set
	# $_[1] ==> dbxref string
	#
	my $dbxref_set       = $_[0];
	my $dbxref_as_string = $_[1];
	
	$dbxref_as_string =~ s/^\[//;
	$dbxref_as_string =~ s/\]$//;
	$dbxref_as_string =~ s/\\,/;;;;/g;  # trick to keep the comma's
	$dbxref_as_string =~ s/\\"/;;;;;/g; # trick to keep the double quote's
	
	my @lineas = $dbxref_as_string =~ /\"([^\"]*)\"/g; # get the double-quoted pieces
	foreach my $l (@lineas) {
		my $cp = $l;
		$l =~ s/,/;;;;/g; # trick to keep the comma's
		$dbxref_as_string =~ s/\Q$cp\E/$l/;
	}
	
	my @dbxrefs = split (',', $dbxref_as_string);
	
	my $r_db_acc      = qr/([ \*\.\w-]*):([ '\#~\w:\\\+\?\{\}\$\/\(\)\[\]\.=&!%_-]*)/o;
	my $r_desc        = qr/\s+\"([^\"]*)\"/o;
	my $r_mod         = qr/\s+(\{[\w ]+=[\w ]+\})/o;
	
	foreach my $entry (@dbxrefs) {
		my ($match, $db, $acc, $desc, $mod) = undef;
		my $dbxref = OBO::Core::Dbxref->new();
		if ($entry =~ m/$r_db_acc$r_desc$r_mod?/) {
			$db    = __unescape($1);
			$acc   = __unescape($2);
			$desc  = __unescape($3);
			$mod   = __unescape($4) if ($4);
		} elsif ($entry =~ m/$r_db_acc$r_desc?$r_mod?/) {
			$db    = __unescape($1);
			$acc   = __unescape($2);
			$desc  = __unescape($3) if ($3);
			$mod   = __unescape($4) if ($4);
		} else {
			return (-1, $entry);
		}
		
		# set the dbxref:
		$dbxref->name($db.':'.$acc);
		$dbxref->description($desc) if (defined $desc);
		$dbxref->modifier($mod) if (defined $mod);
		$dbxref_set->add($dbxref);
	}
	return 1;
}

sub __unescape {
	caller eq __PACKAGE__ or die;
	my $match = $_[0];
	$match =~ s/;;;;;/\\"/g;
	$match =~ s/;;;;/\\,/g;
	return $match;
}

1;

__END__


=head1 NAME

OBO::Core::RelationshipType - A type of relationship type in an ontology.
    
=head1 SYNOPSIS

use OBO::Core::RelationshipType;

use strict;


# three new relationships types

my $r1 = OBO::Core::RelationshipType->new();

my $r2 = OBO::Core::RelationshipType->new();

my $r3 = OBO::Core::RelationshipType->new();


$r1->id("APO:R0000001");

$r2->id("APO:R0000002");

$r3->id("APO:R0000003");


$r1->name("is a");

$r2->name("part of");

$r3->name("participates in");


# rel. type creator + date

$r1->created_by("erick_antezana");

$r1->creation_date("2008-04-13T01:32:36Z ");


# inverse

my $r3_inv = OBO::Core::RelationshipType->new();

$r3_inv->id("APO:R0000004");

$r3_inv->name("has participant");

$r3_inv->inverse_of($r3);


# def as string

$r2->def_as_string("This is a dummy definition", '[APO:vm, APO:ls, APO:ea "Erick Antezana"]');

my @refs_r2 = $r2->def()->dbxref_set()->get_set();

my %r_r2;

foreach my $ref_r2 (@refs_r2) {
	
	$r_r2{$ref_r2->name()} = $ref_r2->name();
	
}


=head1 DESCRIPTION

A type of relationship in the ontology.

=head1 AUTHOR

Erick Antezana, E<lt>erick.antezana -@- gmail.comE<gt>

=head1 COPYRIGHT AND LICENSE

Copyright (c) 2006-2012 by Erick Antezana

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself, either Perl version 5.8.7 or,
at your option, any later version of Perl 5 you may have available.

=cut