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