File Coverage

Bio/Phenotype/MeSH/Twig.pm
Criterion Covered Total %
statement 40 40 100.0
branch 7 10 70.0
condition n/a
subroutine 11 11 100.0
pod 9 9 100.0
total 67 70 95.7


line stmt bran cond sub pod time code
1             #
2             # BioPerl module for Bio::Phenotype::MeSH::Twig
3             #
4             # Please direct questions and support issues to
5             #
6             # Cared for by Heikki Lehvaslaiho, heikki-at-bioperl-dot-org
7             #
8             # You may distribute this module under the same terms as perl itself
9              
10             # POD documentation - main docs before the code
11              
12             =head1 NAME
13              
14             Bio::Phenotype::MeSH::Twig - Context for a MeSH term
15              
16             =head1 SYNOPSIS
17              
18             use Bio::Phenotype::MeSH::Twig
19             # create a twig object
20             my $twig = Bio::Phenotype::MeSH::Twig->new();
21              
22             # the term has only one parent in any twig
23             $twig->parent('Fats');
24              
25              
26             # a twig makeas sense only in the context of a term
27             # which is a Bio::Phenotype::MeSH::Term object
28              
29             # a term can have many twigs i.e. it can appear in many places in
30             # the hierarchy
31             #
32             $ term->add_twig($twig);
33              
34             # adding the twig into a term adds a link into into it
35             $twig->term eq $term;
36              
37             # a twig can know about other terms under the parant node
38             $twig->add_sister('Bread', 'Candy', 'Cereals');
39             print join ( ', ', $twig->each_sister()), "\n";
40              
41             # a twig can know about other terms under this term
42             $twig->add_child('Butter', 'Margarine');
43             print join ( ', ', $twig->each_child()), "\n";
44              
45              
46              
47             =head1 DESCRIPTION
48              
49             This class represents the immediate surrounding of a MeSH term. It
50             keeps track on nodes names above the current node ('parent') other
51             nodes at the same level ('sisters') and nodes under it ('children').
52             Note that these are name strings, not objects.
53              
54             Each twig can be associated with only one term, but term can have
55             multiple twigs. (Twigs can be though to be roles for a term.)
56              
57             =head1 SEE ALSO
58              
59             L
60              
61             =head1 FEEDBACK
62              
63             =head2 Mailing Lists
64              
65             User feedback is an integral part of the evolution of this and other
66             Bioperl modules. Send your comments and suggestions preferably to the
67             Bioperl mailing lists Your participation is much appreciated.
68              
69             bioperl-l@bioperl.org - General discussion
70             http://bioperl.org/wiki/Mailing_lists - About the mailing lists
71              
72             =head2 Support
73              
74             Please direct usage questions or support issues to the mailing list:
75              
76             I
77              
78             rather than to the module maintainer directly. Many experienced and
79             reponsive experts will be able look at the problem and quickly
80             address it. Please include a thorough description of the problem
81             with code and data examples if at all possible.
82              
83             =head2 Reporting Bugs
84              
85             report bugs to the Bioperl bug tracking system to help us keep track
86             the bugs and their resolution. Bug reports can be submitted via the
87             web:
88              
89             https://github.com/bioperl/bioperl-live/issues
90              
91             =head1 AUTHOR
92              
93             Heikki Lehvaslaiho, heikki-at-bioperl-dot-org
94              
95             =head1 APPENDIX
96              
97             The rest of the documentation details each of the object
98             methods. Internal methods are usually preceded with a _
99              
100             =cut
101              
102              
103             # Let the code begin...
104              
105             package Bio::Phenotype::MeSH::Twig;
106 1     1   783 use strict;
  1         1  
  1         29  
107              
108              
109 1     1   7 use base qw(Bio::Root::Root);
  1         2  
  1         430  
