File Coverage

Bio/Tools/EPCR.pm
Criterion Covered Total %
statement 42 42 100.0
branch 18 22 81.8
condition n/a
subroutine 9 9 100.0
pod 5 5 100.0
total 74 78 94.8


line stmt bran cond sub pod time code
1             #
2             # BioPerl module for Bio::Tools::EPCR
3             #
4             # Please direct questions and support issues to
5             #
6             # Cared for by Jason Stajich
7             #
8             # Copyright Jason Stajich
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::Tools::EPCR - Parse ePCR output and make features
17              
18             =head1 SYNOPSIS
19              
20             # A simple annotation pipeline wrapper for ePCR data
21             # assuming ePCR data is already generated in file seq1.epcr
22             # and sequence data is in fasta format in file called seq1.fa
23              
24             use Bio::Tools::EPCR;
25             use Bio::SeqIO;
26             my $parser = Bio::Tools::EPCR->new(-file => 'seq1.epcr');
27             my $seqio = Bio::SeqIO->new(-format => 'fasta', -file => 'seq1.fa');
28             my $seq = $seqio->next_seq || die("cannot get a seq object from SeqIO");
29              
30             while( my $feat = $parser->next_feature ) {
31             # add EPCR annotation to a sequence
32             $seq->add_SeqFeature($feat);
33             }
34             my $seqout = Bio::SeqIO->new(-format => 'embl');
35             $seqout->write_seq($seq);
36              
37              
38             =head1 DESCRIPTION
39              
40             This object serves as a parser for ePCR data, creating a
41             Bio::SeqFeatureI for each ePCR hit. These can be processed or added
42             as annotation to an existing Bio::SeqI object for the purposes of
43             automated annotation.
44              
45             =head1 FEEDBACK
46              
47             =head2 Mailing Lists
48              
49             User feedback is an integral part of the evolution of this and other
50             Bioperl modules. Send your comments and suggestions preferably to
51             the Bioperl mailing list. Your participation is much appreciated.
52              
53             bioperl-l@bioperl.org - General discussion
54             http://bioperl.org/wiki/Mailing_lists - About the mailing lists
55              
56             =head2 Support
57              
58             Please direct usage questions or support issues to the mailing list:
59              
60             I
61              
62             rather than to the module maintainer directly. Many experienced and
63             reponsive experts will be able look at the problem and quickly
64             address it. Please include a thorough description of the problem
65             with code and data examples if at all possible.
66              
67             =head2 Reporting Bugs
68              
69             Report bugs to the Bioperl bug tracking system to help us keep track
70             of the bugs and their resolution. Bug reports can be submitted via the
71             web:
72              
73             https://github.com/bioperl/bioperl-live/issues
74              
75             =head1 AUTHOR - Jason Stajich
76              
77             Email jason-at-bioperl.org
78              
79             =head1 APPENDIX
80              
81             The rest of the documentation details each of the object methods.
82             Internal methods are usually preceded with a _
83              
84             =cut
85              
86              
87             # Let the code begin...
88              
89              
90             package Bio::Tools::EPCR;
91 2     2   432 use strict;
  2         2  
  2         65  
92              
93 2     2   808 use Bio::SeqFeature::FeaturePair;
  2         4  
  2         51  
94 2     2   9 use Bio::SeqFeature::Generic;
  2         2  
  2         43  
95              
96 2     2   9 use base qw(Bio::Root::Root Bio::SeqAnalysisParserI Bio::Root::IO);
  2         2  
  2         827  
