File Coverage

GO/Model/LogicalDefinition.pm
Criterion Covered Total %
statement 33 44 75.0
branch 4 8 50.0
condition n/a
subroutine 9 9 100.0
pod 2 2 100.0
total 48 63 76.1


line stmt bran cond sub pod time code
1             # $Id: LogicalDefinition.pm,v 1.1 2006/04/05 22:47:57 cmungall Exp $
2             #
3             # This GO module is maintained by Chris Mungall
4             #
5             # see also - http://www.geneontology.org
6             # - http://www.godatabase.org/dev
7             #
8             # You may distribute this module under the same terms as perl itself
9              
10             package GO::Model::LogicalDefinition;
11              
12             =head1 NAME
13              
14             GO::Model::LogicalDefinition;
15              
16             =head1 SYNOPSIS
17              
18             =head1 DESCRIPTION
19              
20             =cut
21              
22              
23 14     14   77 use Carp qw(cluck confess);
  14         26  
  14         804  
24 14     14   79 use Exporter;
  14         35  
  14         784  
25 14     14   91 use GO::Utils qw(rearrange);
  14         109  
  14         633  
26 14     14   78 use GO::Model::Root;
  14         31  
  14         316  
27 14     14   79 use strict;
  14         24  
  14         716  
28 14     14   80 use vars qw(@ISA);
  14         34  
  14         5375  
29              
30             @ISA = qw(GO::Model::Root Exporter);
31              
32             sub _valid_params {
33 13     13   29 return qw(intersection_list);
34             }
35              
36             =head2 intersection_list
37              
38             Usage -
39             Returns -
40             Args -
41              
42             Each element of the list is itself a list
43              
44             This list is of length 1 or 2.
45              
46             [$generic_term_acc]
47             [$relation,$differentiating_term_acc]
48              
49             =cut
50              
51              
52             =head2 generic_term_acc
53              
54             Usage -
55             Synonyms - genus_acc
56             Returns -
57             Args -
58              
59             the ID of the generic term, also known as 'genus'
60              
61             =cut
62              
63             sub generic_term_acc {
64 1     1 1 22 my $self = shift;
65 1 50       5 if (@_) {
66 0         0 my $acc = shift;
67 0         0 my $diffs = $self->differentia;
68 0         0 push(@{$self->intersection_list},$acc);
  0         0  
69 0         0 return $acc;
70             }
71 2         6 my @direct_accs =
72 1         3 grep {scalar(@$_) == 1} @{$self->intersection_list};
  1         6  
73 1 50       5 if (@direct_accs > 1) {
74 0         0 $self->throw("multiple generic terms");
75             }
76 1 50       3 if (@direct_accs) {
77 1         5 return $direct_accs[0]->[0];
78             }
79             # no genus
80 0         0 return;
81             }
82             *genus_acc = \&generic_term_acc;
83              
84             =head2 differentia
85              
86             Usage -
87             Returns -
88             Args -
89              
90             =cut
91              
92             sub differentia {
93 1     1 1 89 my $self = shift;
94 1 50       14 if (@_) {
95 0         0 my $diffs = shift;
96 0         0 my $genus = $self->generic_term_acc;
97 0         0 $self->intersection_list([$genus, $diffs]);
98 0         0 return $diffs;
99             }
100 2         7 my @diffs =
101 1         2 grep {scalar(@$_) > 1} @{$self->intersection_list};
  1         10  
102 1         5 return \@diffs;
103             }
104              
105             1;