File Coverage

Bio/Variation/Allele.pm
Criterion Covered Total %
statement 31 54 57.4
branch 15 36 41.6
condition 4 12 33.3
subroutine 6 10 60.0
pod 8 8 100.0
total 64 120 53.3


line stmt bran cond sub pod time code
1             #
2             # BioPerl module for Bio::Variation::Allele
3             #
4             # Please direct questions and support issues to
5             #
6             # Cared for by Heikki Lehvaslaiho
7             #
8             # Copyright Heikki Lehvaslaiho
9             #
10             # You may distribute this module under the same terms as perl itself
11              
12             # POD documentation - main docs before the code
13              
14             =head1 NAME
15              
16             Bio::Variation::Allele - Sequence object with allele-specific attributes
17              
18             =head1 SYNOPSIS
19              
20             $allele1 = Bio::Variation::Allele->new ( -seq => 'A',
21             -id => 'AC00001.1',
22             -alphabet => 'dna',
23             -is_reference => 1
24             );
25              
26             =head1 DESCRIPTION
27              
28             List of alleles describe known sequence alternatives in a variable region.
29             Alleles are contained in Bio::Variation::VariantI complying objects.
30             See L for details.
31              
32             Bio::Varation::Alleles are PrimarySeqI complying objects which can
33             contain database cross references as specified in
34             Bio::DBLinkContainerI interface, too.
35              
36             A lot of the complexity with dealing with Allele objects are caused by
37             null alleles; Allele objects that have zero length sequence string.
38              
39             In addition describing the allele by its sequence , it possible to
40             give describe repeat structure within the sequence. This done using
41             methods repeat_unit (e.g. 'ca') and repeat_count (e.g. 7).
42              
43             =head1 FEEDBACK
44              
45             =head2 Mailing Lists
46              
47             User feedback is an integral part of the evolution of this and other
48             Bioperl modules. Send your comments and suggestions preferably to the
49             Bioperl mailing lists Your participation is much appreciated.
50              
51             bioperl-l@bioperl.org - General discussion
52             http://bioperl.org/wiki/Mailing_lists - About the mailing lists
53              
54             =head2 Support
55              
56             Please direct usage questions or support issues to the mailing list:
57              
58             I
59              
60             rather than to the module maintainer directly. Many experienced and
61             reponsive experts will be able look at the problem and quickly
62             address it. Please include a thorough description of the problem
63             with code and data examples if at all possible.
64              
65             =head2 Reporting Bugs
66              
67             Report bugs to the Bioperl bug tracking system to help us keep track
68             the bugs and their resolution. Bug reports can be submitted via the
69             web:
70              
71             https://github.com/bioperl/bioperl-live/issues
72              
73             =head1 AUTHOR - Heikki Lehvaslaiho
74              
75             Email: heikki-at-bioperl-dot-org
76              
77             =head1 APPENDIX
78              
79             The rest of the documentation details each of the object
80             methods. Internal methods are usually preceded with a _
81              
82             =cut
83              
84              
85             # Let the code begin...
86              
87             package Bio::Variation::Allele;
88              
89 11     11   3571 use strict;
  11         12  
  11         314  
90              
91             # Object preamble - inheritance
92              
93              
94 11     11   35 use base qw(Bio::PrimarySeq Bio::DBLinkContainerI);
  11         15  
  11         5266  
