0
|
1 # $Id: Tmhmm.pm,v 1.6 2002/10/22 07:45:22 lapp Exp $
|
|
2 #
|
|
3 # BioPerl module for Bio::Tools::Tmhmm
|
|
4 #
|
|
5 # Copyright Balamurugan Kumarasamy
|
|
6 #
|
|
7 # You may distribute this module under the same terms as perl itself
|
|
8 #
|
|
9 # POD documentation - main docs before the code
|
|
10 #
|
|
11 # Copyright
|
|
12 #
|
|
13 # You may distribute this module under the same terms as perl itself
|
|
14
|
|
15 =head1 NAME
|
|
16
|
|
17 Bio::Tools::Tmhmm - parse TmHMM output (transmembrane HMM)
|
|
18
|
|
19 =head1 SYNOPSIS
|
|
20
|
|
21 use Bio::Tools::Tmhmm;
|
|
22 my $parser = new Bio::Tools::Tmhmm(-fh =>$filehandle );
|
|
23 while( my $tmhmm_feat = $parser->next_result ) {
|
|
24 #do something
|
|
25 #eg
|
|
26 push @tmhmm_feat, $tmhmm_feat;
|
|
27 }
|
|
28
|
|
29 =head1 DESCRIPTION
|
|
30
|
|
31 Parser for Tmhmm output
|
|
32
|
|
33 =head1 FEEDBACK
|
|
34
|
|
35 =head2 Mailing Lists
|
|
36
|
|
37 user feedback is an integral part of the evolution of this and other
|
|
38 Bioperl modules. Send your comments and suggestions preferably to
|
|
39 the Bioperl mailing list. Your participation is much appreciated.
|
|
40
|
|
41 bioperl-l@bioperl.org - General discussion
|
|
42 http://bioperl.org/MailList.shtml - About the mailing lists
|
|
43
|
|
44 =head2 Reporting Bugs
|
|
45
|
|
46 Report bugs to the Bioperl bug tracking system to help us keep track
|
|
47 of the bugs and their resolution. Bug reports can be submitted via
|
|
48 email or the web:
|
|
49
|
|
50 bioperl-bugs@bioperl.org
|
|
51 http://bugzilla.bioperl.org/
|
|
52
|
|
53 =head1 AUTHOR - Bala
|
|
54
|
|
55 Email savikalpa@fugu-sg.org
|
|
56
|
|
57
|
|
58 =head1 APPENDIX
|
|
59
|
|
60 The rest of the documentation details each of the object methods.
|
|
61 Internal methods are usually preceded with a _
|
|
62
|
|
63 =cut
|
|
64
|
|
65 package Bio::Tools::Tmhmm;
|
|
66 use vars qw(@ISA);
|
|
67 use strict;
|
|
68
|
|
69 use Bio::Tools::AnalysisResult;
|
|
70 use Bio::Root::Root;
|
|
71 use Bio::SeqFeature::FeaturePair;
|
|
72 use Bio::Root::IO;
|
|
73 use Bio::SeqFeature::Generic;
|
|
74 @ISA = qw(Bio::Root::Root Bio::Root::IO Bio::Tools::AnalysisResult);
|
|
75
|
|
76
|
|
77
|
|
78 =head2 new
|
|
79
|
|
80 Title : new
|
|
81 Usage : my $obj = new Bio::Tools::Tmhmm();
|
|
82 Function: Builds a new Bio::Tools::Tmhmm object
|
|
83 Returns : Bio::Tools::Tmhmm
|
|
84 Args : -fh/-file => $val, # for initing input, see Bio::Root::IO
|
|
85
|
|
86
|
|
87 =cut
|
|
88
|
|
89 sub new {
|
|
90 my($class,@args) = @_;
|
|
91
|
|
92 my $self = $class->SUPER::new(@args);
|
|
93 $self->_initialize_io(@args);
|
|
94
|
|
95 return $self;
|
|
96 }
|
|
97
|
|
98
|
|
99 =head2 next_result
|
|
100
|
|
101 Title : next_result
|
|
102 Usage : my $feat = $Tmhmm->next_result
|
|
103 Function: Get the next result set from parser data
|
|
104 Returns : Bio::SeqFeature::Generic
|
|
105 Args : none
|
|
106
|
|
107
|
|
108 =cut
|
|
109
|
|
110 sub next_result {
|
|
111 my ($self) = @_;
|
|
112
|
|
113 my $line;
|
|
114
|
|
115 # parse
|
|
116 my $id;
|
|
117 while ($_=$self->_readline()) {
|
|
118 $line = $_;
|
|
119 chomp $line;
|
|
120
|
|
121
|
|
122 next if /^$/;
|
|
123 if ($line=~/^#\s+(\S+)/) {
|
|
124 #if the line starts with a '#' for example in # 13 Length: 522
|
|
125 #assign 13 as the id.
|
|
126
|
|
127 $id = $1;
|
|
128 my ($junk, $values) = split /:/;
|
|
129 $self->_seqname($id);
|
|
130 next;
|
|
131 }
|
|
132
|
|
133 elsif ($line=~/^(\S+)\s+(\S+)\s+(\w+)\s+(\d+)\s+(\d+)/) {
|
|
134
|
|
135 # Example :- 13 TMHMM2.0 inside 1 120
|
|
136 # assign $orien(inside) $start(1) and $end(120)
|
|
137
|
|
138
|
|
139 my $orien = $3;
|
|
140 my $start = $4;
|
|
141 my $end = $5;
|
|
142 $orien = uc ($orien);
|
|
143
|
|
144 if ($orien eq "TMHELIX") {
|
|
145 my (%feature);
|
|
146 $feature{name} = $self->_seqname;
|
|
147 $feature{start} = $start;
|
|
148 $feature{end} = $end;
|
|
149 $feature{source} ='tmhmm';
|
|
150 $feature{primary}= 'transmembrane';
|
|
151 $feature{program} ='tmhmm';
|
|
152 $feature{logic_name} = 'TMHelix';
|
|
153 my $new_feat= $self->create_feature(\%feature);
|
|
154 return $new_feat;
|
|
155 }
|
|
156 next;
|
|
157 }
|
|
158 next;
|
|
159 }
|
|
160 }
|
|
161
|
|
162 =head2 create_feature
|
|
163
|
|
164 Title : create_feature
|
|
165 Usage : obj->create_feature(\%feature)
|
|
166 Function: Internal(not to be used directly)
|
|
167 Returns : A Bio::SeqFeature::Generic object
|
|
168 Args :
|
|
169
|
|
170 =cut
|
|
171
|
|
172 sub create_feature {
|
|
173 my ($self, $feat) = @_;
|
|
174
|
|
175
|
|
176 # create feature object
|
|
177 my $feature = Bio::SeqFeature::Generic->new(-seq_id => $feat->{name},
|
|
178 -start => $feat->{start},
|
|
179 -end => $feat->{end},
|
|
180 -score => $feat->{score},
|
|
181 -source => $feat->{source},
|
|
182 -primary => $feat->{primary},
|
|
183 -logic_name => $feat->{logic_name},
|
|
184 );
|
|
185 return $feature;
|
|
186 }
|
|
187
|
|
188 =head2 _seqname
|
|
189
|
|
190 Title : _seqname
|
|
191 Usage : obj->_seqname($seqname)
|
|
192 Function: Internal(not to be used directly)
|
|
193 Returns :
|
|
194 Args : seqname
|
|
195
|
|
196 =cut
|
|
197
|
|
198 sub _seqname{
|
|
199 my ($self,$seqname)=@_;
|
|
200
|
|
201 if (defined $seqname){
|
|
202
|
|
203 $self->{'seqname'}=$seqname;
|
|
204 }
|
|
205
|
|
206 return $self->{'seqname'};
|
|
207
|
|
208 }
|
|
209
|
|
210
|
|
211 1;
|
|
212
|
|
213
|