File Coverage

Bio/LiveSeq/Mutation.pm
Criterion Covered Total %
statement 65 72 90.2
branch 37 44 84.0
condition 3 4 75.0
subroutine 13 13 100.0
pod 11 11 100.0
total 129 144 89.5


line stmt bran cond sub pod time code
1             #
2             # BioPerl module for Bio::LiveSeq::Mutation
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::LiveSeq::Mutation - Mutation event descriptor class
17              
18             =head1 SYNOPSIS
19              
20             # full description of a point mutation
21             $mutation1a = Bio::LiveSeq::Mutation->new ( -seq => 'A',
22             -seqori => 'T',
23             -pos => 100,
24             -len => 1 # optional, defaults to length(seq)
25             );
26              
27             # minimal information for a point mutation
28             $mutation1b = Bio::LiveSeq::Mutation->new ( -seq => 'A',
29             -pos => 100
30             );
31             # insertion
32             $mutation2 = Bio::LiveSeq::Mutation->new ( -seq => 'ATT',
33             -pos => 100,
34             -len => 0
35             );
36             # deletion
37             $mutation3 = Bio::LiveSeq::Mutation->new ( -seq => '', # optional
38             -seqori => 'TTG', # optional
39             -pos => 100
40             -len => 3
41             );
42             # complex
43             $mutation4 = Bio::LiveSeq::Mutation->new ( -seq => 'CC',
44             -seqori => 'TTG', # optional
45             -pos => 100
46             -len => 3
47             );
48              
49              
50             =head1 DESCRIPTION
51              
52             This class describes a local mutation event using minimalistic
53             description. It is not necessary to know anything about the original
54             sequence. You need to give the changed sequence, the position of the
55             mutation in the (unidentified) reference sequence, and the length of
56             the affected subsequence in the reference sequence. If the original
57             allele sequence is given, the objects applying the mutation into the
58             reference sequence (e.g. L) might check for its
59             validity.
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 - Heikki Lehvaslaiho
92              
93             Email: 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::LiveSeq::Mutation;
106 3     3   1567 use strict;
  3         5  
  3         79  
107              
108             # Object preamble - inheritance
109              
110              
111 3     3   14 use base qw(Bio::Root::Root);
  3         4  
  3         1589  
