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-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::RelationshipType;
11              
12 9     9   8545 use Carp;
  9         18  
  9         656  
13 9     9   49 use strict;
  9         19  
  9         210  
14 9     9   45 use warnings;
  9         17  
  9         276  
15              
16 9     9   1075 use OBO::Core::Def;
  9         21  
  9         213  
17 9     9   1166 use OBO::Util::Map;
  9         18  
  9         208  
18 9     9   1085 use OBO::Util::SynonymSet;
  9         18  
  9         45303  
19              
20             sub new {
21 183     183 0 483 my $class = shift;
22 183         285 my $self = {};
23              
24 183         416 $self->{ID} = undef; # required, string (1)
25 183         319 $self->{IS_ANONYMOUS} = undef; # [1|0], 0 by default
26 183         309 $self->{NAME} = undef; # string (1)
27              
28 183         614 $self->{NAMESPACE_SET} = OBO::Util::Set->new(); # set (0..N)
29 183         533 $self->{ALT_ID} = OBO::Util::Set->new(); # set (0..N)
30 183         337 $self->{BUILTIN} = undef; # [1|0], 0 by default
31 183         592 $self->{DEF} = OBO::Core::Def->new(); # (0..1)
32 183         511 $self->{COMMENT} = undef; # string (0..1)
33 183         514 $self->{SUBSET_SET} = OBO::Util::Set->new(); # set of scalars (0..N)
34 183         563 $self->{SYNONYM_SET} = OBO::Util::SynonymSet->new(); # set of synonyms (0..N)
35 183         544 $self->{XREF_SET} = OBO::Util::DbxrefSet->new(); # set of dbxref's (0..N)
36 183         544 $self->{DOMAIN} = OBO::Util::Set->new(); # set of scalars (0..N)
37 183         515 $self->{RANGE} = OBO::Util::Set->new(); # set of scalars (0..N)
38 183         451 $self->{IS_ANTI_SYMMETRIC} = undef; # [1|0], 0 by default
39 183         292 $self->{IS_CYCLIC} = undef; # [1|0], 0 by default
40 183         586 $self->{IS_REFLEXIVE} = undef; # [1|0], 0 by default
41 183         310 $self->{IS_SYMMETRIC} = undef; # [1|0], 0 by default
42 183         303 $self->{IS_TRANSITIVE} = undef; # [1|0], 0 by default
43 183         328 $self->{INVERSE_OF} = undef; # string (0..1) # TODO This should be a Set of Relationships...
44 183         503 $self->{TRANSITIVE_OVER} = OBO::Util::Set->new(); # set of scalars (0..N)
45              
46 183         652 $self->{HOLDS_OVER_CHAIN} = OBO::Util::Map->new(); # map of scalars-->ref's to arrays (0..N)
47 183         325 $self->{IS_FUNCTIONAL} = undef; # [1|0], 0 by default
48 183         280 $self->{IS_INVERSE_FUNCTIONAL} = undef; # [1|0], 0 by default
49            
50 183         526 $self->{INTERSECTION_OF} = OBO::Util::Set->new(); # (0..N)
51 183         515 $self->{UNION_OF} = OBO::Util::Set->new(); # (0..N)
52 183         532 $self->{DISJOINT_FROM} = OBO::Util::Set->new(); # (0..N)
53              
54 183         316 $self->{CREATED_BY} = undef; # scalar (0..1)
55 183         308 $self->{CREATION_DATE} = undef; # scalar (0..1)
56 183         304 $self->{MODIFIED_BY} = undef; # scalar (0..1)
57 183         292 $self->{MODIFICATION_DATE} = undef; # scalar (0..1)
58 183         288 $self->{IS_OBSOLETE} = undef; # [1|0], 0 by default
59 183         490 $self->{REPLACED_BY} = OBO::Util::Set->new(); # set of scalars (0..N)
60 183         518 $self->{CONSIDER} = OBO::Util::Set->new(); # set of scalars (0..N)
61 183         309 $self->{IS_METADATA_TAG} = undef; # [1|0], 0 by default
62 183         280 $self->{IS_CLASS_LEVEL} = undef; # [1|0], 0 by default
63              
64 183         362 bless ($self, $class);
65 183         474 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 227837 100   227837 1 427948 if ($_[1]) { $_[0]->{ID} = $_[1] }
  183         443  
79 227837         577409 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 405 if (defined $_[1] && ($_[1] == 1 || $_[1] == 0)) { $_[0]->{IS_ANONYMOUS} = $_[1] }
  10   66     18  
92 177 100 66     786 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 54469 100   54469 1 101070 $_[0]->{NAME} = $_[1] if ($_[1]);
106 54469         165442 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 232 my $self = shift;
120 191 50       511 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         618 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 797 $_[0]->{DEF} = $_[1] if ($_[1]);
139 376         1250 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 60 my $dbxref_as_string = $_[2];
154 38 100 66     101 if ($_[1] && $dbxref_as_string) {
155 2         5 my $def = $_[0]->{DEF};
156 2         14 $def->text($_[1]);
157 2         7 my $dbxref_set = OBO::Util::DbxrefSet->new();
158            
159 2         6 my ($e, $entry) = __dbxref($dbxref_set, $dbxref_as_string);
160 2 50       7 if ($e == -1) {
161 0         0 croak "ERROR: Check the 'dbxref' field of '", $entry, "' (term ID = ", $_[0]->id(), ")." ;
162             }
163            
164 2         10 $def->dbxref_set($dbxref_set);
165             }
166 38         63 my @result = (); # a Set?
167 38         117 foreach my $dbxref (sort {lc($a->id()) cmp lc($b->id())} $_[0]->{DEF}->dbxref_set()->get_set()) {
  5         17  
168 40         107 push @result, $dbxref->as_string();
169             }
170 38         128 my $d = $_[0]->{DEF}->text();
171 38 50       78 if (defined $d) {
172 38         103 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 249 my $self = shift;
189 191 50       551 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         631 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 649 if ($_[1]) { $_[0]->{COMMENT} = $_[1] }
  36         122  
208 291         1545 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 365 my $self = shift;
221 171 100       503 if (scalar(@_) > 1) {
    100          
222 1         4 $self->{SUBSET_SET}->add_all(@_);
223             } elsif (scalar(@_) == 1) {
224 2         16 $self->{SUBSET_SET}->add(shift);
225             }
226 171         530 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 339 my $self = shift;
242 235         428 foreach my $synonym (@_) {
243 28         64 my $rel_type_name = $self->name();
244 28 50       76 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         44 my $syn_found = 0;
252 28         96 foreach my $s ($self->{SYNONYM_SET}->get_set()) {
253            
254 18 100       55 if ($s->def()->text() eq $synonym->def()->text()) { # if that SYNONYM is already in the set
255            
256 7         16 my $synonym_type_name = $synonym->synonym_type_name();
257 7         16 my $s_type_name = $s->synonym_type_name();
258 7 100 66     20 if ($synonym_type_name || $s_type_name) { # if any of their STN's is defined
259 5 100 66     31 if ($s_type_name && $synonym_type_name && ($s_type_name eq $synonym_type_name)) { # they should be identical
      100        
260            
261 1         4 $s->def()->dbxref_set($synonym->def()->dbxref_set); # then update its DBXREFs!
262 1         5 $s->scope($synonym->scope); # then update its SCOPE!
263            
264 1         2 $syn_found = 1;
265 1         2 last;
266             }
267             } else {
268 2         7 $s->def()->dbxref_set($synonym->def()->dbxref_set); # then update its DBXREFs!
269 2         7 $s->scope($synonym->scope); # then update its SCOPE!
270            
271 2         3 $syn_found = 1;
272 2         4 last;
273             }
274             }
275             }
276            
277             # do not add 'EXACT' synonyms with the same 'name':
278 28 50 66     134 if (!$syn_found && !($synonym->scope() eq 'EXACT' && $synonym->def()->text() eq $rel_type_name)) {
      66        
279 25 50       80 $self->{SYNONYM_SET}->add($synonym) || warn "ERROR: the synonym (", $synonym->def()->text(), ") was not added!!";
280             }
281             }
282 235         709 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 238 if ($_[1] && $_[2] && $_[3]) {
      33        
298 25         99 my $synonym = OBO::Core::Synonym->new();
299 25         100 $synonym->def_as_string($_[1], $_[2]);
300 25         91 $synonym->scope($_[3]);
301 25         89 $synonym->synonym_type_name($_[4]); # optional argument
302 25         75 $_[0]->synonym_set($synonym);
303             }
304            
305 87         174 my @sorted_syns = map { $_->[0] } # restore original values
306 63         133 sort { $a->[1] cmp $b->[1] } # sort
307 87         230 map { [$_, lc($_->def_as_string())] } # transform: value, sortkey
308 42         142 $_[0]->{SYNONYM_SET}->get_set();
309            
310 42         110 my @result;
311             my $s_as_string;
312 42         75 foreach my $synonym (@sorted_syns) {
313 87         219 my $syn_scope = $synonym->scope();
314 87 50       175 if ($syn_scope) {
315 87         214 my $syn_type_name = $synonym->synonym_type_name();
316 87 100       166 if ($syn_type_name) {
317 18         41 $s_as_string = ' '.$syn_scope.' '.$syn_type_name;
318             } else {
319 69         126 $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         219 push @result, $synonym->def_as_string().$s_as_string;
327             }
328 42         196 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 549 $_[0]->{XREF_SET} = $_[1] if ($_[1]);
342 270         876 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 460 my $xref_as_string = $_[1];
357 229 100       484 if ($xref_as_string) {
358 75         122 my $xref_set = $_[0]->{XREF_SET};
359            
360 75         162 my ($e, $entry) = __dbxref($xref_set, $xref_as_string);
361 75 50       188 if ($e == -1) {
362 0         0 croak "ERROR: Check the 'dbxref' field of '", $entry, "' (term ID = ", $_[0]->id(), ")." ;
363             }
364              
365 75         163 $_[0]->{XREF_SET} = $xref_set; # We are overwriting the existing set; otherwise, add the new elements to the existing set!
366             }
367 229         525 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 311 my $self = shift;
381 161 50       458 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         551 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 219 my $self = shift;
400 161 50       428 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         665 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 402 if ($_[1]) {
419 14         26 $_[0]->{INVERSE_OF} = $_[1];
420 14         29 $_[1]->{INVERSE_OF} = $_[0];
421             # TODO Test what would happen if we delete any of those two relationships.
422             }
423 183         460 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 380 if (defined $_[1] && ($_[1] == 1 || $_[1] == 0)) { $_[0]->{IS_CYCLIC} = $_[1] }
  8   66     14  
437 170 50 33     711 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 538 if (defined $_[1] && ($_[1] == 1 || $_[1] == 0)) { $_[0]->{IS_REFLEXIVE} = $_[1] }
  32   66     70  
451 194 100 66     971 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 450 if (defined $_[1] && ($_[1] == 1 || $_[1] == 0)) { $_[0]->{IS_SYMMETRIC} = $_[1] }
  10   66     21  
465 201 100 66     844 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 464 if (defined $_[1] && ($_[1] == 1 || $_[1] == 0)) { $_[0]->{IS_ANTI_SYMMETRIC} = $_[1] }
  21   66     39  
479 183 100 66     875 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 657 if (defined $_[1] && ($_[1] == 1 || $_[1] == 0)) { $_[0]->{IS_TRANSITIVE} = $_[1] }
  55   66     103  
493 248 100 66     1321 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 450 if (defined $_[1] && ($_[1] == 1 || $_[1] == 0)) { $_[0]->{IS_METADATA_TAG} = $_[1] }
  8   66     10  
507 199 50 33     858 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 441 if (defined $_[1] && ($_[1] == 1 || $_[1] == 0)) { $_[0]->{IS_CLASS_LEVEL} = $_[1] }
  9   66     16  
521 199 100 66     820 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 210 my $self = shift;
535 165 50       440 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         509 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 318 my $self = shift;
554 185         238 my $composition_symbol = '&&';
555 185 100       376 if (scalar(@_) == 2) {
556 18         43 my $key = $_[0].$composition_symbol.$_[1]; # R<-R1&&R2
557 18         77 $self->{HOLDS_OVER_CHAIN}->put($key, \@_);
558             }
559 185         609 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 469 if (defined $_[1] && ($_[1] == 1 || $_[1] == 0)) { $_[0]->{IS_FUNCTIONAL} = $_[1] }
  10   66     14  
573 175 100 66     758 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 421 if (defined $_[1] && ($_[1] == 1 || $_[1] == 0)) { $_[0]->{IS_INVERSE_FUNCTIONAL} = $_[1] }
  10   66     16  
587 175 100 66     753 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 223 my $self = shift;
600 157 50       486 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         505 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 266 my $self = shift;
618 157 50       432 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         446 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 204 my $self = shift;
636 158 50       429 if (scalar(@_) > 1) {
    100          
637 0         0 $self->{DISJOINT_FROM}->add_all(@_);
638             } elsif (scalar(@_) == 1) {
639 1         6 $self->{DISJOINT_FROM}->add(shift);
640             }
641 158         457 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 360 $_[0]->{CREATED_BY} = $_[1] if ($_[1]);
654 175         506 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 338 $_[0]->{CREATION_DATE} = $_[1] if ($_[1]);
667 175         494 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 297 $_[0]->{MODIFIED_BY} = $_[1] if ($_[1]);
680 140         428 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 269 $_[0]->{MODIFICATION_DATE} = $_[1] if ($_[1]);
693 140         413 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 412 if (defined $_[1] && ($_[1] == 1 || $_[1] == 0)) { $_[0]->{IS_OBSOLETE} = $_[1] }
  8   66     13  
707 169 50 33     766 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 244 my $self = shift;
721 190 50       519 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         624 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 259 my $self = shift;
740 190 50       542 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         815 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 417 if (defined $_[1] && ($_[1] == 1 || $_[1] == 0)) { $_[0]->{BUILTIN} = $_[1] }
  13   66     27  
759 175 100 66     814 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 14 my $result = 0;
773              
774 8 50 33     40 if ($_[1] && eval { $_[1]->isa('OBO::Core::RelationshipType') }) {
  8         77  
775 8         18 my $self_id = $_[0]->{'ID'};
776 8         15 my $target_id = $_[1]->{'ID'};
777            
778 8 50       22 croak 'The ID of this relationship type is not defined.' if (!defined($self_id));
779 8 50       21 croak 'The ID of the target relationship type is not defined.' if (!defined($target_id));
780            
781 8         18 $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         38 return $result;
786             }
787              
788             sub __dbxref () {
789 77 50   77   205 caller eq __PACKAGE__ or croak "You cannot call this (__dbxref) prived method!";
790             #
791             # $_[0] ==> set
792             # $_[1] ==> dbxref string
793             #
794 77         99 my $dbxref_set = $_[0];
795 77         101 my $dbxref_as_string = $_[1];
796            
797 77         134 $dbxref_as_string =~ s/^\[//;
798 77         148 $dbxref_as_string =~ s/\]$//;
799 77         123 $dbxref_as_string =~ s/\\,/;;;;/g; # trick to keep the comma's
800 77         113 $dbxref_as_string =~ s/\\"/;;;;;/g; # trick to keep the double quote's
801            
802 77         162 my @lineas = $dbxref_as_string =~ /\"([^\"]*)\"/g; # get the double-quoted pieces
803 77         135 foreach my $l (@lineas) {
804 2         3 my $cp = $l;
805 2         5 $l =~ s/,/;;;;/g; # trick to keep the comma's
806 2         25 $dbxref_as_string =~ s/\Q$cp\E/$l/;
807             }
808              
809 77         271 my $r_db_acc = qr/([ \*\.\w-]*):([ ;'\#~\w:\\\+\?\{\}\$\/\(\)\[\]\.=&!%_-]*)/o;
810 77         218 my $r_desc = qr/\s+\"([^\"]*)\"/o;
811 77         214 my $r_mod = qr/\s+(\{[\w ]+=[\w ]+\})/o;
812            
813 77         210 my @dbxrefs = split (',', $dbxref_as_string);
814            
815 77         146 foreach my $entry (@dbxrefs) {
816 82         134 my ($match, $db, $acc, $desc, $mod) = undef;
817 82         256 my $dbxref = OBO::Core::Dbxref->new();
818 82 100       7673 if ($entry =~ m/$r_db_acc$r_desc$r_mod?/) {
    50          
819 2         6 $db = __unescape($1);
820 2         5 $acc = __unescape($2);
821 2         5 $desc = __unescape($3);
822 2 100       14 $mod = __unescape($4) if ($4);
823             } elsif ($entry =~ m/$r_db_acc$r_desc?$r_mod?/) {
824 80         202 $db = __unescape($1);
825 80         168 $acc = __unescape($2);
826 80 50       212 $desc = __unescape($3) if ($3);
827 80 50       222 $mod = __unescape($4) if ($4);
828             } else {
829 0         0 return (-1, $entry);
830             }
831            
832             # set the dbxref:
833 82         645 $dbxref->name($db.':'.$acc);
834 82 100       222 $dbxref->description($desc) if (defined $desc);
835 82 100       165 $dbxref->modifier($mod) if (defined $mod);
836 82         244 $dbxref_set->add($dbxref);
837             }
838 77         301 return 1;
839             }
840              
841             sub __unescape {
842 167 50   167   405 caller eq __PACKAGE__ or die;
843 167         312 my $match = $_[0];
844 167         248 $match =~ s/;;;;;/\\"/g;
845 167         226 $match =~ s/;;;;/\\,/g;
846 167         326 return $match;
847             }
848              
849             1;
850              
851             __END__