File Coverage

Bio/SeqFeature/SiRNA/Pair.pm
Criterion Covered Total %
statement 44 75 58.6
branch 21 60 35.0
condition 2 8 25.0
subroutine 8 10 80.0
pod 5 5 100.0
total 80 158 50.6


line stmt bran cond sub pod time code
1             #
2             # BioPerl module for Bio::SeqFeature::SiRNA::Pair
3             #
4             # Please direct questions and support issues to
5             #
6             # Cared for by Donald Jackson, donald.jackson@bms.com
7             #
8             # Copyright Donald Jackson
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::SeqFeature::SiRNA::Pair - Perl object for small inhibitory RNA
17             (SiRNA) oligo pairs
18              
19             =head1 SYNOPSIS
20              
21             use Bio::SeqFeature::SiRNA::Pair;
22             my $pair = Bio::SeqFeature::SiRNA::Pair->
23             new( -sense => $bio_seqfeature_sirna_oligo, # strand=1
24             -antisense => $bio_seqfeature_sirna_oligo, # strand= -1
25             -primary => 'SiRNA::Pair',
26             -source_tag => 'Bio::Tools::SiRNA',
27             -start => 8,
28             -end => 31,
29             -rank => 1,
30             -fxgc => 0.5,
31             -tag => { note => 'a note' } );
32              
33             $target_sequence->add_SeqFeature($pair);
34              
35             =head1 DESCRIPTION
36              
37             Object methods for (complementary) pairs of L
38             objects - inherits L. See that package for information
39             on inherited methods.
40              
41             Does B include methods for designing SiRNAs -- see L
42              
43             =head1 SEE ALSO
44              
45             L, L.
46              
47             =head1 FEEDBACK
48              
49             =head2 Mailing Lists
50              
51             User feedback is an integral part of the evolution of this and other
52             Bioperl modules. Send your comments and suggestions preferably to
53             the Bioperl mailing list. Your participation is much appreciated.
54              
55             bioperl-l@bioperl.org - General discussion
56             http://bioperl.org/wiki/Mailing_lists - About the mailing lists
57              
58             =head2 Support
59              
60             Please direct usage questions or support issues to the mailing list:
61              
62             I
63              
64             rather than to the module maintainer directly. Many experienced and
65             reponsive experts will be able look at the problem and quickly
66             address it. Please include a thorough description of the problem
67             with code and data examples if at all possible.
68              
69             =head2 Reporting Bugs
70              
71             Report bugs to the Bioperl bug tracking system to help us keep track
72             of the bugs and their resolution. Bug reports can be submitted via
73             the web:
74              
75             https://github.com/bioperl/bioperl-live/issues
76              
77             =head1 AUTHOR
78              
79             Donald Jackson (donald.jackson@bms.com)
80              
81             =head1 APPENDIX
82              
83             The rest of the documentation details each of the object methods.
84             Internal methods are usually preceded with a _
85              
86             =cut
87              
88             package Bio::SeqFeature::SiRNA::Pair;
89              
90 1     1   3 use strict;
  1         1  
  1         23  
91 1     1   3 use warnings;
  1         0  
  1         21  
92              
93 1     1   4 use base qw(Bio::SeqFeature::Generic);
  1         1  
  1         662  
