|
0
|
1 # $Id: chado.pm,v 1.1 2002/12/03 08:13:55 cjm Exp $
|
|
|
2 #
|
|
|
3 # BioPerl module for Bio::SearchIO::chado
|
|
|
4 #
|
|
|
5 # Chris Mungall <cjm@fruitfly.org>
|
|
|
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 =head1 NAME
|
|
|
12
|
|
|
13 Bio::SearchIO::chado - chado sequence input/output stream
|
|
|
14
|
|
|
15 =head1 SYNOPSIS
|
|
|
16
|
|
|
17 It is probably best not to use this object directly, but
|
|
|
18 rather go through the SearchIO handler system. Go:
|
|
|
19
|
|
|
20 $stream = Bio::SearchIO->new(-file => $filename, -format => 'chado');
|
|
|
21
|
|
|
22 while ( my $seq = $stream->next_seq() ) {
|
|
|
23 # do something with $seq
|
|
|
24 }
|
|
|
25
|
|
|
26 =head1 DESCRIPTION
|
|
|
27
|
|
|
28 This object can transform Bio::Seq objects to and from chado flat
|
|
|
29 file databases. CURRENTLY ONLY TO
|
|
|
30
|
|
|
31
|
|
|
32 =head2 Optional functions
|
|
|
33
|
|
|
34 =over 3
|
|
|
35
|
|
|
36 =item _show_dna()
|
|
|
37
|
|
|
38 (output only) shows the dna or not
|
|
|
39
|
|
|
40 =item _post_sort()
|
|
|
41
|
|
|
42 (output only) provides a sorting func which is applied to the FTHelpers
|
|
|
43 before printing
|
|
|
44
|
|
|
45
|
|
|
46 =back
|
|
|
47
|
|
|
48 =head1 FEEDBACK
|
|
|
49
|
|
|
50 =head2 Mailing Lists
|
|
|
51
|
|
|
52 User feedback is an integral part of the evolution of this
|
|
|
53 and other Bioperl modules. Send your comments and suggestions preferably
|
|
|
54 to one of the Bioperl mailing lists.
|
|
|
55 Your participation is much appreciated.
|
|
|
56
|
|
|
57 bioperl-l@bioperl.org - General discussion
|
|
|
58 http://www.bioperl.org/MailList.shtml - About the mailing lists
|
|
|
59
|
|
|
60 =head2 Reporting Bugs
|
|
|
61
|
|
|
62 Report bugs to the Bioperl bug tracking system to help us keep track
|
|
|
63 the bugs and their resolution.
|
|
|
64 Bug reports can be submitted via email or the web:
|
|
|
65
|
|
|
66 bioperl-bugs@bio.perl.org
|
|
|
67 http://bio.perl.org/bioperl-bugs/
|
|
|
68
|
|
|
69 =head1 AUTHOR - Chris Mungall
|
|
|
70
|
|
|
71 Email cjm@fruitfly.org
|
|
|
72
|
|
|
73 =head1 APPENDIX
|
|
|
74
|
|
|
75 The rest of the documentation details each of the object methods. Internal methods are usually preceded with a _
|
|
|
76
|
|
|
77 =cut
|
|
|
78
|
|
|
79 # Let the code begin...
|
|
|
80
|
|
|
81 package Bio::SearchIO::chado;
|
|
|
82 use vars qw(@ISA);
|
|
|
83 use strict;
|
|
|
84
|
|
|
85 use Bio::SearchIO;
|
|
|
86 use Bio::SeqFeature::Generic;
|
|
|
87 use Bio::Seq::SeqFactory;
|
|
|
88 use Bio::Annotation::Collection;
|
|
|
89 use Bio::Annotation::Comment;
|
|
|
90 use Bio::Annotation::Reference;
|
|
|
91 use Bio::Annotation::DBLink;
|
|
|
92
|
|
|
93
|
|
|
94 use Bio::SeqIO::chado;
|
|
|
95
|
|
|
96 use Data::Stag qw(:all);
|
|
|
97
|
|
|
98 # should really inherit off of a chado helper...
|
|
|
99 @ISA = qw(Bio::SearchIO Bio::SeqIO::chado);
|
|
|
100
|
|
|
101 sub _initialize {
|
|
|
102 my($self,@args) = @_;
|
|
|
103
|
|
|
104 $self->SUPER::_initialize(@args);
|
|
|
105 my $wclass = $self->default_handler_class;
|
|
|
106 $self->handler($wclass->new);
|
|
|
107 $self->{_end_of_data} = 0;
|
|
|
108 $self->handler->S("chado");
|
|
|
109 return;
|
|
|
110 }
|
|
|
111
|
|
|
112 sub DESTROY {
|
|
|
113 my $self = shift;
|
|
|
114 $self->end_of_data();
|
|
|
115 $self->SUPER::DESTROY();
|
|
|
116 }
|
|
|
117
|
|
|
118 sub end_of_data {
|
|
|
119 my $self = shift;
|
|
|
120 $self->{_end_of_data} = 1;
|
|
|
121 $self->handler->E("chado");
|
|
|
122 }
|
|
|
123
|
|
|
124 sub default_handler_class {
|
|
|
125 return "Data::Stag::BaseHandler";
|
|
|
126 }
|
|
|
127
|
|
|
128 =head2 write_result
|
|
|
129
|
|
|
130 Title : write_result
|
|
|
131 Usage : $stream->write_result($result)
|
|
|
132 Function: writes the $result object (must be result) to the stream
|
|
|
133 Returns : 1 for success and 0 for error
|
|
|
134 Args : Bio::Result
|
|
|
135
|
|
|
136
|
|
|
137 =cut
|
|
|
138
|
|
|
139 sub write_result {
|
|
|
140 my ($self,$result) = @_;
|
|
|
141
|
|
|
142 if( !defined $result ) {
|
|
|
143 $self->throw("Attempting to write with no result!");
|
|
|
144 }
|
|
|
145
|
|
|
146 my $w = $self->handler;
|
|
|
147 $w->S("result");
|
|
|
148 # my $result_temp_uid = $self->get_temp_uid($result);
|
|
|
149
|
|
|
150 my @stats =
|
|
|
151 (map {
|
|
|
152 [analysisprop=>[
|
|
|
153 [pkey=>$_],
|
|
|
154 [pval=>$result->get_statistic($_)]]]
|
|
|
155 } $result->available_statistics);
|
|
|
156 my @params =
|
|
|
157 (map {
|
|
|
158 [analysisprop=>[
|
|
|
159 [pkey=>$_],
|
|
|
160 [pval=>$result->get_parameter($_)]]]
|
|
|
161 } $result->available_parameters);
|
|
|
162
|
|
|
163 my $cid = $self->get_temp_uid($result);
|
|
|
164 $w->ev(companalysis=>[
|
|
|
165 [companalysis_id=>$cid],
|
|
|
166 [datasource=>$result->database_name],
|
|
|
167 @stats,
|
|
|
168 @params,
|
|
|
169 ]
|
|
|
170 );
|
|
|
171 while( my $hit = $result->next_hit ) {
|
|
|
172 # process the Bio::Search::Hit::HitI object
|
|
|
173 $self->write_hit($hit, $cid);
|
|
|
174 }
|
|
|
175 $w->E("result");
|
|
|
176 return 1;
|
|
|
177 }
|
|
|
178
|
|
|
179 sub write_hit {
|
|
|
180 my $self = shift;
|
|
|
181 my $hit = shift;
|
|
|
182 my $cid = shift;
|
|
|
183
|
|
|
184 my $w = $self->handler;
|
|
|
185 my $hit_id = $self->get_temp_uid($hit);
|
|
|
186
|
|
|
187 # we should determine the type by the type of blast;
|
|
|
188 # eg blastx gives CDS for hit and CDS_exon for HSP
|
|
|
189 my $fnode =
|
|
|
190 [feature=> [
|
|
|
191 [feature_id=>$hit_id],
|
|
|
192 [name=>$hit->name],
|
|
|
193 [typename=>"hit"],
|
|
|
194 [analysisfeature=>[
|
|
|
195 [rawscore=>$hit->raw_score],
|
|
|
196 [significance=>$hit->significance],
|
|
|
197 [analysis_id=>$cid]]]]];
|
|
|
198 $w->ev(@$fnode);
|
|
|
199 foreach my $hsp ( $hit->hsps) {
|
|
|
200 $self->write_hsp($hsp, $hit_id);
|
|
|
201 }
|
|
|
202 return 1;
|
|
|
203 }
|
|
|
204
|
|
|
205 sub write_hsp {
|
|
|
206 my $self = shift;
|
|
|
207 my $hsp = shift;
|
|
|
208 my $hid = shift;
|
|
|
209
|
|
|
210 my $w = $self->handler;
|
|
|
211 my $hsp_id = $self->get_temp_uid($hsp);
|
|
|
212 my $order = 0;
|
|
|
213 my @lnodes =
|
|
|
214 map {
|
|
|
215 my ($nbeg, $nend, $strand) =
|
|
|
216 $self->bp2ib([$hsp->start($_),
|
|
|
217 $hsp->end($_),
|
|
|
218 $hsp->strand($_)
|
|
|
219 ]);
|
|
|
220 my $src = $_ eq 'query' ? $hsp->query->seq_id : $hsp->hit->seq_id;
|
|
|
221 [featureloc=>[
|
|
|
222 [nbeg=>$nbeg],
|
|
|
223 [nend=>$nend],
|
|
|
224 [strand=>$strand],
|
|
|
225 [srcfeature=>$src],
|
|
|
226 [group=>0],
|
|
|
227 [order=>$order++],
|
|
|
228 ]
|
|
|
229 ]
|
|
|
230 } qw(query subject);
|
|
|
231 my $fnode =
|
|
|
232 [feature => [
|
|
|
233
|
|
|
234 [feature_id=>$hsp_id],
|
|
|
235 [typename=>"hsp"],
|
|
|
236 [analysisfeature=>[
|
|
|
237 [rawscore=>$hsp->score],
|
|
|
238 [significance=>$hsp->significance],
|
|
|
239 ]
|
|
|
240 ],
|
|
|
241 @lnodes,
|
|
|
242 ]
|
|
|
243 ];
|
|
|
244 $w->ev(@$fnode);
|
|
|
245 $w->ev(feature_relationship=>[
|
|
|
246 [subjfeature_id=>$hsp_id],
|
|
|
247 [objfeature_id=>$hid]
|
|
|
248 ]
|
|
|
249 );
|
|
|
250 return 1;
|
|
|
251 }
|
|
|
252
|
|
|
253
|
|
|
254 1;
|