95              
96             sub new {
97 148     148 1 327 my($class, @args) = @_;
98 148         397 my $self = $class->SUPER::new(@args);
99              
100 148         332 my($is_reference, $repeat_unit, $repeat_count) =
101             $self->_rearrange([qw(IS_REFERENCE
102             REPEAT_UNIT
103             REPEAT_COUNT
104             )],
105             @args);
106              
107 148 50       295 $is_reference && $self->is_reference($is_reference);
108 148 50       202 $repeat_unit && $self->repeat_unit($repeat_unit);
109 148 50       200 $repeat_count && $self->repeat_count($repeat_count);
110              
111 148         227 return $self; # success - we hope!
112             }
113              
114              
115             =head2 is_reference
116              
117             Title : is_reference
118             Usage : $obj->is_reference()
119             Function: sets and returns boolean values.
120             Unset values return false.
121             Example : $obj->is_reference()
122             Returns : boolean
123             Args : optional true of false value
124              
125              
126             =cut
127              
128              
129             sub is_reference {
130 2     2 1 3 my ($self,$value) = @_;
131 2 100       5 if( defined $value) {
132 1 50       2 $value ? ($value = 1) : ($value = 0);
133 1         2 $self->{'is_reference'} = $value;
134             }
135 2 50       3 if( ! exists $self->{'is_reference'} ) {
136 0         0 return 0;
137             }
138             else {
139 2         4 return $self->{'is_reference'};
140             }
141             }
142              
143              
144             =head2 add_DBLink
145              
146             Title : add_DBLink
147             Usage : $self->add_DBLink($ref)
148             Function: adds a link object
149             Example :
150             Returns :
151             Args :
152              
153              
154             =cut
155              
156              
157             sub add_DBLink{
158 0     0 1 0 my ($self,$com) = @_;
159 0 0       0 if( ! $com->isa('Bio::Annotation::DBLink') ) {
160 0         0 $self->throw("Is not a link object but a [$com]");
161             }
162 0         0 push(@{$self->{'link'}},$com);
  0         0  
163             }
164              
165             =head2 each_DBLink
166              
167             Title : each_DBLink
168             Usage : foreach $ref ( $self->each_DBlink() )
169             Function: gets an array of DBlink of objects
170             Example :
171             Returns :
172             Args :
173              
174              
175             =cut
176              
177             sub each_DBLink{
178 0     0 1 0 my ($self) = @_;
179 0         0 return @{$self->{'link'}};
  0         0  
180             }
181              
182             =head2 repeat_unit
183              
184             Title : repeat_unit
185             Usage : $obj->repeat_unit('ca');
186             Function:
187              
188             Sets and returns the sequence of the repeat_unit the
189             allele is composed of.
190              
191             Example :
192             Returns : string
193             Args : string
194              
195             =cut
196              
197             sub repeat_unit {
198 2     2 1 2 my ($self,$value) = @_;
199 2 100       5 if( defined $value) {
200 1         2 $self->{'repeat_unit'} = $value;
201             }
202 2 50 33     10 if ($self->{'seq'} && $self->{'repeat_unit'} && $self->{'repeat_count'} ) {
      33        
203             $self->warn("Repeats do not add up!")
204 0 0       0 if ( $self->{'repeat_unit'} x $self->{'repeat_count'}) ne $self->{'seq'};
205             }
206 2         4 return $self->{'repeat_unit'};
207             }
208              
209             =head2 repeat_count
210              
211             Title : repeat_count
212             Usage : $obj->repeat_count();
213             Function:
214              
215             Sets and returns the number of repeat units in the allele.
216              
217             Example :
218             Returns : string
219             Args : string
220              
221             =cut
222              
223              
224             sub repeat_count {
225 2     2 1 3 my ($self,$value) = @_;
226 2 100       4 if( defined $value) {
227 1 50       6 if ( not $value =~ /^\d+$/ ) {
228 0         0 $self->throw("[$value] for repeat_count has to be a positive integer\n");
229             } else {
230 1         2 $self->{'repeat_count'} = $value;
231             }
232             }
233 2 50 33     10 if ($self->{'seq'} && $self->{'repeat_unit'} && $self->{'repeat_count'} ) {
      33        
234             $self->warn("Repeats do not add up!")
235 2 50       5 if ( $self->{'repeat_unit'} x $self->{'repeat_count'}) ne $self->{'seq'};
236             }
237 2         4 return $self->{'repeat_count'};
238             }
239              
240             =head2 count
241              
242             Title : count
243             Usage : $obj->count();
244             Function:
245              
246             Sets and returns the number of times this allele was observed.
247              
248             Example :
249             Returns : string
250             Args : string
251              
252             =cut
253              
254             sub count {
255 0     0 1   my ($self,$value) = @_;
256 0 0         if( defined $value) {
257 0 0         if ( not $value =~ /^\d+$/ ) {
258 0           $self->throw("[$value] for count has to be a positive integer\n");
259             } else {
260 0           $self->{'count'} = $value;
261             }
262             }
263 0           return $self->{'count'};
264             }
265              
266              
267             =head2 frequency
268              
269             Title : frequency
270             Usage : $obj->frequency();
271             Function:
272              
273             Sets and returns the frequency of the allele in the observed
274             population.
275              
276             Example :
277             Returns : string
278             Args : string
279              
280             =cut
281              
282             sub frequency {
283 0     0 1   my ($self,$value) = @_;
284 0 0         if( defined $value) {
285 0 0         if ( not $value =~ /^\d+$/ ) {
286 0           $self->throw("[$value] for frequency has to be a positive integer\n");
287             } else {
288 0           $self->{'frequency'} = $value;
289             }
290             }
291 0           return $self->{'frequency'};
292             }
293              
294              
295             1;