Merge pull request #210 from hdevillers/master
[bioperl-live.git] / Bio / Tools / tRNAscanSE.pm
blobd183bf912847452d8e76622bc4e00404eb1365cf
2 # BioPerl module for Bio::Tools::tRNAscanSE
4 # Please direct questions and support issues to <bioperl-l@bioperl.org>
6 # Cared for by Jason Stajich <jason-at-bioperl.org>
8 # Copyright Jason Stajich
10 # You may distribute this module under the same terms as perl itself
12 # POD documentation - main docs before the code
14 =head1 NAME
16 Bio::Tools::tRNAscanSE - A parser for tRNAscan-SE output
18 =head1 SYNOPSIS
20 use Bio::Tools::tRNAscanSE;
22 my $parser = Bio::Tools::tRNAscanSE->new(-file => 'result.tRNAscanSE');
24 # parse the results
25 while( my $gene = $parser->next_prediction ) {
27 @exon_arr = $gene->get_SeqFeatures();
31 =head1 DESCRIPTION
33 This script will parse tRNAscan-SE output. Just the tabular output of
34 the tRNA locations in the genome for now.
36 =head1 FEEDBACK
38 =head2 Mailing Lists
40 User feedback is an integral part of the evolution of this and other
41 Bioperl modules. Send your comments and suggestions preferably to
42 the Bioperl mailing list. Your participation is much appreciated.
44 bioperl-l@bioperl.org - General discussion
45 http://bioperl.org/wiki/Mailing_lists - About the mailing lists
47 =head2 Support
49 Please direct usage questions or support issues to the mailing list:
51 I<bioperl-l@bioperl.org>
53 rather than to the module maintainer directly. Many experienced and
54 reponsive experts will be able look at the problem and quickly
55 address it. Please include a thorough description of the problem
56 with code and data examples if at all possible.
58 =head2 Reporting Bugs
60 Report bugs to the Bioperl bug tracking system to help us keep track
61 of the bugs and their resolution. Bug reports can be submitted via the
62 web:
64 https://github.com/bioperl/bioperl-live/issues
66 =head1 AUTHOR - Jason Stajich
68 Email jason-at-bioperl.org
70 =head1 APPENDIX
72 The rest of the documentation details each of the object methods.
73 Internal methods are usually preceded with a _
75 =cut
78 # Let the code begin...
81 package Bio::Tools::tRNAscanSE;
82 use strict;
84 use Bio::SeqFeature::Generic;
86 use base qw(Bio::Tools::AnalysisResult);
88 use vars qw($GeneTag $SrcTag $ExonTag);
89 ($GeneTag,$SrcTag,$ExonTag) = qw(gene tRNAscan-SE exon);
91 =head2 new
93 Title : new
94 Usage : my $obj = Bio::Tools::tRNAscanSE->new();
95 Function: Builds a new Bio::Tools::tRNAscanSE object
96 Returns : an instance of Bio::Tools::tRNAscanSE
97 Args : -fh/-file for input filename
98 -genetag => primary tag used in gene features (default 'tRNA_gene')
99 -exontag => primary tag used in exon features (default 'tRNA_exon')
100 -srctag => source tag used in all features (default 'tRNAscan-SE')
103 =cut
105 sub _initialize {
106 my($self,@args) = @_;
107 $self->SUPER::_initialize(@args);
108 my ($genetag,$exontag,$srctag) = $self->SUPER::_rearrange([qw(GENETAG
109 SRCTAG
110 EXONTAG)],
111 @args);
112 $self->gene_tag(defined $genetag ? $genetag : $GeneTag);
113 $self->source_tag(defined $srctag ? $srctag : $SrcTag);
114 $self->exon_tag(defined $exontag ? $exontag : $ExonTag);
115 $self->{'_seen'} = {};
118 =head2 gene_tag
120 Title : gene_tag
121 Usage : $obj->gene_tag($newval)
122 Function: Get/Set the value used for the 'gene_tag' of genes
123 Default is 'tRNA_gene' as set by the global $GeneTag
124 Returns : value of gene_tag (a scalar)
125 Args : on set, new value (a scalar or undef, optional)
128 =cut
130 sub gene_tag{
131 my $self = shift;
133 return $self->{'gene_tag'} = shift if @_;
134 return $self->{'gene_tag'};
137 =head2 source_tag
139 Title : source_tag
140 Usage : $obj->source_tag($newval)
141 Function: Get/Set the value used for the 'source_tag' of exons and genes
142 Default is 'tRNAscan-SE' as set by the global $SrcTag
143 Returns : value of source_tag (a scalar)
144 Args : on set, new value (a scalar or undef, optional)
147 =cut
149 sub source_tag{
150 my $self = shift;
152 return $self->{'_source_tag'} = shift if @_;
153 return $self->{'_source_tag'};
156 =head2 exon_tag
158 Title : exon_tag
159 Usage : $obj->exon_tag($newval)
160 Function: Get/Set the value used for the 'primary_tag' of exons
161 Default is 'tRNA_exon' as set by the global $ExonTag
162 Returns : value of exon_tag (a scalar)
163 Args : on set, new value (a scalar or undef, optional)
166 =cut
168 sub exon_tag{
169 my $self = shift;
171 return $self->{'_exon_tag'} = shift if @_;
172 return $self->{'_exon_tag'};
176 =head2 analysis_method
178 Usage : $genscan->analysis_method();
179 Purpose : Inherited method. Overridden to ensure that the name matches
180 /tRNAscan-SE/i.
181 Returns : String
182 Argument : n/a
184 =cut
186 #-------------
187 sub analysis_method {
188 #-------------
189 my ($self, $method) = @_;
190 if($method && ($method !~ /tRNAscan-SE/i)) {
191 $self->throw("method $method not supported in " . ref($self));
193 return $self->SUPER::analysis_method($method);
196 =head2 next_feature
198 Title : next_feature
199 Usage : while($gene = $genscan->next_feature()) {
200 # do something
202 Function: Returns the next gene structure prediction of the Genscan result
203 file. Call this method repeatedly until FALSE is returned.
205 The returned object is actually a SeqFeatureI implementing object.
206 This method is required for classes implementing the
207 SeqAnalysisParserI interface, and is merely an alias for
208 next_prediction() at present.
210 Example :
211 Returns : A Bio::SeqFeature::Generic object.
212 Args :
213 See also : L<Bio::SeqFeature::Generic>
215 =cut
217 sub next_feature {
218 my ($self,@args) = @_;
219 # even though next_prediction doesn't expect any args (and this method
220 # does neither), we pass on args in order to be prepared if this changes
221 # ever
222 return $self->next_prediction(@args);
225 =head2 next_prediction
227 Title : next_prediction
228 Usage : while($gene = $genscan->next_prediction()) {
229 # do something
231 Function: Returns the next gene structure prediction of the Genscan result
232 file. Call this method repeatedly until FALSE is returned.
234 Example :
235 Returns : A Bio::SeqFeature::Generic object.
236 Args :
237 See also : L<Bio::SeqFeature::Generic>
239 =cut
241 sub next_prediction {
242 my ($self) = @_;
243 my ($genetag,$srctag,$exontag) = ( $self->gene_tag,
244 $self->source_tag,
245 $self->exon_tag);
247 while( defined($_ = $self->_readline) ) {
248 if( m/^(\S+)\s+ # sequence name
249 (\d+)\s+ # tRNA #
250 (\d+)\s+(\d+)\s+ # tRNA start,end
251 (\w{3})\s+ # tRNA type
252 ([CAGT]{3})\s+ # Codon
253 (\d+)\s+(\d+)\s+ # Intron Begin End
254 (\d+\.\d+)/ox # Cove Score
257 my ($seqid,$tRNAnum,$start,$end,$type,
258 $codon,$intron_start,$intron_end,
259 $score) = ($1,$2,$3,$4,$5,$6,$7,$8,$9);
261 my $strand = 1;
262 if( $start > $end ) {
263 ($start,$end,$strand) = ($end,$start,-1);
265 if( $self->{'_seen'}->{$type}++ ) {
266 $type .= "-".$self->{'_seen'}->{$type};
268 my $gene = Bio::SeqFeature::Generic->new
269 ( -seq_id => $seqid,
270 -start => $start,
271 -end => $end,
272 -strand => $strand,
273 -score => $score,
274 -primary_tag => $genetag,
275 -source_tag => $srctag,
276 -tag => {
277 'ID' => "tRNA:$type",
278 'Name' => "tRNA:$type",
279 'AminoAcid' => $type,
280 'Codon' => $codon,
282 if( $intron_start ) {
283 if( $intron_start > $intron_end ) {
284 ($intron_start,$intron_end) = ($intron_end,$intron_start);
286 $gene->add_SeqFeature(Bio::SeqFeature::Generic->new
287 ( -seq_id=> $seqid,
288 -start => $start,
289 -end => $intron_start-1,
290 -strand=> $strand,
291 -primary_tag => $exontag,
292 -source_tag => $srctag,
293 -tag => {
294 'Parent' => "tRNA:$type",
295 }));
296 $gene->add_SeqFeature(Bio::SeqFeature::Generic->new
297 ( -seq_id=> $seqid,
298 -start => $intron_end+1,
299 -end => $end,
300 -strand=> $strand,
301 -primary_tag => $exontag,
302 -source_tag => $srctag,
303 -tag => {
304 'Parent' => "tRNA:$type"
305 }));
306 } else {
307 $gene->add_SeqFeature(Bio::SeqFeature::Generic->new
308 ( -seq_id=> $seqid,
309 -start => $start,
310 -end => $end,
311 -strand=> $strand,
312 -primary_tag => $exontag,
313 -source_tag => $srctag,
314 -tag => {
315 'Parent' => "tRNA:$type"
316 }));
318 return $gene;