File Coverage

blib/lib/OBO/Core/Relationship.pm
Criterion Covered Total %
statement 37 38 97.3
branch 13 18 72.2
condition 2 6 33.3
subroutine 10 10 100.0
pod 6 7 85.7
total 68 79 86.0


line stmt bran cond sub pod time code
1             # $Id: Relationship.pm 2014-11-14 erick.antezana $
2             #
3             # Module : Relationship.pm
4             # Purpose : Relationship in the Ontology.
5             # License : Copyright (c) 2006-2015 by Erick Antezana. All rights reserved.
6             # This program is free software; you can redistribute it and/or
7             # modify it under the same terms as Perl itself.
8             # Contact : Erick Antezana
9             #
10             package OBO::Core::Relationship;
11              
12 11     11   7856 use Carp;
  11         22  
  11         766  
13 11     11   60 use strict;
  11         22  
  11         238  
14 11     11   64 use warnings;
  11         23  
  11         5480  
15              
16             sub new {
17 3367     3367 0 4938 my $class = shift;
18 3367         5765 my $self = {};
19            
20 3367         6865 $self->{ID} = undef; # required, string (1)
21 3367         4764 $self->{TYPE} = undef; # required, string (1)
22            
23 3367         4596 $self->{HEAD} = undef; # required, OBO::Core::Term or OBO::Core::RelationshipType or OBO::Core::Term (1: instance_of) or OBO::Core::Instance or OBO::Util::Datatype (TODO) or OBO::Util::Datatype (TODO: property_value: shoe_size "8" xsd:positiveInteger)
24             # ^^ ^^ ^^ ^^ ^^ ^^
25             # || || || || || ||
26 3367         5231 $self->{TAIL} = undef; # required, OBO::Core::Term or OBO::Core::RelationshipType or OBO::Core::Instance (1: instance_of) or OBO::Core::Term or OBO::Core::Term (TODO) or OBO::Core::Instance (TODO)
27            
28 3367         5002 bless ($self, $class);
29 3367         7876 return $self;
30             }
31              
32             =head2 id
33              
34             Usage - print $relationship->id() or $relationship->id($id)
35             Returns - the relationship ID (string)
36             Args - the relationship ID (string)
37             Function - gets/sets an ID
38            
39             =cut
40              
41             sub id {
42 17712 100   17712 1 40459 $_[0]->{ID} = $_[1] if ($_[1]);
43 17712         49020 return $_[0]->{ID};
44             }
45              
46             =head2 type
47              
48             Usage - $relationship->type('is_a') or print $relationship->type()
49             Returns - the type of the relationship (string)
50             Args - the type of the relationship (string)
51             Function - gets/sets the type of the relationship
52             Remark - this field corresponds to the relationship type ID (c.f. OBO::Core::RelationshipType::id())
53            
54             =cut
55              
56             sub type {
57 153434 100   153434 1 295491 $_[0]->{TYPE} = $_[1] if ($_[1]);
58 153434         669933 return $_[0]->{TYPE};
59             }
60              
61             =head2 equals
62              
63             Usage - print $relationship->equals($another_relationship)
64             Returns - either 1 (true) or 0 (false)
65             Args - the relationship (OBO::Core::Relationship) to compare with
66             Function - tells whether this relationship is equal to the parameter
67            
68             =cut
69              
70             sub equals {
71 4     4 1 11 my $result = 0;
72 4 50       15 if ($_[1]) {
73 4 50 33     29 if ($_[1] && eval { $_[1]->isa('OBO::Core::Relationship') }) {
  4         39  
74 4         9 my $self_id = $_[0]->{'ID'};
75 4         8 my $target_id = $_[1]->{'ID'};
76            
77 4 50       15 croak 'The ID of this relationship is not defined.' if (!defined($self_id));
78 4 50       13 croak 'The ID of the target relationship is not defined.' if (!defined($target_id));
79            
80 4         11 $result = ($self_id eq $target_id);
81             } else {
82 0         0 croak "An unrecognized object type (not a OBO::Core::Relationship) was found: '", $_[1], "'";
83             }
84             }
85 4         21 return $result;
86             }
87              
88             =head2 head
89              
90             Usage - $relationship->head($object) or $relationship->head()
91             Returns - the OBO::Core::Term (object or target) or OBO::Core::RelationshipType (object or target) targeted by this relationship
92             Args - the target term (OBO::Core::Term) or the target relationship type (OBO::Core::RelationshipType)
93             Function - gets/sets the term/relationship type attached to the head of the relationship
94            
95             =cut
96              
97             sub head {
98 56614 100   56614 1 112962 $_[0]->{HEAD} = $_[1] if ($_[1]);
99 56614         180711 return $_[0]->{HEAD};
100             }
101              
102             =head2 tail
103              
104             Usage - $relationship->tail($subject) or $relationship->tail()
105             Returns - the OBO::Core::Term (subject or source) or OBO::Core::RelationshipType (subject or source) sourced by this relationship or the OBO::Core::Instance (subject or source)
106             Args - the source term (OBO::Core::Term) or the source relationship type (OBO::Core::RelationshipType) or the source instance (OBO::Core::Instance)
107             Function - gets/sets the term/relationship type/instance attached to the tail of the relationship
108            
109             =cut
110              
111             sub tail {
112 8279 100   8279 1 17591 $_[0]->{TAIL} = $_[1] if ($_[1]);
113 8279         18650 return $_[0]->{TAIL};
114             }
115              
116             =head2 link
117              
118             Usage - $relationship->link($tail, $head) or $relationship->link()
119             Returns - the two Terms (OBO::Core::Term) or two RelationshipTypes (OBO::Core::RelationshipType) or an Instance (OBO::Core::Instance) and a Term (OBO::Core::Term) --subject and source-- connected by this relationship
120             Args - the source (tail, OBO::Core::Term/OBO::Core::RelationshipType) and target(head, OBO::Core::Term/OBO::Core::RelationshipType) term/relationship type
121             Function - gets/sets the terms/relationship type attached to this relationship
122            
123             =cut
124              
125             sub link {
126 3453 50 33 3453 1 15790 ($_[0]->{TAIL}, $_[0]->{HEAD}) = ($_[1], $_[2]) if ($_[1] && $_[2]);
127 3453         7836 return ($_[0]->{TAIL}, $_[0]->{HEAD});
128             }
129              
130             1;
131              
132             __END__