97              
98             =head2 new
99              
100             Title : new
101             Usage : my $epcr = Bio::Tools::EPCR->new(-file => $file,
102             -primary => $fprimary,
103             -source => $fsource,
104             -groupclass => $fgroupclass);
105             Function: Initializes a new EPCR parser
106             Returns : Bio::Tools::EPCR
107             Args : -fh => filehandle
108             OR
109             -file => filename
110              
111             -primary => a string to be used as the common value for
112             each features '-primary' tag. Defaults to
113             'sts'. (This in turn maps to the GFF 'type'
114             tag (aka 'method')).
115              
116             -source => a string to be used as the common value for
117             each features '-source' tag. Defaults to
118             'e-PCR'. (This in turn maps to the GFF 'source'
119             tag)
120              
121             -groupclass => a string to be used as the name of the tag
122             which will hold the sts marker namefirst
123             attribute. Defaults to 'name'.
124              
125             =cut
126              
127             sub new {
128 2     2 1 6 my($class,@args) = @_;
129              
130 2         15 my $self = $class->SUPER::new(@args);
131 2         11 my ($primary, $source,
132             $groupclass) = $self->_rearrange([qw(PRIMARY
133             SOURCE
134             GROUPCLASS)],@args);
135 2 50       11 $self->primary(defined $primary ? $primary : 'sts');
136 2 50       7 $self->source(defined $source ? $source : 'e-PCR');
137 2 50       6 $self->groupclass(defined $groupclass ? $groupclass : 'name');
138              
139 2         14 $self->_initialize_io(@args);
140 2         6 return $self;
141             }
142              
143             =head2 next_feature
144              
145             Title : next_feature
146             Usage : $seqfeature = $obj->next_feature();
147             Function: Returns the next feature available in the analysis result, or
148             undef if there are no more features.
149             Example :
150             Returns : A Bio::SeqFeatureI implementing object, or undef if there are no
151             more features.
152             Args : none
153              
154             =cut
155              
156             sub next_feature {
157 16     16 1 272 my ($self) = @_;
158 16         42 my $line = $self->_readline;
159 16 100       30 return unless defined($line);
160 14         18 chomp($line);
161 14         68 my($seqname,$location,$mkrname, $rest) = split(/\s+/,$line,4);
162            
163 14         57 my ($start,$end) = ($location =~ /(\S+)\.\.(\S+)/);
164              
165             # `e-PCR -direct` results code match strand in $rest as (+) and (-). Decode it if present.
166 14         12 my $strandsign;
167 14 100       35 if ($rest =~ m/^\(([+-])\)(.*)$/) {
168 12         281 ($strandsign,$rest) = ($1, $2);
169             } else {
170 2         2 $strandsign = "?";
171             }
172 14 100       31 my $strand = $strandsign eq "+" ? 1 : $strandsign eq "-" ? -1 : 0;
    100          
173              
174 14 50       26 my $markerfeature = Bio::SeqFeature::Generic->new
175             ( '-start' => $start,
176             '-end' => $end,
177             '-strand' => $strand,
178             '-source' => $self->source,
179             '-primary' => $self->primary,
180             '-seq_id' => $seqname,
181             '-tag' => {
182             $self->groupclass => $mkrname,
183             ($rest ? ('Note' => $rest ) : ()),
184             });
185             #$markerfeature->add_tag_value('Note', $rest) if defined $rest;
186 14         37 return $markerfeature;
187             }
188              
189             =head2 source
190              
191             Title : source
192             Usage : $obj->source($newval)
193             Function:
194             Example :
195             Returns : value of source (a scalar)
196             Args : on set, new value (a scalar or undef, optional)
197              
198              
199             =cut
200              
201             sub source{
202 16     16 1 15 my $self = shift;
203 16 100       31 return $self->{'_source'} = shift if @_;
204 14         24 return $self->{'_source'};
205             }
206              
207             =head2 primary
208              
209             Title : primary
210             Usage : $obj->primary($newval)
211             Function:
212             Example :
213             Returns : value of primary (a scalar)
214             Args : on set, new value (a scalar or undef, optional)
215              
216              
217             =cut
218              
219             sub primary{
220 16     16 1 18 my $self = shift;
221 16 100       25 return $self->{'_primary'} = shift if @_;
222 14         29 return $self->{'_primary'};
223             }
224              
225             =head2 groupclass
226              
227             Title : groupclass
228             Usage : $obj->groupclass($newval)
229             Function:
230             Example :
231             Returns : value of groupclass (a scalar)
232             Args : on set, new value (a scalar or undef, optional)
233              
234              
235             =cut
236              
237             sub groupclass{
238 16     16 1 12 my $self = shift;
239              
240 16 100       28 return $self->{'_groupclass'} = shift if @_;
241 14         61 return $self->{'_groupclass'};
242             }
243              
244             1;