112              
113             sub new {
114 11     11 1 175 my($class,@args) = @_;
115 11         18 my $self;
116 11         87 $self = {};
117 11         27 bless $self, $class;
118              
119 11         84 my ($seq, $seqori, $pos, $len, $label) =
120             $self->_rearrange([qw(SEQ
121             SEQORI
122             POS
123             LEN
124             )],
125             @args);
126              
127 11 100       97 $seq && $self->seq($seq);
128 11 100       28 $seqori && $self->seqori($seqori);
129 11 100       41 $pos && $self->pos($pos);
130 11 100       28 defined($len) && $self->len($len); # defined() added otherwise won't work for len==0
131            
132 11         39 return $self; # success - we hope!
133             }
134              
135              
136             =head2 seq
137              
138             Title : seq
139             Usage : $obj->seq();
140             Function:
141              
142             Sets and returns the mutated sequence. No checking is done
143             to validate the symbols.
144              
145             Example :
146             Returns : string
147             Args : integer
148              
149             =cut
150              
151              
152             sub seq {
153 47     47 1 920 my ($self,$value) = @_;
154 47 100       124 if( defined $value) {
155 10         39 $self->{'seq'} = $value;
156             }
157 47   100     201 return $self->{'seq'} || '';
158             }
159              
160              
161             =head2 seqori
162              
163             Title : seqori
164             Usage : $obj->seqori();
165             Function:
166              
167             Sets and returns the original subsequence in the reference
168             sequence. No checking is done to validate the symbols.
169             Optional value.
170              
171             Example :
172             Returns : string
173             Args : string
174              
175             =cut
176              
177              
178             sub seqori {
179 4     4 1 227 my ($self,$value) = @_;
180 4 100       10 if( defined $value) {
181 2         3 $self->{'seqori'} = $value;
182             }
183 4   50     13 return $self->{'seqori'} || '';
184             }
185              
186              
187             =head2 pos
188              
189             Title : pos
190             Usage : $obj->pos();
191             Function:
192              
193             Sets and returns the position of the first element in the
194             sequence.
195              
196             Example :
197             Returns : string
198             Args : integer
199              
200             =cut
201              
202              
203             sub pos {
204 42     42 1 72 my ($self,$value) = @_;
205 42 100       81 if( defined $value) {
206 16 50       141 if ( $value !~ /^([+-])?\d+$/ ) {
207 0         0 $self->throw("[$value] for pos has to be an integer\n");
208             } else {
209 16         34 $self->{'pos'} = $value;
210             }
211             }
212 42         115 return $self->{'pos'};
213             }
214              
215             =head2 len
216              
217             Title : len
218             Usage : $obj->len();
219             Function:
220              
221             Sets and returns the len of the affected original allele
222             sequence. If value is not set, defaults to the length of
223             the mutated sequence (seq).
224              
225             Example :
226             Returns : string
227             Args : string
228              
229             =cut
230              
231             sub len {
232 62     62 1 100 my ($self,$value) = @_;
233 62 100       109 if ( defined $value) {
234 5         8 $self->{'len'} = $value;
235             }
236 62 100       113 if ( ! exists $self->{'len'} ) {
237 52         234 return length $self->{'seq'};
238             }
239 10         16 return $self->{'len'};
240             }
241              
242             =head2 label
243              
244             Title : label
245             Usage : $obj->label();
246             Function:
247              
248             Sets and returns the label of the affected original allele
249             location. Label is a stable identifier whereas location
250             can be changed by mutations. Label comes from
251             l.
252              
253             Example :
254             Returns : string
255             Args : string
256              
257             =cut
258              
259             sub label {
260 56     56 1 108 my ($self,$value) = @_;
261 56 100       136 if ( defined $value) {
262 6         21 $self->{'label'} = $value;
263             }
264 56 50       146 if ( ! exists $self->{'label'} ) {
265 0         0 return;
266             }
267 56         243 return $self->{'label'};
268             }
269              
270              
271             =head2 transpos
272              
273             Title : transpos
274             Usage : $obj->transpos();
275             Function:
276              
277             Sets and returns the transcript position of the mutation.
278             Set when associated with a reference sequence. Value
279             depends on reference molecule and the co-ordinate system
280             used.
281              
282             Example :
283             Returns : string
284             Args : integer
285              
286             =cut
287              
288              
289             sub transpos {
290 17     17 1 34 my ($self,$value) = @_;
291 17 100       28 if( defined $value) {
292 6 50       88 if ( $value !~ /^([+-])?\d+$/ ) {
293 0         0 $self->throw("[$value] for transpos has to be an integer\n");
294             } else {
295 6         25 $self->{'transpos'} = $value;
296             }
297             }
298 17         66 return $self->{'transpos'};
299             }
300              
301              
302             =head2 issue
303              
304             Title : issue
305             Usage : $obj->issue();
306             Function:
307              
308             Sets and returns the position of the mutation in an array
309             of mutations to be issued. Set after the validity of the
310             mutation has been confirmed.
311              
312             Example :
313             Returns : string
314             Args : integer
315              
316             =cut
317              
318              
319             sub issue {
320 27     27 1 56 my ($self,$value) = @_;
321 27 100       64 if( defined $value) {
322 6 50       64 if ( $value !~ /^([+-])?\d+$/ ) {
323 0         0 $self->throw("[$value] for issue has to be an integer\n");
324             } else {
325 6         15 $self->{'issue'} = $value;
326             }
327             }
328 27         114 return $self->{'issue'};
329             }
330              
331              
332             =head2 prelabel
333              
334             Title : prelabel
335             Usage : $obj->prelabel();
336             Function:
337              
338             Sets and returns the prelabel of the affected original allele
339             location. Prelabel is a stable identifier whereas location
340             can be changed by mutations. Prelabel comes from
341             l.
342              
343             Example :
344             Returns : string
345             Args : string
346              
347             =cut
348              
349             sub prelabel {
350 80     80 1 97 my ($self,$value) = @_;
351 80 100       119 if ( defined $value) {
352 6         14 $self->{'prelabel'} = $value;
353             }
354 80 50       123 if ( ! exists $self->{'prelabel'} ) {
355 0         0 return;
356             }
357 80         312 return $self->{'prelabel'};
358             }
359              
360              
361             =head2 postlabel
362              
363             Title : postlabel
364             Usage : $obj->postlabel();
365             Function:
366              
367             Sets and returns the postlabel of the affected original allele
368             location. Postlabel is a stable identifier whereas location
369             can be changed by mutations. Postlabel comes from
370             l.
371              
372             Example :
373             Returns : string
374             Args : string
375              
376             =cut
377              
378             sub postlabel {
379 69     69 1 97 my ($self,$value) = @_;
380 69 100       97 if ( defined $value) {
381 6         23 $self->{'postlabel'} = $value;
382             }
383 69 50       111 if ( ! exists $self->{'postlabel'} ) {
384 0         0 return;
385             }
386 69         334 return $self->{'postlabel'};
387             }
388              
389              
390             =head2 lastlabel
391              
392             Title : lastlabel
393             Usage : $obj->lastlabel();
394             Function:
395              
396             Sets and returns the lastlabel of the affected original allele
397             location. Lastlabel is a stable identifier whereas location
398             can be changed by mutations. Lastlabel comes from
399             l.
400              
401             Example :
402             Returns : string
403             Args : string
404              
405             =cut
406              
407             sub lastlabel {
408 17     17 1 29 my ($self,$value) = @_;
409 17 100       41 if ( defined $value) {
410 6         13 $self->{'lastlabel'} = $value;
411             }
412 17 50       42 if ( ! exists $self->{'lastlabel'} ) {
413 0         0 return;
414             }
415 17         61 return $self->{'lastlabel'};
416             }
417              
418             1;