File Coverage

Bio/Variation/SNP.pm
Criterion Covered Total %
statement 37 37 100.0
branch 10 12 83.3
condition n/a
subroutine 9 9 100.0
pod 4 4 100.0
total 60 62 96.7


line stmt bran cond sub pod time code
1             # bioperl module for Bio::Variation::SNP
2             #
3             # Copyright Allen Day , Stan Nelson
4             # Human Genetics, UCLA Medical School, University of California, Los Angeles
5              
6             =head1 NAME
7              
8             Bio::Variation::SNP - submitted SNP
9              
10             =head1 SYNOPSIS
11              
12             $SNP = Bio::Variation::SNP->new ();
13              
14             =head1 DESCRIPTION
15              
16             Inherits from Bio::Variation::SeqDiff and Bio::Variation::Allele, with
17             additional methods that are (db)SNP specific (ie, refSNP/subSNP IDs, batch
18             IDs, validation methods).
19              
20             =head1 FEEDBACK
21              
22             =head2 Mailing Lists
23              
24             User feedback is an integral part of the evolution of this and other
25             Bioperl modules. Send your comments and suggestions preferably to one
26             of the Bioperl mailing lists. Your participation is much appreciated.
27              
28             bioperl-l@bioperl.org - General discussion
29             http://bioperl.org/wiki/Mailing_lists - About the mailing lists
30              
31             =head2 Support
32              
33             Please direct usage questions or support issues to the mailing list:
34              
35             I
36              
37             rather than to the module maintainer directly. Many experienced and
38             reponsive experts will be able look at the problem and quickly
39             address it. Please include a thorough description of the problem
40             with code and data examples if at all possible.
41              
42             =head2 Reporting Bugs
43              
44             Report bugs to the Bioperl bug tracking system to help us keep track
45             the bugs and their resolution. Bug reports can be submitted via the
46             web:
47              
48             https://github.com/bioperl/bioperl-live/issues
49              
50             =head1 AUTHOR
51              
52             Allen Day Eallenday@ucla.eduE
53              
54             =head1 APPENDIX
55              
56             The rest of the documentation details each of the object
57             methods. Internal methods are usually preceded with a _
58              
59             =cut
60              
61             # Let the code begin...
62              
63             package Bio::Variation::SNP;
64              
65 2     2   434 use strict;
  2         2  
  2         46  
66 2     2   5 use vars qw($AUTOLOAD);
  2         1  
  2         57  
67 2     2   292 use Bio::Root::Root;
  2         2  
  2         83  
68              
69 2     2   7 use base qw(Bio::Variation::SeqDiff Bio::Variation::Allele);
  2         3  
  2         673  
70              
71             =head2 get/set-able methods
72              
73             Usage : $is = $snp->method()
74             Function: for getting/setting attributes
75             Returns : a value. probably a scalar.
76             Args : if you're trying to set an attribute, pass in the new value.
77              
78             Methods:
79             --------
80             id
81             type
82             observed
83             seq_5
84             seq_3
85             ncbi_build
86             ncbi_chr_hits
87             ncbi_ctg_hits
88             ncbi_seq_loc
89             ucsc_build
90             ucsc_chr_hits
91             ucsc_ctg_hits
92             heterozygous
93             heterozygous_SE
94             validated
95             genotype
96             handle
97             batch_id
98             method
99             locus_id
100             symbol
101             mrna
102             protein
103             functional_class
104              
105             =cut
106              
107             #'
108             my %OK_AUTOLOAD = (
109             id => '',
110             type => '',
111             observed => [],
112             seq_5 => '',
113             seq_3 => '',
114             ncbi_build => '',
115             ncbi_chr_hits => '',
116             ncbi_ctg_hits => '',
117             ncbi_seq_loc => '',
118             ucsc_build => '',
119             ucsc_chr_hits => '',
120             ucsc_ctg_hits => '',
121             heterozygous => '',
122             heterozygous_SE => '',
123             validated => '',
124             genotype => '',
125             handle => '',
126             batch_id => '',
127             method => '',
128             locus_id => '',
129             symbol => '',
130             mrna => '',
131             protein => '',
132             functional_class => '',
133             );
134              
135             sub AUTOLOAD {
136 43     43   1277 my $self = shift;
137 43         39 my $param = $AUTOLOAD;
138 43         161 $param =~ s/.*:://;
139 43 100       114 $self->throw(__PACKAGE__." doesn't implement $param") unless defined $OK_AUTOLOAD{$param};
140              
141 42 100       67 if( ref $OK_AUTOLOAD{$param} eq 'ARRAY' ) {
142 2 100       8 push @{$self->{$param}}, shift if @_;
  1         3  
143 2         3 return $self->{$param}->[scalar(@{$self->{$param}}) - 1];
  2         9  
144             } else {
145 40 100       86 $self->{$param} = shift if @_;
146 40         101 return $self->{$param};
147             }
148             }
149              
150              
151             #foreach my $slot (keys %RWSLOT){
152             # no strict "refs"; #add class methods to package
153             # *$slot = sub {
154             # shift;
155             # $RWSLOT{$slot} = shift if @_;
156             # return $RWSLOT{$slot};
157             # };
158             #}
159              
160              
161             =head2 is_subsnp
162              
163             Title : is_subsnp
164             Usage : $is = $snp->is_subsnp()
165             Function: returns 1 if $snp is a subSNP
166             Returns : 1 or undef
167             Args : NONE
168              
169             =cut
170              
171             sub is_subsnp {
172 44     44 1 70 return shift->{is_subsnp};
173             }
174              
175             =head2 subsnp
176              
177             Title : subsnp
178             Usage : $subsnp = $snp->subsnp()
179             Function: returns the currently active subSNP of $snp
180             Returns : Bio::Variation::SNP
181             Args : NONE
182              
183             =cut
184              
185             sub subsnp {
186 34     34 1 22 my $self = shift;
187 34         50 return $self->{subsnps}->[ scalar($self->each_subsnp) - 1 ];
188             }
189              
190             =head2 add_subsnp
191              
192             Title : add_subsnp
193             Usage : $subsnp = $snp->add_subsnp()
194             Function: pushes the previous value returned by subsnp() onto a stack,
195             accessible with each_subsnp().
196             Sets return value of subsnp() to a new Bio::Variation::SNP
197             object, and returns that object.
198             Returns : Bio::Varitiation::SNP
199             Args : NONE
200              
201             =cut
202              
203             sub add_subsnp {
204 7     7 1 8 my $self = shift;
205 7 50       13 $self->throw("add_subsnp(): cannot add subSNP to subSNP, only to refSNP")
206             if $self->is_subsnp;
207              
208 7         17 my $subsnp = Bio::Variation::SNP->new;
209 7         7 push @{$self->{subsnps}}, $subsnp;
  7         13  
210 7         13 $self->subsnp->{is_subsnp} = 1;
211 7         11 return $self->subsnp;
212             }
213              
214             =head2 each_subsnp
215              
216             Title : each_subsnp
217             Usage : @subsnps = $snp->each_subsnp()
218             Function: returns a list of the subSNPs of a refSNP
219             Returns : list
220             Args : NONE
221              
222             =cut
223              
224             sub each_subsnp {
225 36     36 1 27 my $self = shift;
226 36 50       43 $self->throw("each_subsnp(): cannot be called on a subSNP")
227             if $self->is_subsnp;
228 36         26 return @{$self->{subsnps}};
  36         128  
229             }
230              
231             1;