94              
95             # arguments to new(). Taken from Bio::SeqFeature Generic.
96             # Omit frame (not relevant), GFF_STRING and GFF1_STRING
97             # because I'm not sure how to handle them. Add RANK, FXGC, SENSE, ANTISENSE
98             our @ARGNAMES = qw(RANK FXGC SENSE ANTISENSE START END STRAND PRIMARY SOURCE_TAG
99             SCORE TAG SEQNAME ANNOTATION LOCATION);
100              
101             =head1 METHODS
102              
103             =head2 new
104              
105             Title : new
106             Usage : my $sirna_pair = Bio::SeqFeature::SiRNA::Pair->new();
107             Purpose : Create a new SiRNA::Pair object
108             Returns : Bio::Tools::SiRNA object
109             Args : -start 10
110             -end 31
111             -rank 1 # 'Rank' in Tuschl group's rules
112             -fxgc 0.5 # GC fraction for target sequence
113             -primary 'SiRNA::Pair', # default value
114             -source_tag 'Bio::Tools::SiRNA'
115             -tag { note => 'A note' }
116             -sense a Bio::SeqFeature::SiRNA::Oligo object
117             with strand = 1
118             -antisense a Bio::SeqFeature::SiRNA::Oligo object
119             with strand = -1
120             );
121              
122             Note : SiRNA::Pair objects are typically created by a design
123             algorithm such as Bio::Tools::SiRNA
124              
125             =cut
126              
127             sub new {
128 312     312 1 530 my ($proto, @args) = @_;
129              
130 312   33     698 my $pkg = ref($proto) || $proto;
131              
132 312         538 my $self = $pkg->SUPER::new();
133 312         234 my %args;
134 312         462 @args{@ARGNAMES} = $self->_rearrange(\@ARGNAMES, @args);
135             # default primary tag
136 312   50     1235 $args{'PRIMARY'} ||= 'SiRNA::Pair';
137              
138 312 50       804 $args{'PRIMARY'} && $self->primary_tag($args{'PRIMARY'});
139 312 50       658 $args{'SOURCE_TAG'} && $self->source_tag($args{'SOURCE_TAG'});
140 312 50       393 $args{'SEQNAME'} && $self->seqname($args{'SEQNAME'});
141 312 50       396 $args{'ANNOTATION'} && $self->annotation($args{'ANNOTATION'});
142 312 50       379 $args{'LOCATION'} && $self->location($args{'LOCATION'});
143 312 50       652 $args{'SENSE'} && $self->sense($args{'SENSE'});
144 312 50       707 $args{'ANTISENSE'} && $self->antisense($args{'ANTISENSE'});
145 312 50       492 defined($args{'START'}) && $self->start($args{'START'});
146 312 50       423 defined($args{'END'}) && $self->end($args{'END'});
147 312 50       418 defined($args{'STRAND'}) && $self->strand($args{'STRAND'});
148 312 50       377 defined($args{'SCORE'}) && $self->score($args{'SCORE'});
149 312 50       606 defined($args{'RANK'}) && $self->rank($args{'RANK'});
150 312 50       427 defined($args{'FXGC'}) && $self->fxGC($args{'FXGC'});
151              
152 312 50       368 if ($args{'TAG'}) {
153 0         0 foreach my $t (keys %{$args{'TAG'}}) {
  0         0  
154 0         0 $self->add_tag_value($t, $args{'TAG'}->{$t});
155             }
156             }
157              
158              
159 312         935 return $self;
160             }
161              
162             =head2 rank
163              
164             Title : rank
165             Usage : my $pair_rank = $sirna_pair->rank()
166             Purpose : Get/set the 'quality rank' for this pair.
167             See Bio::Tools::SiRNA for a description of ranks.
168             Returns : scalar
169             Args : scalar (optional) indicating pair rank
170              
171             =cut
172              
173             sub rank {
174 312     312 1 228 my ($self, $rank) = @_;
175              
176 312 50       344 if (defined $rank) {
177             # first clear out old tags
178 312 50       430 $self->remove_tag('rank') if ( $self->has_tag('rank') );
179 312         484 $self->add_tag_value('rank', $rank);
180             }
181             else {
182 0 0       0 if ($self->has_tag('rank')) {
183 0         0 my @ranks = $self->get_tag_values('rank');
184 0         0 return shift @ranks;
185             }
186             else {
187 0         0 $self->throw("Rank not defined for this Pair\n");
188 0         0 return;
189             }
190             }
191             }
192              
193             =head2 fxGC
194              
195             Title : fxGC
196             Usage : my $fxGC = $sirna_pair->fxGC();
197             Purpose : Get/set the fraction of GC for this pair - based on TARGET sequence, not oligos.
198             Returns : scalar between 0-1
199             Args : scalar between 0-1 (optional)
200              
201             =cut
202              
203              
204             sub fxGC {
205 0     0 1 0 my ($self, $fxGC) = @_;
206              
207 0 0       0 if (defined $fxGC) {
208             # is this an integer?
209 0 0       0 if ($fxGC =~ /[^.\d]/) {
210 0         0 $self->throw( -class => 'Bio::Root::BadParameter',
211             -text => "Fraction GC must be a number between 0, 1 - NOT <$fxGC>",
212             -value => $fxGC
213             );
214             }
215 0 0 0     0 if ( $fxGC < 0 or $fxGC > 1 ) {
216 0         0 $self->throw( -class => 'Bio::Root::BadParameter',
217             -text => "Fraction GC must be a number between 0, 1 - NOT <$fxGC>",
218             -value => $fxGC
219             );
220             }
221            
222             # clear out old tags
223 0 0       0 $self->remove_tag('fxGC') if ( $self->has_tag('fxGC') );
224 0 0       0 $self->add_tag_value('fxGC', $fxGC)
225             or $self->throw("Unable to set fxGC");
226             }
227             else {
228 0 0       0 if ($self->has_tag('fxGC')) {
229 0         0 my @fxGCs = $self->get_tag_values('fxGC');
230 0         0 return shift @fxGCs;
231             }
232             else {
233 0         0 $self->throw("FxGC not defined for this Pair");
234             }
235             }
236             }
237              
238             =head2 sense
239              
240             Title : sense
241             Usage : my $sense_oligo = $sirna_pair->sense()
242             Purpose : Get/set the SiRNA::Oligo object corresponding to the sense strand
243             Returns : Bio::SeqFeature::SiRNA::Oligo object
244             Args : Bio::SeqFeature::SiRNA::Oligo object
245              
246             =cut
247              
248              
249             sub sense {
250 312     312 1 233 my ($self, $soligo) = @_;
251              
252 312 50       385 if ($soligo) {
253 312 50       399 $self->_add_oligo($soligo, 1) or return;
254             }
255             else {
256 0         0 return $self->_get_oligo(1);
257             }
258             }
259              
260             =head2 antisense
261              
262             Title : antisense
263             Usage : my $antisense_oligo = $sirna_pair->antisense()
264             Purpose : Get/set the SiRNA::Oligo object corresponding to the antisense strand
265             Returns : Bio::SeqFeature::SiRNA::Oligo object
266             Args : Bio::SeqFeature::SiRNA::Oligo object
267              
268             =cut
269              
270             sub antisense {
271 312     312 1 234 my ($self, $asoligo) = @_;
272              
273 312 50       353 if ($asoligo) {
274 312 50       357 $self->_add_oligo($asoligo, -1) or return;
275             }
276             else {
277 0         0 return $self->_get_oligo(-1);
278             }
279             }
280            
281             sub _add_oligo {
282 624     624   450 my ($self, $oligo, $strand) = @_;
283              
284 624 50       1474 unless ($oligo->isa('Bio::SeqFeature::SiRNA::Oligo')) {
285 0         0 $self->throw( -class => 'Bio::Root::BadParameter',
286             -text => "Oligos must be passed as Bio::SeqFeature::SiRNA::Oligo objects\n");
287             }
288              
289 624         777 $oligo->strand($strand);
290 624         922 return $self->add_sub_SeqFeature($oligo, 'EXPAND');
291             }
292              
293             sub _get_oligo {
294 0     0     my ($self, $strand) = @_;
295 0           my $feat;
296              
297 0           my @feats = $self->sub_SeqFeature;
298              
299 0           foreach $feat (@feats) {
300 0 0         next unless ($feat->primary_tag eq 'SiRNA::Oligo');
301 0 0         next unless ($feat->strand == $strand);
302 0           return $feat;
303             }
304 0           return;
305             }
306              
307             1;