|
0
|
1 # $Id: Primer.pm,v 1.10 2002/10/30 14:21:58 heikki Exp $
|
|
|
2 #
|
|
|
3 # BioPerl module for Bio::SeqFeature::Primer
|
|
|
4 #
|
|
|
5 # Cared for by Chad Matsalla
|
|
|
6 #
|
|
|
7 # Copyright Chad Matsalla
|
|
|
8 #
|
|
|
9 # You may distribute this module under the same terms as perl itself
|
|
|
10
|
|
|
11 # POD documentation - main docs before the code
|
|
|
12
|
|
|
13 =head1 NAME
|
|
|
14
|
|
|
15 Bio::SeqFeature::Primer - Primer Generic SeqFeature
|
|
|
16
|
|
|
17 =head1 SYNOPSIS
|
|
|
18
|
|
|
19 A synopsis does not yet exist for this module.
|
|
|
20
|
|
|
21 =head1 DESCRIPTION
|
|
|
22
|
|
|
23 A description does not yet exist for this module.
|
|
|
24
|
|
|
25 =head1 FEEDBACK
|
|
|
26
|
|
|
27 =head2 Mailing Lists
|
|
|
28
|
|
|
29 User feedback is an integral part of the evolution of this and other
|
|
|
30 Bioperl modules. Send your comments and suggestions preferably to one
|
|
|
31 of the Bioperl mailing lists. Your participation is much appreciated.
|
|
|
32
|
|
|
33 bioperl-l@bioperl.org - General discussion
|
|
|
34 http://bio.perl.org/MailList.html - About the mailing lists
|
|
|
35
|
|
|
36 =head2 Reporting Bugs
|
|
|
37
|
|
|
38 Report bugs to the Bioperl bug tracking system to help us keep track
|
|
|
39 the bugs and their resolution. Bug reports can be submitted via email
|
|
|
40 or the web:
|
|
|
41
|
|
|
42 bioperl-bugs@bio.perl.org
|
|
|
43 http://bugzilla.bioperl.org/
|
|
|
44
|
|
|
45 =head1 AUTHOR - Chad Matsalla
|
|
|
46
|
|
|
47 Chad Matsalla E<lt>bioinformatics1@dieselwurks.comE<gt>
|
|
|
48
|
|
|
49 =head1 APPENDIX
|
|
|
50
|
|
|
51 The rest of the documentation details each of the object
|
|
|
52 methods. Internal methods are usually preceded with a _
|
|
|
53
|
|
|
54 =cut
|
|
|
55
|
|
|
56
|
|
|
57 # Let the code begin...
|
|
|
58
|
|
|
59
|
|
|
60 package Bio::SeqFeature::Primer;
|
|
|
61 use vars qw(@ISA);
|
|
|
62 use strict;
|
|
|
63
|
|
|
64 use Bio::Root::Root;
|
|
|
65 use Bio::SeqFeature::Generic;
|
|
|
66 use Bio::Seq;
|
|
|
67 use Dumpvalue qw(dumpValue);
|
|
|
68
|
|
|
69 my $dumper = new Dumpvalue();
|
|
|
70
|
|
|
71
|
|
|
72 @ISA = qw(Bio::Root::Root Bio::SeqFeature::Generic);
|
|
|
73
|
|
|
74
|
|
|
75
|
|
|
76 =head2 new()
|
|
|
77
|
|
|
78 Title : new()
|
|
|
79 Usage :
|
|
|
80 Function:
|
|
|
81 Example :
|
|
|
82 Returns :
|
|
|
83 Args :
|
|
|
84 Devel notes: I think that I want to accept a hash
|
|
|
85
|
|
|
86 =cut
|
|
|
87
|
|
|
88
|
|
|
89 sub new {
|
|
|
90 my ($class, @args) = @_;
|
|
|
91 my %arguments = @args;
|
|
|
92 my $self = $class->SUPER::new(@args);
|
|
|
93 # these are from generic.pm, with which i started
|
|
|
94 $self->{'_parse_h'} = {};
|
|
|
95 $self->{'_gsf_tag_hash'} = {};
|
|
|
96 # things that belong with the primer
|
|
|
97 my ($sequence, $primer_sequence_id, $id) =
|
|
|
98 $self->{'_gsf_seqname'} = $self->{primer_sequence_id};
|
|
|
99 # i am going to keep an array of the things that have been passed
|
|
|
100 # into the object on construction. this will aid retrieval of these
|
|
|
101 # things later
|
|
|
102 foreach my $argument (sort keys %arguments) {
|
|
|
103 if ($argument eq "-SEQUENCE" || $argument eq "-sequence") {
|
|
|
104 if (ref($arguments{$argument}) eq "Bio::Seq") {
|
|
|
105 $self->{seq} = $arguments{$argument};
|
|
|
106 }
|
|
|
107 else {
|
|
|
108 $self->{seq} = new Bio::Seq( -seq => $arguments{$argument},
|
|
|
109 -id => $arguments{-id});
|
|
|
110 }
|
|
|
111 $self->{tags}->{$argument} = "A Bio::Seq. Use seq() to get this 'tag'";
|
|
|
112 }
|
|
|
113 else {
|
|
|
114 (my $fixed = $argument) =~ s/-//;
|
|
|
115 $self->{tags}->{$fixed} = $arguments{$argument};
|
|
|
116 }
|
|
|
117 }
|
|
|
118 if (!$self->{seq}) {
|
|
|
119 $self->throw("You must pass in a sequence to construct this object.");
|
|
|
120 }
|
|
|
121
|
|
|
122 # a bunch of things now need to be set for this SeqFeature
|
|
|
123 # things like:
|
|
|
124 # TARGET=513,26
|
|
|
125 # PRIMER_FIRST_BASE_INDEX=1
|
|
|
126 # PRIMER_LEFT=484,20
|
|
|
127 return $self;
|
|
|
128 }
|
|
|
129
|
|
|
130
|
|
|
131 =head2 seq()
|
|
|
132
|
|
|
133 Title : seq()
|
|
|
134 Usage : $seq = $primer->seq();
|
|
|
135 Function: Return the _entire_ sequence associated with this Primer.
|
|
|
136 Returns : A Bio::Seq object
|
|
|
137 Args : None.
|
|
|
138 Develper Note: Do you want to be able to set the sequence associated with this
|
|
|
139 SeqFeature?
|
|
|
140
|
|
|
141 =cut
|
|
|
142
|
|
|
143 sub seq {
|
|
|
144 my $self = shift;
|
|
|
145 return $self->{seq};
|
|
|
146 }
|
|
|
147
|
|
|
148
|
|
|
149
|
|
|
150 =head2 all_tags()
|
|
|
151
|
|
|
152 Title : all_tags()
|
|
|
153 Usage : @tags = $primer->all_tags();
|
|
|
154 Function: Return a list of tag names for this Primer.
|
|
|
155 Returns : An array of strings representing the names of tags in this Primer
|
|
|
156 Args : None.
|
|
|
157 Notes : When the Bio::SeqFeature::Primer object is created, the user can
|
|
|
158 pass in an arbitrary hash containing key->value pairs. This is allowed
|
|
|
159 because I didn't want to assume that the user was trying to model a
|
|
|
160 primer3 construct.
|
|
|
161
|
|
|
162 =cut
|
|
|
163
|
|
|
164 #'
|
|
|
165
|
|
|
166 sub all_tags {
|
|
|
167 my $self = shift;
|
|
|
168 my @tags = sort keys %{$self->{tags}};
|
|
|
169 return @tags;
|
|
|
170 }
|
|
|
171
|
|
|
172
|
|
|
173 =head2 primary_tag()
|
|
|
174
|
|
|
175 Title : primary_tag()
|
|
|
176 Usage : $tag = $feature->primary_tag();
|
|
|
177 Function: Returns the string "Primer"
|
|
|
178 Returns : A string.
|
|
|
179 Args : None.
|
|
|
180
|
|
|
181 =cut
|
|
|
182
|
|
|
183 sub primary_tag {
|
|
|
184 return "Primer";
|
|
|
185 }
|
|
|
186
|
|
|
187 =head2 source_tag()
|
|
|
188
|
|
|
189 Title : source_tag()
|
|
|
190 Usage : $tag = $feature->source_tag();
|
|
|
191 Function: Returns the source of this tag.
|
|
|
192 Returns : A string.
|
|
|
193 Args : If an argument is provided, the source of this SeqFeature
|
|
|
194 is set to that argument.
|
|
|
195
|
|
|
196 =cut
|
|
|
197
|
|
|
198 sub source_tag {
|
|
|
199 my ($self,$insource) = @_;
|
|
|
200 if ($insource) { $self->{source} = $insource; }
|
|
|
201 return $self->{source};
|
|
|
202 }
|
|
|
203
|
|
|
204 =head2 has_tag()
|
|
|
205
|
|
|
206 Title : has_tag()
|
|
|
207 Usage : $true_or_false = $feature->has_tag('MELTING_TEMPERATURE');
|
|
|
208 Function: Does this SeqFeature have this tag?
|
|
|
209 Returns : TRUE or FALSE
|
|
|
210 Args : A string.
|
|
|
211
|
|
|
212 =cut
|
|
|
213
|
|
|
214 sub has_tag {
|
|
|
215 my ($self,$tagname) = @_;
|
|
|
216 if ($self->{tags}->{$tagname}) { return "TRUE"; }
|
|
|
217 return { "FALSE" };
|
|
|
218 }
|
|
|
219
|
|
|
220 =head2 each_tag_value()
|
|
|
221
|
|
|
222 Title : each_tag_value()
|
|
|
223 Usage : $tag = $feature->each_tag_value('MELTING_TEMPERATURE');
|
|
|
224 Function: Returns the value of this tag.
|
|
|
225 Returns : Unknown. Whatever the value of the given tag was.
|
|
|
226 Args : None.
|
|
|
227
|
|
|
228 =cut
|
|
|
229
|
|
|
230 sub each_tag_value {
|
|
|
231 my ($self,$tagname) = @_;
|
|
|
232 return $self->{tags}->{$tagname};
|
|
|
233 }
|
|
|
234
|
|
|
235 =head2 location()
|
|
|
236
|
|
|
237 Title : location()
|
|
|
238 Usage : $tag = $feature->location();
|
|
|
239 Function: returns a location object suitable for identifying location of
|
|
|
240 feature on sequence or parent feature
|
|
|
241 Returns : a bio::locationi object.
|
|
|
242 Args : none.
|
|
|
243 Developer Notes: Chad has no idea how to implement this at this time.
|
|
|
244
|
|
|
245 =cut
|
|
|
246
|
|
|
247 sub location {
|
|
|
248 my $self = shift;
|
|
|
249 $self->warn("Chad has not written the code for this yet.");
|
|
|
250 }
|
|
|
251
|
|
|
252 =head2 start()
|
|
|
253
|
|
|
254 Title : start()
|
|
|
255 Usage : $start_position = $feature->start($new_position);
|
|
|
256 Function: Return the start position of this Primer.
|
|
|
257 Returns : The start position of this Primer.
|
|
|
258 Args : If an argument is provided, the start position of this
|
|
|
259 Primer is set to that position.
|
|
|
260
|
|
|
261 =cut
|
|
|
262
|
|
|
263 sub start {
|
|
|
264 my ($self,$new_position) = @_;
|
|
|
265 if ($new_position) { $self->{start_position} = $new_position; }
|
|
|
266 return $self->{start_position};
|
|
|
267 }
|
|
|
268
|
|
|
269 =head2 end()
|
|
|
270
|
|
|
271 Title : end()
|
|
|
272 Usage : $end_position = $feature->end($new_position);
|
|
|
273 Function: Return the end position of this Primer.
|
|
|
274 Returns : The end position of this Primer.
|
|
|
275 Args : If an argument is provided, the end position of this
|
|
|
276 Primer is set to that position.
|
|
|
277
|
|
|
278 =cut
|
|
|
279
|
|
|
280 sub end {
|
|
|
281 my ($self,$new_position) = @_;
|
|
|
282 if ($new_position) { $self->{end_position} = $new_position; }
|
|
|
283 return $self->{end_position};
|
|
|
284 }
|
|
|
285
|
|
|
286 =head2 strand()
|
|
|
287
|
|
|
288 Title : strand()
|
|
|
289 Usage :
|
|
|
290 Function:
|
|
|
291 Returns :
|
|
|
292 Args :
|
|
|
293 Developer Notes: Chad has no idea how to implement this at this time.
|
|
|
294
|
|
|
295 =cut
|
|
|
296
|
|
|
297 sub strand {
|
|
|
298 my $self = shift;
|
|
|
299 $self->warn("Chad has not implemented this method at this time.");
|
|
|
300 }
|
|
|
301
|
|
|
302 =head2 display_id()
|
|
|
303
|
|
|
304 Title : display_id()
|
|
|
305 Usage : $id = $feature->display_id($new_id)
|
|
|
306 Function: Returns the display ID for this Primer feature
|
|
|
307 Returns : A scalar.
|
|
|
308 Args : If an argument is provided, the display_id of this Primer is
|
|
|
309 set to that value.
|
|
|
310
|
|
|
311 =cut
|
|
|
312
|
|
|
313 sub display_id {
|
|
|
314 my ($self,$newid) = @_;
|
|
|
315 if ($newid) { $self->seq()->display_id($newid); }
|
|
|
316 return $self->seq()->display_id();
|
|
|
317 }
|
|
|
318
|
|
|
319
|
|
|
320 1;
|