110              
111              
112             sub new {
113              
114 1     1 1 4 my( $class,@args ) = @_;
115 1         8 my $self = $class->SUPER::new( @args );
116              
117 1         6 my ($term, $parent ) = $self->_rearrange
118             ( [ qw(
119             TERM
120             PARENT
121             ) ],
122             @args );
123              
124 1         3 $self->{"_children"} = [];
125 1         1 $self->{"_sisters"} = [];
126              
127 1 50       3 $term && $self->term($term );
128 1 50       3 $parent && $self->parent($parent );
129 1         5 return $self;
130             }
131              
132              
133             =head2 parent
134              
135             Title : parent
136             Usage : $obj->parent( "r1" );
137             or
138             print $obj->parent();
139             Function: Set/get for the parent.
140             Returns : A parent [scalar].
141             Args : A parent [scalar] (optional).
142              
143             =cut
144              
145             sub parent {
146 2     2 1 4 my ( $self, $value ) = @_;
147 2 100       6 $self->{ "_parent" } = $value if defined $value;
148 2         7 return $self->{ "_parent" };
149             }
150              
151             =head2 term
152              
153             Title : term
154             Usage : $obj->term( "r1" );
155             or
156             print $obj->term();
157             Function: Set/get for the term.
158             Returns : A term [scalar].
159             Args : A term [scalar] (optional).
160              
161             =cut
162              
163             sub term {
164 2     2 1 3 my ( $self, $value ) = @_;
165 2 100       12 if (defined $value) {
166 1 50       5 $self->throw ("Not a MeSH term [$value]")
167             unless $value->isa('Bio::Phenotype::MeSH::Term');
168 1         3 $self->{ "_term" } = $value
169             }
170 2         6 return $self->{ "_term" };
171             }
172              
173              
174             =head2 add_child
175              
176             Title : add_child
177             Usage : $obj->add_child( @children );
178             or
179             $obj->add_child( $child );
180             Function: Pushes one or more child term names [scalars, most likely Strings]
181             into the list of children.
182             Returns :
183             Args : scalar(s).
184              
185             =cut
186              
187             sub add_child {
188 1     1 1 3 my ( $self, @values ) = @_;
189 1         2 push( @{ $self->{ "_children" } }, @values );
  1         2  
190 1         5 return scalar @values;
191             }
192              
193             =head2 each_child
194              
195             Title : each_child()
196             Usage : @gs = $obj->each_child();
197             Function: Returns a list of gene symbols [scalars, most likely Strings]
198             associated with this phenotype.
199             Returns : A list of scalars.
200             Args :
201              
202             =cut
203              
204             sub each_child {
205 2     2 1 5 my ( $self ) = shift;
206 2         2 return @{ $self->{ "_children" } };
  2         8  
207             }
208              
209             =head2 purge_children
210              
211             Usage : $obj->purge_child();
212             Function: Deletes the list of children associated with this term.
213             Returns : A list of scalars.
214             Args :
215              
216             =cut
217              
218             sub purge_children {
219 1     1 1 4 my ( $self ) = @_;
220 1         7 $self->{ "_children" } = [];
221             }
222              
223              
224             =head2 add_sister
225              
226             Title : add_sister
227             Usage : $obj->add_sister( @sisters );
228             or
229             $obj->add_sister( $sister );
230             Function: Pushes one or more sister term names [scalars, most likely Strings]
231             into the list of sisters.
232             Returns :
233             Args : scalar(s).
234              
235             =cut
236              
237             sub add_sister {
238 2     2 1 7 my ( $self, @values ) = @_;
239 2         2 push( @{ $self->{ "_sisters" } }, @values );
  2         5  
240 2         7 return scalar @values;
241             }
242              
243             =head2 each_sister
244              
245             Title : each_sister()
246             Usage : @gs = $obj->each_sister();
247             Function: Returns a list of gene symbols [scalars, most likely Strings]
248             associated with this phenotype.
249             Returns : A list of scalars.
250             Args :
251              
252             =cut
253              
254             sub each_sister {
255 2     2 1 3 my ( $self ) = shift;
256 2         3 return @{ $self->{ "_sisters" } };
  2         8  
257             }
258              
259             =head2 purge_sisters
260              
261             Usage : $obj->purge_sister();
262             Function: Deletes the list of sisters associated with this term.
263             Returns : A list of scalars.
264             Args :
265              
266             =cut
267              
268             sub purge_sisters {
269 1     1 1 2 my ( $self ) = @_;
270 1         6 $self->{'_sisters'} = [];
271             }
272              
273             1;