File Coverage

blib/lib/OBO/Core/RelationshipType.pm
Criterion Covered Total %
statement 270 296 91.2
branch 116 166 69.8
condition 83 135 61.4
subroutine 48 48 100.0
pod 39 40 97.5
total 556 685 81.1


line stmt bran cond sub pod time code
1             # $Id: RelationshipType.pm 2011-06-06 erick.antezana $
2             #
3             # Module : RelationshipType.pm
4             # Purpose : Type of relationship in the Ontology: is_a, part_of, etc.
5             # License : Copyright (c) 2006-2014 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::RelationshipType;
11              
12 9     9   6342 use Carp;
  9         15  
  9         648  
13 9     9   51 use strict;
  9         15  
  9         465  
14 9     9   42 use warnings;
  9         13  
  9         262  
15              
16 9     9   803 use OBO::Core::Def;
  9         14  
  9         262  
17 9     9   694 use OBO::Util::Map;
  9         14  
  9         339  
18 9     9   686 use OBO::Util::SynonymSet;
  9         12  
  9         35908  
19              
20             sub new {
21 183     183 0 324 my $class = shift;
22 183         227 my $self = {};
23              
24 183         307 $self->{ID} = undef; # required, string (1)
25 183         242 $self->{IS_ANONYMOUS} = undef; # [1|0], 0 by default
26 183         199 $self->{NAME} = undef; # string (1)
27              
28 183         483 $self->{NAMESPACE_SET} = OBO::Util::Set->new(); # set (0..N)
29 183         359 $self->{ALT_ID} = OBO::Util::Set->new(); # set (0..N)
30 183         229 $self->{BUILTIN} = undef; # [1|0], 0 by default
31 183         486 $self->{DEF} = OBO::Core::Def->new(); # (0..1)
32 183         366 $self->{COMMENT} = undef; # string (0..1)
33 183         377 $self->{SUBSET_SET} = OBO::Util::Set->new(); # set of scalars (0..N)
34 183         418 $self->{SYNONYM_SET} = OBO::Util::SynonymSet->new(); # set of synonyms (0..N)
35 183         393 $self->{XREF_SET} = OBO::Util::DbxrefSet->new(); # set of dbxref's (0..N)
36 183         356 $self->{DOMAIN} = OBO::Util::Set->new(); # set of scalars (0..N)
37 183         364 $self->{RANGE} = OBO::Util::Set->new(); # set of scalars (0..N)
38 183         353 $self->{IS_ANTI_SYMMETRIC} = undef; # [1|0], 0 by default
39 183         224 $self->{IS_CYCLIC} = undef; # [1|0], 0 by default
40 183         411 $self->{IS_REFLEXIVE} = undef; # [1|0], 0 by default
41 183         217 $self->{IS_SYMMETRIC} = undef; # [1|0], 0 by default
42 183         219 $self->{IS_TRANSITIVE} = undef; # [1|0], 0 by default
43 183         200 $self->{INVERSE_OF} = undef; # string (0..1) # TODO This should be a Set of Relationships...
44 183         349 $self->{TRANSITIVE_OVER} = OBO::Util::Set->new(); # set of scalars (0..N)
45              
46 183         497 $self->{HOLDS_OVER_CHAIN} = OBO::Util::Map->new(); # map of scalars-->ref's to arrays (0..N)
47 183         231 $self->{IS_FUNCTIONAL} = undef; # [1|0], 0 by default
48 183         218 $self->{IS_INVERSE_FUNCTIONAL} = undef; # [1|0], 0 by default
49            
50 183         362 $self->{INTERSECTION_OF} = OBO::Util::Set->new(); # (0..N)
51 183         472 $self->{UNION_OF} = OBO::Util::Set->new(); # (0..N)
52 183         348 $self->{DISJOINT_FROM} = OBO::Util::Set->new(); # (0..N)
53              
54 183         226 $self->{CREATED_BY} = undef; # scalar (0..1)
55 183         214 $self->{CREATION_DATE} = undef; # scalar (0..1)
56 183         208 $self->{MODIFIED_BY} = undef; # scalar (0..1)
57 183         171 $self->{MODIFICATION_DATE} = undef; # scalar (0..1)
58 183         196 $self->{IS_OBSOLETE} = undef; # [1|0], 0 by default
59 183         332 $self->{REPLACED_BY} = OBO::Util::Set->new(); # set of scalars (0..N)
60 183         369 $self->{CONSIDER} = OBO::Util::Set->new(); # set of scalars (0..N)
61 183         263 $self->{IS_METADATA_TAG} = undef; # [1|0], 0 by default
62 183         202 $self->{IS_CLASS_LEVEL} = undef; # [1|0], 0 by default
63              
64 183         267 bless ($self, $class);
65 183         404 return $self;
66             }
67              
68             =head2 id
69              
70             Usage - print $relationship_type->id()
71             Returns - the relationship type ID
72             Args - the relationship type ID
73             Function - gets/sets an ID
74            
75             =cut
76              
77             sub id {
78 227831 100   227831 1 284276 if ($_[1]) { $_[0]->{ID} = $_[1] }
  183         366  
79 227831         381685 return $_[0]->{ID};
80             }
81              
82             =head2 is_anonymous
83              
84             Usage - print $relationship_type->is_anonymous() or $relationship_type->is_anonymous("1")
85             Returns - either 1 (true) or 0 (false)
86             Args - either 1 (true) or 0 (false)
87             Function - tells whether this relationship type is anonymous or not.
88            
89             =cut
90             sub is_anonymous {
91 177 50 66 177 1 333 if (defined $_[1] && ($_[1] == 1 || $_[1] == 0)) { $_[0]->{IS_ANONYMOUS} = $_[1] }
  10   66     14  
92 177 100 66     669 return ($_[0]->{IS_ANONYMOUS} && $_[0]->{IS_ANONYMOUS} == 1)?1:0;
93             }
94              
95             =head2 name
96              
97             Usage - print $relationship_type->name()
98             Returns - the name of the relationship type
99             Args - the name of the relationship type
100             Function - gets/sets the name of the relationship type
101            
102             =cut
103              
104             sub name {
105 54498 100   54498 1 75845 $_[0]->{NAME} = $_[1] if ($_[1]);
106 54498         113895 return $_[0]->{NAME};
107             }
108              
109             =head2 alt_id
110              
111             Usage - $relationship_type->alt_id() or $relationship_type->alt_id($id1, $id2, $id3, ...)
112             Returns - a set (OBO::Util::Set) with the alternate id(s) of this relationship type
113             Args - the alternate id(s) (string) of this relationship type
114             Function - gets/sets the alternate id(s) of this relationship type
115            
116             =cut
117              
118             sub alt_id {
119 191     191 1 182 my $self = shift;
120 191 50       424 if (scalar(@_) > 1) {
    50          
121 0         0 $self->{ALT_ID}->add_all(@_);
122             } elsif (scalar(@_) == 1) {
123 0         0 $self->{ALT_ID}->add(shift);
124             }
125 191         409 return $self->{ALT_ID};
126             }
127              
128             =head2 def
129              
130             Usage - $relationship_type->def() or $relationship_type->def($def)
131             Returns - the definition (OBO::Core::Def) of the relationship type
132             Args - the definition (OBO::Core::Def) of the relationship type
133             Function - gets/sets the definition of the relationship type
134            
135             =cut
136              
137             sub def {
138 376 100   376 1 636 $_[0]->{DEF} = $_[1] if ($_[1]);
139 376         1125 return $_[0]->{DEF};
140             }
141              
142             =head2 def_as_string
143              
144             Usage - $relationship_type->def_as_string() or $relationship_type->def_as_string("This is a sample", "[APO:ea, PMID:9334324]")
145             Returns - the definition (string) of the relationship type
146             Args - the definition (string) of the relationship type plus the dbxref list describing the source of this definition
147             Function - gets/sets the definition of the relationship type
148             Remark - make sure that colons (,) are scaped (\,) when necessary
149            
150             =cut
151              
152             sub def_as_string {
153 38     38 1 48 my $dbxref_as_string = $_[2];
154 38 100 66     306 if ($_[1] && $dbxref_as_string) {
155 2         4 my $def = $_[0]->{DEF};
156 2         5 $def->text($_[1]);
157 2         6 my $dbxref_set = OBO::Util::DbxrefSet->new();
158            
159 2         6 my ($e, $entry) = __dbxref($dbxref_set, $dbxref_as_string);
160 2 50       4 if ($e == -1) {
161 0         0 croak "ERROR: Check the 'dbxref' field of '", $entry, "' (term ID = ", $_[0]->id(), ")." ;
162             }
163            
164 2         5 $def->dbxref_set($dbxref_set);
165             }
166 38         53 my @result = (); # a Set?
167 38         100 foreach my $dbxref (sort {lc($a->id()) cmp lc($b->id())} $_[0]->{DEF}->dbxref_set()->get_set()) {
  5         9  
168 40         88 push @result, $dbxref->as_string();
169             }
170 38         96 my $d = $_[0]->{DEF}->text();
171 38 50       67 if (defined $d) {
172 38         76 return '"'.$_[0]->{DEF}->text().'"'.' ['.join(', ', @result).']';
173             } else {
174 0         0 return '"" ['.join(', ', @result).']';
175             }
176             }
177              
178             =head2 namespace
179              
180             Usage - $relationship_type->namespace() or $relationship_type->namespace($ns1, $ns2, $ns3, ...)
181             Returns - an array with the namespace to which this relationship type belongs
182             Args - the namespacet(s) to which this relationship type belongs
183             Function - gets/sets the namespace(s) to which this relationship type belongs
184            
185             =cut
186              
187             sub namespace {
188 191     191 1 196 my $self = shift;
189 191 50       437 if (scalar(@_) > 1) {
    50          
190 0         0 $self->{NAMESPACE_SET}->add_all(@_);
191             } elsif (scalar(@_) == 1) {
192 0         0 $self->{NAMESPACE_SET}->add(shift);
193             }
194 191         451 return $self->{NAMESPACE_SET}->get_set();
195             }
196              
197             =head2 comment
198              
199             Usage - print $relationship_type->comment()
200             Returns - the comment of this relationship type
201             Args - the comment of this relationship type
202             Function - gets/sets the comment of this relationship type
203            
204             =cut
205              
206             sub comment {
207 291 100   291 1 523 if ($_[1]) { $_[0]->{COMMENT} = $_[1] }
  36         107  
208 291         1106 return $_[0]->{COMMENT};
209             }
210              
211             =head2 subset
212              
213             Usage - $relationship_type->subset() or $relationship_type->subset($ss1, $ss2, $ss3, ...)
214             Returns - an array with the subset to which this relationship type belongs
215             Args - the subset(s) to which this relationship type belongs
216             Function - gets/sets the subset(s) to which this relationship type belongs
217            
218             =cut
219             sub subset {
220 171     171 1 263 my $self = shift;
221 171 100       433 if (scalar(@_) > 1) {
    100          
222 1         4 $self->{SUBSET_SET}->add_all(@_);
223             } elsif (scalar(@_) == 1) {
224 2         7 $self->{SUBSET_SET}->add(shift);
225             }
226 171         404 return $self->{SUBSET_SET}->get_set();
227             }
228              
229             =head2 synonym_set
230              
231             Usage - $relationship_type->synonym_set() or $relationship_type->synonym_set($synonym1, $synonym2, $synonym3, ...)
232             Returns - an array with the synonym(s) of this relationship type
233             Args - the synonym(s) of this relationship type
234             Function - gets/sets the synonym(s) of this relationship type
235             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)
236             Remark2 - a synonym text identical to the relationship type name is not added to the set of synonyms of this relationship type
237            
238             =cut
239              
240             sub synonym_set {
241 235     235 1 269 my $self = shift;
242 235         337 foreach my $synonym (@_) {
243 28         59 my $rel_type_name = $self->name();
244 28 50       68 if (!defined($rel_type_name)) {
245 0         0 croak 'The name of this term (', $self->id(), ') is undefined. Add it before adding its synonyms.';
246             }
247            
248             #
249             # update the scope (and dbxref's) of a synonym -- if the text and synonym type name are identical in both synonyms
250             #
251 28         27 my $syn_found = 0;
252 28         281 foreach my $s ($self->{SYNONYM_SET}->get_set()) {
253            
254 18 100       39 if ($s->def()->text() eq $synonym->def()->text()) { # if that SYNONYM is already in the set
255            
256 7         13 my $synonym_type_name = $synonym->synonym_type_name();
257 7         10 my $s_type_name = $s->synonym_type_name();
258 7 100 66     18 if ($synonym_type_name || $s_type_name) { # if any of their STN's is defined
259 5 100 66     24 if ($s_type_name && $synonym_type_name && ($s_type_name eq $synonym_type_name)) { # they should be identical
      100        
260            
261 1         3 $s->def()->dbxref_set($synonym->def()->dbxref_set); # then update its DBXREFs!
262 1         3 $s->scope($synonym->scope); # then update its SCOPE!
263            
264 1         1 $syn_found = 1;
265 1         1 last;
266             }
267             } else {
268 2         5 $s->def()->dbxref_set($synonym->def()->dbxref_set); # then update its DBXREFs!
269 2         6 $s->scope($synonym->scope); # then update its SCOPE!
270            
271 2         2 $syn_found = 1;
272 2         3 last;
273             }
274             }
275             }
276            
277             # do not add 'EXACT' synonyms with the same 'name':
278 28 50 66     145 if (!$syn_found && !($synonym->scope() eq 'EXACT' && $synonym->def()->text() eq $rel_type_name)) {
      66        
279 25 50       92 $self->{SYNONYM_SET}->add($synonym) || warn "ERROR: the synonym (", $synonym->def()->text(), ") was not added!!";
280             }
281             }
282 235         576 return $self->{SYNONYM_SET}->get_set();
283             }
284              
285             =head2 synonym_as_string
286              
287             Usage - print $relationship_type->synonym_as_string() or $relationship_type->synonym_as_string("this is a synonym text", "[APO:ea]", "EXACT")
288             Returns - an array with the synonym(s) of this relationship type
289             Args - the synonym text (string), the dbxrefs (string), synonym scope (string) of this relationship type, and optionally the synonym type name (string)
290             Function - gets/sets the synonym(s) of this relationship type
291             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)
292             Remark2 - a synonym text identical to the relationship type name is not added to the set of synonyms of this relationship type
293            
294             =cut
295              
296             sub synonym_as_string {
297 42 50 66 42 1 202 if ($_[1] && $_[2] && $_[3]) {
      33        
298 25         91 my $synonym = OBO::Core::Synonym->new();
299 25         88 $synonym->def_as_string($_[1], $_[2]);
300 25         78 $synonym->scope($_[3]);
301 25         69 $synonym->synonym_type_name($_[4]); # optional argument
302 25         66 $_[0]->synonym_set($synonym);
303             }
304            
305 87         139 my @sorted_syns = map { $_->[0] } # restore original values
  63         102  
306 87         189 sort { $a->[1] cmp $b->[1] } # sort
307 42         132 map { [$_, lc($_->def_as_string())] } # transform: value, sortkey
308             $_[0]->{SYNONYM_SET}->get_set();
309            
310 42         90 my @result;
311             my $s_as_string;
312 42         55 foreach my $synonym (@sorted_syns) {
313 87         198 my $syn_scope = $synonym->scope();
314 87 50       139 if ($syn_scope) {
315 87         151 my $syn_type_name = $synonym->synonym_type_name();
316 87 100       148 if ($syn_type_name) {
317 18         36 $s_as_string = ' '.$syn_scope.' '.$syn_type_name;
318             } else {
319 69         97 $s_as_string = ' '.$syn_scope;
320             }
321             } else {
322             # This case should never happen since the SCOPE is mandatory!
323 0         0 warn "The scope of this synonym is not defined: ", $synonym->def()->text();
324             }
325            
326 87         152 push @result, $synonym->def_as_string().$s_as_string;
327             }
328 42         197 return @result;
329             }
330              
331             =head2 xref_set
332              
333             Usage - $relationship_type->xref_set() or $relationship_type->xref_set($dbxref_set)
334             Returns - a Dbxref set with the analogous xref(s) of this relationship type in another vocabulary
335             Args - analogous xref(s) (OBO::Util::DbxrefSet) of this relationship type in another vocabulary
336             Function - gets/sets the analogous xref(s) of this relationship type in another vocabulary
337            
338             =cut
339              
340             sub xref_set {
341 270 100   270 1 421 $_[0]->{XREF_SET} = $_[1] if ($_[1]);
342 270         694 return $_[0]->{XREF_SET};
343             }
344              
345             =head2 xref_set_as_string
346              
347             Usage - $relationship_type->xref_set_as_string() or $relationship_type->xref_set_as_string("[Reactome:20610, EC:2.3.2.12]")
348             Returns - the dbxref set with the analogous xref(s) of this relationship type; [] if the set is empty
349             Args - the dbxref set with the analogous xref(s) of this relationship type
350             Function - gets/sets the dbxref set with the analogous xref(s) of this relationship type
351             Remark - make sure that colons (,) are scaped (\,) when necessary
352            
353             =cut
354              
355             sub xref_set_as_string {
356 229     229 1 397 my $xref_as_string = $_[1];
357 229 100       357 if ($xref_as_string) {
358 75         119 my $xref_set = $_[0]->{XREF_SET};
359            
360 75         149 my ($e, $entry) = __dbxref($xref_set, $xref_as_string);
361 75 50       145 if ($e == -1) {
362 0         0 croak "ERROR: Check the 'dbxref' field of '", $entry, "' (term ID = ", $_[0]->id(), ")." ;
363             }
364              
365 75         130 $_[0]->{XREF_SET} = $xref_set; # We are overwriting the existing set; otherwise, add the new elements to the existing set!
366             }
367 229         429 my @result = $_[0]->xref_set()->get_set();
368             }
369              
370             =head2 domain
371              
372             Usage - print $relationship_type->domain() or $relationship_type->domain($id1, $id2, $id3, ...)
373             Returns - a set (OBO::Util::Set) with the domain(s) to which this relationship type belongs
374             Args - the domain(s) (string) to which this relationship type belongs
375             Function - gets/sets the domain(s) to which this relationship type belongs
376            
377             =cut
378              
379             sub domain {
380 161     161 1 247 my $self = shift;
381 161 50       385 if (scalar(@_) > 1) {
    50          
382 0         0 $self->{DOMAIN}->add_all(@_);
383             } elsif (scalar(@_) == 1) {
384 0         0 $self->{DOMAIN}->add(shift);
385             }
386 161         428 return $self->{DOMAIN};
387             }
388              
389             =head2 range
390              
391             Usage - print $relationship_type->range() or $relationship_type->range($id1, $id2, $id3, ...)
392             Returns - a set (OBO::Util::Set) with the range(s) of this relationship type
393             Args - the range(s) (string) of this relationship type
394             Function - gets/sets the range(s) of this relationship type
395            
396             =cut
397              
398             sub range {
399 161     161 1 145 my $self = shift;
400 161 50       393 if (scalar(@_) > 1) {
    50          
401 0         0 $self->{RANGE}->add_all(@_);
402             } elsif (scalar(@_) == 1) {
403 0         0 $self->{RANGE}->add(shift);
404             }
405 161         322 return $self->{RANGE};
406             }
407              
408             =head2 inverse_of
409              
410             Usage - $relationship_type->inverse_of() or $relationship_type->inverse_of($inv_rel)
411             Returns - inverse relationship type (OBO::Core::RelationshipType) of this relationship type
412             Args - inverse relationship type (OBO::Core::RelationshipType) of this relationship type
413             Function - gets/sets the inverse relationship type of this relationship type
414            
415             =cut
416              
417             sub inverse_of {
418 183 100   183 1 351 if ($_[1]) {
419 14         30 $_[0]->{INVERSE_OF} = $_[1];
420 14         20 $_[1]->{INVERSE_OF} = $_[0];
421             # TODO Test what would happen if we delete any of those two relationships.
422             }
423 183         470 return $_[0]->{INVERSE_OF};
424             }
425              
426             =head2 is_cyclic
427              
428             Usage - $relationship_type->is_cyclic()
429             Returns - 1 (true) or 0 (false)
430             Args - 1 (true) or 0 (false)
431             Function - tells whether the relationship type is cyclic or not.
432            
433             =cut
434              
435             sub is_cyclic {
436 170 50 33 170 1 303 if (defined $_[1] && ($_[1] == 1 || $_[1] == 0)) { $_[0]->{IS_CYCLIC} = $_[1] }
  8   66     10  
437 170 50 33     587 return ($_[0]->{IS_CYCLIC} && $_[0]->{IS_CYCLIC} == 1)?1:0;
438             }
439              
440             =head2 is_reflexive
441              
442             Usage - $relationship_type->is_reflexive()
443             Returns - 1 (true) or 0 (false)
444             Args - 1 (true) or 0 (false)
445             Function - tells whether the relationship type is reflexive or not.
446            
447             =cut
448              
449             sub is_reflexive {
450 194 50 66 194 1 423 if (defined $_[1] && ($_[1] == 1 || $_[1] == 0)) { $_[0]->{IS_REFLEXIVE} = $_[1] }
  32   66     60  
451 194 100 66     778 return ($_[0]->{IS_REFLEXIVE} && $_[0]->{IS_REFLEXIVE} == 1)?1:0;
452             }
453              
454             =head2 is_symmetric
455              
456             Usage - $relationship_type->is_symmetric()
457             Returns - 1 (true) or 0 (false)
458             Args - 1 (true) or 0 (false)
459             Function - tells whether the relationship type is symmetric or not.
460            
461             =cut
462              
463             sub is_symmetric {
464 201 50 66 201 1 332 if (defined $_[1] && ($_[1] == 1 || $_[1] == 0)) { $_[0]->{IS_SYMMETRIC} = $_[1] }
  10   66     13  
465 201 100 66     710 return ($_[0]->{IS_SYMMETRIC} && $_[0]->{IS_SYMMETRIC} == 1)?1:0;
466             }
467              
468             =head2 is_anti_symmetric
469              
470             Usage - $relationship_type->is_anti_symmetric()
471             Returns - 1 (true) or 0 (false)
472             Args - 1 (true) or 0 (false)
473             Function - tells whether the relationship type is anti symmetric or not.
474            
475             =cut
476              
477             sub is_anti_symmetric {
478 183 50 66 183 1 395 if (defined $_[1] && ($_[1] == 1 || $_[1] == 0)) { $_[0]->{IS_ANTI_SYMMETRIC} = $_[1] }
  21   66     37  
479 183 100 66     756 return ($_[0]->{IS_ANTI_SYMMETRIC} && $_[0]->{IS_ANTI_SYMMETRIC} == 1)?1:0;
480             }
481              
482             =head2 is_transitive
483              
484             Usage - $relationship_type->is_transitive()
485             Returns - 1 (true) or 0 (false)
486             Args - 1 (true) or 0 (false)
487             Function - tells whether the relationship type is transitive or not.
488            
489             =cut
490              
491             sub is_transitive {
492 248 50 66 248 1 593 if (defined $_[1] && ($_[1] == 1 || $_[1] == 0)) { $_[0]->{IS_TRANSITIVE} = $_[1] }
  55   66     90  
493 248 100 66     1203 return ($_[0]->{IS_TRANSITIVE} && $_[0]->{IS_TRANSITIVE} == 1)?1:0;
494             }
495              
496             =head2 is_metadata_tag
497              
498             Usage - $relationship_type->is_metadata_tag()
499             Returns - 1 (true) or 0 (false)
500             Args - 1 (true) or 0 (false)
501             Function - tells whether this relationship type is a metadata tag or not.
502            
503             =cut
504              
505             sub is_metadata_tag {
506 199 50 33 199 1 347 if (defined $_[1] && ($_[1] == 1 || $_[1] == 0)) { $_[0]->{IS_METADATA_TAG} = $_[1] }
  8   66     11  
507 199 50 33     705 return ($_[0]->{IS_METADATA_TAG} && $_[0]->{IS_METADATA_TAG} == 1)?1:0;
508             }
509              
510             =head2 is_class_level
511              
512             Usage - $relationship_type->is_class_level()
513             Returns - 1 (true) or 0 (false)
514             Args - 1 (true) or 0 (false)
515             Function - tells whether this relationship type is a class-level relation or not.
516            
517             =cut
518              
519             sub is_class_level {
520 199 50 66 199 1 361 if (defined $_[1] && ($_[1] == 1 || $_[1] == 0)) { $_[0]->{IS_CLASS_LEVEL} = $_[1] }
  9   66     13  
521 199 100 66     671 return ($_[0]->{IS_CLASS_LEVEL} && $_[0]->{IS_CLASS_LEVEL} == 1)?1:0;
522             }
523              
524             =head2 transitive_over
525              
526             Usage - $relationship_type->transitive_over() or $relationship_type->transitive_over($id1, $id2, $id3, ...)
527             Returns - a set (OBO::Util::Set) with the relationship type(s) for which this relationship type is(are) transitive over
528             Args - the relationship type(s) (string) with which this one is transitive over
529             Function - gets/sets the set of the relationship type(s) for which this relationship type is(are) transitive over
530            
531             =cut
532              
533             sub transitive_over {
534 165     165 1 189 my $self = shift;
535 165 50       401 if (scalar(@_) > 1) {
    50          
536 0         0 $self->{TRANSITIVE_OVER}->add_all(@_);
537             } elsif (scalar(@_) == 1) {
538 0         0 $self->{TRANSITIVE_OVER}->add(shift);
539             }
540 165         347 return $self->{TRANSITIVE_OVER};
541             }
542              
543             =head2 holds_over_chain
544              
545             Usage - $relationship_type->holds_over_chain() or $relationship_type->holds_over_chain($rt1, $rt2)
546             Returns - an array of pairs (string) with the relationship type identifiers for which this relationship type holds over a chain
547             Args - the relationship type identifiers (string) with which this one holds over a chain
548             Function - gets/sets the set of the relationship types for which this relationship type holds over a chain
549            
550             =cut
551              
552             sub holds_over_chain {
553 185     185 1 191 my $self = shift;
554 185         162 my $composition_symbol = '&&';
555 185 100       306 if (scalar(@_) == 2) {
556 18         41 my $key = $_[0].$composition_symbol.$_[1]; # R<-R1&&R2
557 18         59 $self->{HOLDS_OVER_CHAIN}->put($key, \@_);
558             }
559 185         508 return $self->{HOLDS_OVER_CHAIN}->values();
560             }
561              
562             =head2 is_functional
563              
564             Usage - $relationship_type->is_functional() or $relationship_type->is_functional(1) or $relationship_type->is_functional(0)
565             Returns - tells if this relationship type is functional; false by default
566             Args - 1 (true) or 0 (false)
567             Function - gets/sets the value indicating whether this relationship type is functional
568            
569             =cut
570              
571             sub is_functional {
572 175 50 66 175 1 355 if (defined $_[1] && ($_[1] == 1 || $_[1] == 0)) { $_[0]->{IS_FUNCTIONAL} = $_[1] }
  10   66     12  
573 175 100 66     648 return ($_[0]->{IS_FUNCTIONAL} && $_[0]->{IS_FUNCTIONAL} == 1)?1:0;
574             }
575              
576             =head2 is_inverse_functional
577              
578             Usage - $relationship_type->is_inverse_functional() or $relationship_type->is_inverse_functional(1) or $relationship_type->is_inverse_functional(0)
579             Returns - tells if this relationship type is inverse functional; false by default
580             Args - 1 (true) or 0 (false)
581             Function - gets/sets the value indicating whether this relationship type is inverse functional
582            
583             =cut
584              
585             sub is_inverse_functional {
586 175 50 66 175 1 302 if (defined $_[1] && ($_[1] == 1 || $_[1] == 0)) { $_[0]->{IS_INVERSE_FUNCTIONAL} = $_[1] }
  10   66     13  
587 175 100 66     607 return ($_[0]->{IS_INVERSE_FUNCTIONAL} && $_[0]->{IS_INVERSE_FUNCTIONAL} == 1)?1:0;
588             }
589              
590             =head2 intersection_of
591            
592             Usage - $relationship_type->intersection_of() or $relationship_type->intersection_of($t1, $t2, $r1, ...)
593             Returns - an array with the terms/relations which define this relationship type
594             Args - a set (strings) of terms/relations which define this relationship type
595             Function - gets/sets the set of terms/relatonships defining this relationship type
596            
597             =cut
598             sub intersection_of {
599 157     157 1 153 my $self = shift;
600 157 50       389 if (scalar(@_) > 1) {
    50          
601 0         0 $self->{INTERSECTION_OF}->add_all(@_);
602             } elsif (scalar(@_) == 1) {
603 0         0 $self->{INTERSECTION_OF}->add(shift);
604             }
605 157         385 return $self->{INTERSECTION_OF}->get_set();
606             }
607              
608             =head2 union_of
609            
610             Usage - $relationship_type->union_of() or $relationship_type->union_of($t1, $t2, $r1, ...)
611             Returns - an array with the terms/relations which define this relationship type
612             Args - a set (strings) of terms/relations which define this relationship type
613             Function - gets/sets the set of terms/relatonships defining this relationship type
614            
615             =cut
616             sub union_of {
617 157     157 1 149 my $self = shift;
618 157 50       361 if (scalar(@_) > 1) {
    50          
619 0         0 $self->{UNION_OF}->add_all(@_);
620             } elsif (scalar(@_) == 1) {
621 0         0 $self->{UNION_OF}->add(shift);
622             }
623 157         301 return $self->{UNION_OF}->get_set();
624             }
625              
626             =head2 disjoint_from
627              
628             Usage - $relationship_type->disjoint_from() or $relationship_type->disjoint_from($disjoint_term_id1, $disjoint_term_id2, $disjoint_term_id3, ...)
629             Returns - the disjoint relationship type id(s) (string(s)) from this one
630             Args - the relationship type id(s) (string) that is (are) disjoint from this one
631             Function - gets/sets the disjoint relationship type(s) from this one
632            
633             =cut
634             sub disjoint_from {
635 158     158 1 148 my $self = shift;
636 158 50       365 if (scalar(@_) > 1) {
    100          
637 0         0 $self->{DISJOINT_FROM}->add_all(@_);
638             } elsif (scalar(@_) == 1) {
639 1         4 $self->{DISJOINT_FROM}->add(shift);
640             }
641 158         329 return $self->{DISJOINT_FROM}->get_set();
642             }
643              
644             =head2 created_by
645              
646             Usage - print $relationship_type->created_by() or $relationship_type->created_by("erick_antezana")
647             Returns - name (string) of the creator of the relationship type, may be a short username, initials or ID
648             Args - name (string) of the creator of the relationship type, may be a short username, initials or ID
649             Function - gets/sets the name of the creator of the relationship type
650            
651             =cut
652             sub created_by {
653 175 100   175 1 306 $_[0]->{CREATED_BY} = $_[1] if ($_[1]);
654 175         418 return $_[0]->{CREATED_BY};
655             }
656              
657             =head2 creation_date
658              
659             Usage - print $relationship_type->creation_date() or $relationship_type->creation_date("2010-04-13T01:32:36Z")
660             Returns - date (string) of creation of the relationship type specified in ISO 8601 format
661             Args - date (string) of creation of the relationship type specified in ISO 8601 format
662             Function - gets/sets the date of creation of the relationship type
663            
664             =cut
665             sub creation_date {
666 175 100   175 1 276 $_[0]->{CREATION_DATE} = $_[1] if ($_[1]);
667 175         376 return $_[0]->{CREATION_DATE};
668             }
669              
670             =head2 modified_by
671              
672             Usage - print $relationship_type->modified_by() or $relationship_type->modified_by("erick_antezana")
673             Returns - name (string) of the modificator of the relationship type, may be a short username, initials or ID
674             Args - name (string) of the modificator of the relationship type, may be a short username, initials or ID
675             Function - gets/sets the name of the modificator of the relationship type
676            
677             =cut
678             sub modified_by {
679 140 100   140 1 215 $_[0]->{MODIFIED_BY} = $_[1] if ($_[1]);
680 140         294 return $_[0]->{MODIFIED_BY};
681             }
682              
683             =head2 modification_date
684              
685             Usage - print $relationship_type->modification_date() or $relationship_type->modification_date("2010-04-13T01:32:36Z")
686             Returns - date (string) of modification of the relationship type specified in ISO 8601 format
687             Args - date (string) of modification of the relationship type specified in ISO 8601 format
688             Function - gets/sets the date of modification of the relationship type
689            
690             =cut
691             sub modification_date {
692 140 100   140 1 211 $_[0]->{MODIFICATION_DATE} = $_[1] if ($_[1]);
693 140         310 return $_[0]->{MODIFICATION_DATE};
694             }
695              
696             =head2 is_obsolete
697              
698             Usage - print $relationship_type->is_obsolete()
699             Returns - either 1 (true) or 0 (false)
700             Args - either 1 (true) or 0 (false)
701             Function - tells whether the relationship type is obsolete or not. 'false' by default.
702            
703             =cut
704              
705             sub is_obsolete {
706 169 50 33 169 1 299 if (defined $_[1] && ($_[1] == 1 || $_[1] == 0)) { $_[0]->{IS_OBSOLETE} = $_[1] }
  8   66     9  
707 169 50 33     613 return ($_[0]->{IS_OBSOLETE} && $_[0]->{IS_OBSOLETE} == 1)?1:0;
708             }
709              
710             =head2 replaced_by
711              
712             Usage - $relationship_type->replaced_by() or $relationship_type->replaced_by($id1, $id2, $id3, ...)
713             Returns - a set (OBO::Util::Set) with the id(s) of the replacing relationship type(s)
714             Args - the the id(s) of the replacing relationship type(s) (string)
715             Function - gets/sets the the id(s) of the replacing relationship type(s)
716            
717             =cut
718              
719             sub replaced_by {
720 190     190 1 171 my $self = shift;
721 190 50       422 if (scalar(@_) > 1) {
    50          
722 0         0 $self->{REPLACED_BY}->add_all(@_);
723             } elsif (scalar(@_) == 1) {
724 0         0 $self->{REPLACED_BY}->add(shift);
725             }
726 190         462 return $self->{REPLACED_BY};
727             }
728              
729             =head2 consider
730              
731             Usage - $relationship_type->consider() or $relationship_type->consider($id1, $id2, $id3, ...)
732             Returns - a set (OBO::Util::Set) with the appropiate substitute(s) for an obsolete relationship type
733             Args - the appropiate substitute(s) for an obsolete relationship type (string)
734             Function - gets/sets the appropiate substitute(s) for this obsolete relationship type
735            
736             =cut
737              
738             sub consider {
739 190     190 1 159 my $self = shift;
740 190 50       413 if (scalar(@_) > 1) {
    50          
741 0         0 $self->{CONSIDER}->add_all(@_);
742             } elsif (scalar(@_) == 1) {
743 0         0 $self->{CONSIDER}->add(shift);
744             }
745 190         387 return $self->{CONSIDER};
746             }
747              
748             =head2 builtin
749              
750             Usage - $relationship_type->builtin() or $relationship_type->builtin(1) or $relationship_type->builtin(0)
751             Returns - tells if this relationship type is builtin to the OBO format; false by default
752             Args - 1 (true) or 0 (false)
753             Function - gets/sets the value indicating whether this relationship type is builtin to the OBO format
754            
755             =cut
756              
757             sub builtin {
758 175 50 66 175 1 343 if (defined $_[1] && ($_[1] == 1 || $_[1] == 0)) { $_[0]->{BUILTIN} = $_[1] }
  13   66     26  
759 175 100 66     754 return ($_[0]->{BUILTIN} && $_[0]->{BUILTIN} == 1)?1:0;
760             }
761              
762             =head2 equals
763              
764             Usage - print $relationship_type->equals($another_relationship_type)
765             Returns - either 1 (true) or 0 (false)
766             Args - the relationship type (OBO::Core::RelationshipType) to compare with
767             Function - tells whether this relationship type is equal to the parameter
768            
769             =cut
770              
771             sub equals {
772 8     8 1 10 my $result = 0;
773              
774 8 50 33     27 if ($_[1] && eval { $_[1]->isa('OBO::Core::RelationshipType') }) {
  8         57  
775 8         14 my $self_id = $_[0]->{'ID'};
776 8         11 my $target_id = $_[1]->{'ID'};
777            
778 8 50       16 croak 'The ID of this relationship type is not defined.' if (!defined($self_id));
779 8 50       15 croak 'The ID of the target relationship type is not defined.' if (!defined($target_id));
780            
781 8         14 $result = ($self_id eq $target_id);
782             } else {
783 0         0 croak "An unrecognized object type (not a OBO::Core::RelationshipType) was found: '", $_[1], "'";
784             }
785 8         33 return $result;
786             }
787              
788             sub __dbxref () {
789 77 50   77   187 caller eq __PACKAGE__ or croak "You cannot call this (__dbxref) prived method!";
790             #
791             # $_[0] ==> set
792             # $_[1] ==> dbxref string
793             #
794 77         69 my $dbxref_set = $_[0];
795 77         76 my $dbxref_as_string = $_[1];
796            
797 77         129 $dbxref_as_string =~ s/^\[//;
798 77         106 $dbxref_as_string =~ s/\]$//;
799 77         98 $dbxref_as_string =~ s/\\,/;;;;/g; # trick to keep the comma's
800 77         82 $dbxref_as_string =~ s/\\"/;;;;;/g; # trick to keep the double quote's
801            
802 77         169 my @lineas = $dbxref_as_string =~ /\"([^\"]*)\"/g; # get the double-quoted pieces
803 77         120 foreach my $l (@lineas) {
804 2         2 my $cp = $l;
805 2         4 $l =~ s/,/;;;;/g; # trick to keep the comma's
806 2         22 $dbxref_as_string =~ s/\Q$cp\E/$l/;
807             }
808              
809 77         251 my $r_db_acc = qr/([ \*\.\w-]*):([ ;'\#~\w:\\\+\?\{\}\$\/\(\)\[\]\.=&!%_-]*)/o;
810 77         151 my $r_desc = qr/\s+\"([^\"]*)\"/o;
811 77         160 my $r_mod = qr/\s+(\{[\w ]+=[\w ]+\})/o;
812            
813 77         212 my @dbxrefs = split (',', $dbxref_as_string);
814            
815 77         105 foreach my $entry (@dbxrefs) {
816 82         101 my ($match, $db, $acc, $desc, $mod) = undef;
817 82         258 my $dbxref = OBO::Core::Dbxref->new();
818 82 100       5865 if ($entry =~ m/$r_db_acc$r_desc$r_mod?/) {
    50          
819 2         3 $db = __unescape($1);
820 2         5 $acc = __unescape($2);
821 2         2 $desc = __unescape($3);
822 2 100       8 $mod = __unescape($4) if ($4);
823             } elsif ($entry =~ m/$r_db_acc$r_desc?$r_mod?/) {
824 80         161 $db = __unescape($1);
825 80         124 $acc = __unescape($2);
826 80 50       173 $desc = __unescape($3) if ($3);
827 80 50       168 $mod = __unescape($4) if ($4);
828             } else {
829 0         0 return (-1, $entry);
830             }
831            
832             # set the dbxref:
833 82         338 $dbxref->name($db.':'.$acc);
834 82 100       188 $dbxref->description($desc) if (defined $desc);
835 82 100       145 $dbxref->modifier($mod) if (defined $mod);
836 82         201 $dbxref_set->add($dbxref);
837             }
838 77         242 return 1;
839             }
840              
841             sub __unescape {
842 167 50   167   296 caller eq __PACKAGE__ or die;
843 167         221 my $match = $_[0];
844 167         212 $match =~ s/;;;;;/\\"/g;
845 167         157 $match =~ s/;;;;/\\,/g;
846 167         212 return $match;
847             }
848              
849             1;
850              
851             __END__