Mercurial > repos > mahtabm > ensemb_rep_gvl
comparison variant_effect_predictor/Bio/Tools/Tmhmm.pm @ 0:2bc9b66ada89 draft default tip
Uploaded
author | mahtabm |
---|---|
date | Thu, 11 Apr 2013 06:29:17 -0400 |
parents | |
children |
comparison
equal
deleted
inserted
replaced
-1:000000000000 | 0:2bc9b66ada89 |
---|---|
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 |