|
0
|
1 # BioPerl module for Bio::Tools::Profile
|
|
|
2 #
|
|
|
3 # Cared for by Balamurugan Kumarasamy
|
|
|
4 #
|
|
|
5 # You may distribute this module under the same terms as perl itself
|
|
|
6 # POD documentation - main docs before the code
|
|
|
7
|
|
|
8 =head1 NAME
|
|
|
9
|
|
|
10 Bio::Tools::Profile - parse Profile output
|
|
|
11
|
|
|
12 =head1 SYNOPSIS
|
|
|
13
|
|
|
14 use Bio::Tools::Profile;
|
|
|
15 my $profile_parser = new Bio::Tools::Profile(-fh =>$filehandle );
|
|
|
16 while( my $profile_feat = $profile_parser->next_result ) {
|
|
|
17 push @profile_feat, $profile_feat;
|
|
|
18 }
|
|
|
19
|
|
|
20 =head1 DESCRIPTION
|
|
|
21
|
|
|
22 Parser for Profile output
|
|
|
23
|
|
|
24 =head1 FEEDBACK
|
|
|
25
|
|
|
26 =head2 Mailing Lists
|
|
|
27
|
|
|
28 User feedback is an integral part of the evolution of this and other
|
|
|
29 Bioperl modules. Send your comments and suggestions preferably to
|
|
|
30 the Bioperl mailing list. Your participation is much appreciated.
|
|
|
31
|
|
|
32 bioperl-l@bioperl.org - General discussion
|
|
|
33 http://bioperl.org/MailList.shtml - About the mailing lists
|
|
|
34
|
|
|
35 =head2 Reporting Bugs
|
|
|
36
|
|
|
37 Report bugs to the Bioperl bug tracking system to help us keep track
|
|
|
38 of the bugs and their resolution. Bug reports can be submitted via
|
|
|
39 email or the web:
|
|
|
40
|
|
|
41 bioperl-bugs@bioperl.org
|
|
|
42 http://bugzilla.bioperl.org/
|
|
|
43 =head1 AUTHOR - Balamurugan Kumarasamy
|
|
|
44
|
|
|
45 Email: fugui@worf.fugu-sg.org
|
|
|
46
|
|
|
47 =head1 APPENDIX
|
|
|
48
|
|
|
49 The rest of the documentation details each of the object methods.
|
|
|
50 Internal methods are usually preceded with a _
|
|
|
51
|
|
|
52
|
|
|
53 =cut
|
|
|
54
|
|
|
55
|
|
|
56 package Bio::Tools::Profile;
|
|
|
57 use vars qw(@ISA);
|
|
|
58 use strict;
|
|
|
59
|
|
|
60 use Bio::Root::Root;
|
|
|
61 use Bio::SeqFeature::FeaturePair;
|
|
|
62 use Bio::Root::IO;
|
|
|
63 use Bio::SeqFeature::Generic;
|
|
|
64
|
|
|
65 @ISA = qw(Bio::Root::Root Bio::Root::IO );
|
|
|
66
|
|
|
67
|
|
|
68
|
|
|
69 =head2 new
|
|
|
70
|
|
|
71 Title : new
|
|
|
72 Usage : my $obj = new Bio::Tools::Profile();
|
|
|
73 Function: Builds a new Bio::Tools::Profile object
|
|
|
74 Returns : Bio::Tools::Profile
|
|
|
75 Args : -filename
|
|
|
76 -fh ($filehandle)
|
|
|
77
|
|
|
78 =cut
|
|
|
79
|
|
|
80 sub new {
|
|
|
81 my($class,@args) = @_;
|
|
|
82
|
|
|
83 my $self = $class->SUPER::new(@args);
|
|
|
84 $self->_initialize_io(@args);
|
|
|
85
|
|
|
86 return $self;
|
|
|
87 }
|
|
|
88
|
|
|
89 =head2 next_result
|
|
|
90
|
|
|
91 Title : next_result
|
|
|
92 Usage : my $feat = $profile_parser->next_result
|
|
|
93 Function: Get the next result set from parser data
|
|
|
94 Returns : L<Bio::SeqFeature::FeaturePair>
|
|
|
95 Args : none
|
|
|
96
|
|
|
97
|
|
|
98 =cut
|
|
|
99
|
|
|
100 sub next_result {
|
|
|
101 my ($self) = @_;
|
|
|
102
|
|
|
103 my %printsac;
|
|
|
104 my $line;
|
|
|
105 my @features;
|
|
|
106 while ($_=$self->_readline()) {
|
|
|
107 $line = $_;
|
|
|
108 chomp $line;
|
|
|
109 my ($nscore,$rawscore,$from,$to,$hfrom,$hto,$ac) = $line =~ /(\S+)\s+(\d+)\s*pos.\s+(\d*)\s*-\s+(\d*)\s*\[\s+(\d*),\s+(\S*)\]\s*(\w+)/;
|
|
|
110 #for example in this output line
|
|
|
111 #38.435 2559 pos. 19958 - 20212 [ 1, -1] PS50011|PROTEIN_KINASE_DOM Protein kinase domain profile.
|
|
|
112 #$nscore = 38.435
|
|
|
113 #$rawscore = 2559
|
|
|
114 #$from = 19958
|
|
|
115 #$end = 20212
|
|
|
116 #$hfrom = 1
|
|
|
117 #$hto =-1
|
|
|
118 #$ac = PS50011
|
|
|
119 my $feat = "$ac,$from,$to,$hfrom,$hto,$nscore";
|
|
|
120 my $new_feat= $self->create_feature($feat);
|
|
|
121 return $new_feat
|
|
|
122
|
|
|
123 }
|
|
|
124 }
|
|
|
125
|
|
|
126
|
|
|
127 =head2 create_feature
|
|
|
128
|
|
|
129 Title : create_feature
|
|
|
130 Usage : my $feat= $profile_parser->create_feature($feature)
|
|
|
131 Function: creates a Bio::SeqFeature::FeaturePair object
|
|
|
132 Returns : L<Bio::SeqFeature::FeaturePair>
|
|
|
133 Args :
|
|
|
134
|
|
|
135
|
|
|
136 =cut
|
|
|
137
|
|
|
138 sub create_feature {
|
|
|
139 my ($self, $feat) = @_;
|
|
|
140
|
|
|
141 my @f = split (/,/,$feat);
|
|
|
142
|
|
|
143
|
|
|
144 my $hto = $f[4];
|
|
|
145
|
|
|
146 if ($f[4] =~ /-1/) {
|
|
|
147
|
|
|
148 $hto = $f[2] - $f[1] + 1;
|
|
|
149
|
|
|
150 }
|
|
|
151
|
|
|
152
|
|
|
153 my $feat1 = new Bio::SeqFeature::Generic ( -start => $f[1],
|
|
|
154 -end => $f[2],
|
|
|
155 -score => $f[5],
|
|
|
156 -source=>'pfscan',
|
|
|
157 -primary=>$f[0]);
|
|
|
158
|
|
|
159 my $feat2 = new Bio::SeqFeature::Generic (-start => $f[3],
|
|
|
160 -end => $hto,
|
|
|
161 );
|
|
|
162
|
|
|
163 my $feature = new Bio::SeqFeature::FeaturePair(-feature1 => $feat1,
|
|
|
164 -feature2 => $feat2);
|
|
|
165
|
|
|
166 return $feature;
|
|
|
167
|
|
|
168 }
|
|
|
169 1;
|
