|
0
|
1 # $Id: featureHandler.pm,v 1.9 2002/06/04 02:54:48 jason Exp $
|
|
|
2 #
|
|
|
3 # BioPerl module for Bio::SeqIO::game::featureHandler
|
|
|
4 #
|
|
|
5 # Cared for by Brad Marshall <bradmars@yahoo.com>
|
|
|
6 #
|
|
|
7 # Copyright Brad Marshall
|
|
|
8 #
|
|
|
9 # You may distribute this module under the same terms as perl itself
|
|
|
10 # _history
|
|
|
11 # June 25, 2000 written by Brad Marshall
|
|
|
12 #
|
|
|
13 # POD documentation - main docs before the code
|
|
|
14
|
|
|
15 =head1 NAME
|
|
|
16
|
|
|
17 Bio::SeqIO::game::featureHandler - GAME helper via PerlSAX helper.
|
|
|
18
|
|
|
19 =head1 SYNOPSIS
|
|
|
20
|
|
|
21 GAME helper for parsing new Feature objects from GAME XML. Do not use directly.
|
|
|
22
|
|
|
23 =head1 FEEDBACK
|
|
|
24
|
|
|
25 =head2 Mailing Lists
|
|
|
26
|
|
|
27 User feedback is an integral part of the evolution of this and
|
|
|
28 other Bioperl modules. Send your comments and suggestions preferably
|
|
|
29 to one of the Bioperl mailing lists. Your participation is much appreciated.
|
|
|
30
|
|
|
31 bioperl-l@bioperl.org - Bioperl list
|
|
|
32 bioxml-dev@bioxml.org - Technical discussion - Moderate volume
|
|
|
33 bioxml-announce@bioxml.org - General Announcements - Pretty dead
|
|
|
34 http://www.bioxml.org/MailingLists/ - About the mailing lists
|
|
|
35
|
|
|
36 =head1 AUTHOR - Brad Marshall
|
|
|
37
|
|
|
38 Email: bradmars@yahoo.com
|
|
|
39
|
|
|
40 =head1 APPENDIX
|
|
|
41
|
|
|
42 The rest of the documentation details each of the object
|
|
|
43 methods. Internal methods are usually preceded with a _
|
|
|
44
|
|
|
45 =cut
|
|
|
46
|
|
|
47 # This template file is in the Public Domain.
|
|
|
48 # You may do anything you want with this file.
|
|
|
49 #
|
|
|
50
|
|
|
51 package Bio::SeqIO::game::featureHandler;
|
|
|
52
|
|
|
53 use Bio::SeqFeature::Generic;
|
|
|
54 use XML::Handler::Subs;
|
|
|
55
|
|
|
56 use vars qw{ $AUTOLOAD @ISA };
|
|
|
57 use strict;
|
|
|
58
|
|
|
59 @ISA = qw(XML::Handler::Subs);
|
|
|
60
|
|
|
61 sub new {
|
|
|
62 my ($caller,$seq,$length,$type) = @_;
|
|
|
63 my $class = ref($caller) || $caller;
|
|
|
64 my $self = bless ({
|
|
|
65 seq => $seq,
|
|
|
66 type => $type,
|
|
|
67 length => $length,
|
|
|
68 string => '',
|
|
|
69 feat => {},
|
|
|
70 feats => [],
|
|
|
71 comp_id => 1,
|
|
|
72 }, $class);
|
|
|
73 return $self;
|
|
|
74 }
|
|
|
75
|
|
|
76 =head2 start_document
|
|
|
77
|
|
|
78 Title : start_document
|
|
|
79 Usage : $obj->start_document
|
|
|
80 Function: PerlSAX method called when a new document is initialized
|
|
|
81 Returns : nothing
|
|
|
82 Args : document name
|
|
|
83
|
|
|
84 =cut
|
|
|
85
|
|
|
86 # Basic PerlSAX
|
|
|
87 sub start_document {
|
|
|
88 my ($self, $document) = @_;
|
|
|
89
|
|
|
90 $self->{'Names'} = [];
|
|
|
91 $self->{'Nodes'} = [];
|
|
|
92 $self->{'feats'} = [];
|
|
|
93
|
|
|
94 }
|
|
|
95
|
|
|
96 =head2 end_document
|
|
|
97
|
|
|
98 Title : end_document
|
|
|
99 Usage : $obj->end_document
|
|
|
100 Function: PerlSAX method called when a document is finished for cleaning up
|
|
|
101 Returns : list of features seen
|
|
|
102 Args : document name
|
|
|
103
|
|
|
104 =cut
|
|
|
105
|
|
|
106 sub end_document {
|
|
|
107 my ($self, $document) = @_;
|
|
|
108
|
|
|
109 delete $self->{'Names'};
|
|
|
110 return $self->{'feats'};
|
|
|
111 }
|
|
|
112
|
|
|
113 =head2 start_element
|
|
|
114
|
|
|
115 Title : start_element
|
|
|
116 Usage : $obj->start_element
|
|
|
117 Function: PerlSAX method called when a new element is reached
|
|
|
118 Returns : nothing
|
|
|
119 Args : element object
|
|
|
120
|
|
|
121 =cut
|
|
|
122
|
|
|
123 sub start_element {
|
|
|
124 my ($self, $element) = @_;
|
|
|
125
|
|
|
126 push @{$self->{'Names'}}, $element->{'Name'};
|
|
|
127 $self->{'string'} = '';
|
|
|
128
|
|
|
129 if ($self->in_element('bx-feature:seq_relationship')) {
|
|
|
130 if (defined $element->{'Attributes'}->{'bx-feature:seq'} &&
|
|
|
131 defined $self->{'seq'} &&
|
|
|
132 $element->{'Attributes'}->{'bx-feature:seq'} eq $self->{'seq'}) {
|
|
|
133 $self->{'in_current_seq'} = 'true';
|
|
|
134 }
|
|
|
135 }
|
|
|
136
|
|
|
137
|
|
|
138 if ($self->in_element('bx-computation:computation')) {
|
|
|
139 $self->{'feat'} = {};
|
|
|
140 if (defined $element->{'Attributes'}->{'bx-computation:id'}) {
|
|
|
141 $self->{'feat'}->{'computation_id'} = $element->{'Attributes'}->{'bx-computation:id'};
|
|
|
142 } else {
|
|
|
143 $self->{'feat'}->{'computation_id'} = $self->{'comp_id'};
|
|
|
144 $self->{'comp_id'}++;
|
|
|
145 }
|
|
|
146 }
|
|
|
147
|
|
|
148 if ($self->in_element('bx-feature:feature')) {
|
|
|
149 if (defined $element->{'Attributes'}->{'bx-feature:id'}) {
|
|
|
150 $self->{'feat'}->{'id'} = $element->{'Attributes'}->{'bx-feature:id'};
|
|
|
151 }
|
|
|
152 }
|
|
|
153
|
|
|
154 if ($self->in_element('bx-annotation:annotation')) {
|
|
|
155 $self->{'feat'} = {};
|
|
|
156 $self->{'feat'}->{'annotation_id'} = $element->{'Attributes'}->{'bx-annotation:id'};
|
|
|
157 $self->{'feat'}->{'annotation_name'} = $element->{'Attributes'}->{'bx-annotation:name'};
|
|
|
158 }
|
|
|
159
|
|
|
160 return 0;
|
|
|
161 }
|
|
|
162
|
|
|
163 =head2 end_element
|
|
|
164
|
|
|
165 Title : end_element
|
|
|
166 Usage : $obj->end_element
|
|
|
167 Function: PerlSAX method called when an element is finished
|
|
|
168 Returns : nothing
|
|
|
169 Args : element object
|
|
|
170
|
|
|
171 =cut
|
|
|
172
|
|
|
173 sub end_element {
|
|
|
174 my ($self, $element) = @_;
|
|
|
175
|
|
|
176 if ($self->in_element('bx-computation:program')) {
|
|
|
177 $self->{'string'} =~ s/^\s+//g;
|
|
|
178 $self->{'string'} =~ s/\s+$//;
|
|
|
179 $self->{'string'} =~ s/\n//g;
|
|
|
180 $self->{'feat'}->{'source_tag'} = $self->{'string'};
|
|
|
181 }
|
|
|
182
|
|
|
183 if ($self->in_element('bx-annotation:author')) {
|
|
|
184 $self->{'string'} =~ s/^\s+//g;
|
|
|
185 $self->{'string'} =~ s/\s+$//;
|
|
|
186 $self->{'string'} =~ s/\n//g;
|
|
|
187 $self->{'feat'}->{'source_tag'} = "Annotated by $self->{'string'}.";
|
|
|
188 }
|
|
|
189
|
|
|
190 if ($self->in_element('bx-feature:type')) {
|
|
|
191 $self->{'string'} =~ s/^\s+//g;
|
|
|
192 $self->{'string'} =~ s/\s+$//;
|
|
|
193 $self->{'string'} =~ s/\n//g;
|
|
|
194 $self->{'feat'}->{'primary_tag'} = $self->{'string'};
|
|
|
195 }
|
|
|
196
|
|
|
197 if ($self->in_element('bx-feature:start')) {
|
|
|
198 $self->{'string'} =~ s/^\s+//g;
|
|
|
199 $self->{'string'} =~ s/\s+$//;
|
|
|
200 $self->{'string'} =~ s/\n//g;
|
|
|
201 $self->{'feat'}->{'start'} = $self->{'string'};
|
|
|
202 }
|
|
|
203
|
|
|
204 if ($self->in_element('bx-feature:end')) {
|
|
|
205 $self->{'string'} =~ s/^\s+//g;
|
|
|
206 $self->{'string'} =~ s/\s+$//;
|
|
|
207 $self->{'string'} =~ s/\n//g;
|
|
|
208 $self->{'feat'}->{'end'} = $self->{'string'};
|
|
|
209 }
|
|
|
210
|
|
|
211 if ($self->in_element('bx-computation:score')) {
|
|
|
212 $self->{'string'} =~ s/^\s+//g;
|
|
|
213 $self->{'string'} =~ s/\s+$//;
|
|
|
214 $self->{'string'} =~ s/\n//g;
|
|
|
215 $self->{'feat'}->{'score'} = $self->{'string'};
|
|
|
216 }
|
|
|
217
|
|
|
218 if ($self->in_element('bx-feature:seq_relationship')) {
|
|
|
219
|
|
|
220 if ($self->{'feat'}->{'start'} > $self->{'feat'}->{'end'}) {
|
|
|
221 my $new_start = $self->{'feat'}->{'end'};
|
|
|
222 $self->{'feat'}->{'end'} = $self->{'feat'}->{'start'};
|
|
|
223 $self->{'feat'}->{'start'} = $new_start;
|
|
|
224 $self->{'feat'}->{'strand'} = -1;
|
|
|
225 } else {
|
|
|
226 $self->{'feat'}->{'strand'} = 1;
|
|
|
227 }
|
|
|
228 my $new_feat = new Bio::SeqFeature::Generic
|
|
|
229 (
|
|
|
230 -start => $self->{'feat'}->{'start'},
|
|
|
231 -end => $self->{'feat'}->{'end'},
|
|
|
232 -strand => $self->{'feat'}->{'strand'},
|
|
|
233 -source => $self->{'feat'}->{'source_tag'},
|
|
|
234 -primary => $self->{'feat'}->{'primary_tag'},
|
|
|
235 -score => $self->{'feat'}->{'score'},
|
|
|
236 );
|
|
|
237
|
|
|
238 if (defined $self->{'feat'}->{'computation_id'}) {
|
|
|
239 $new_feat->add_tag_value('computation_id',
|
|
|
240 $self->{'feat'}->{'computation_id'} );
|
|
|
241 } elsif (defined $self->{'feat'}->{'annotation_id'}) {
|
|
|
242 $new_feat->add_tag_value('annotation_id',
|
|
|
243 $self->{'feat'}->{'annotation_id'} );
|
|
|
244 }
|
|
|
245 if (defined $self->{'feat'}->{'id'}) {
|
|
|
246 $new_feat->add_tag_value('id', $self->{'feat'}->{'id'} );
|
|
|
247 }
|
|
|
248
|
|
|
249 push @{$self->{'feats'}}, $new_feat;
|
|
|
250 $self->{'feat'} = {
|
|
|
251 seqid => $self->{'feat'}->{'curr_seqid'},
|
|
|
252 primary_tag => $self->{'feat'}->{'primary_tag'},
|
|
|
253 source_tag => $self->{'feat'}->{'source_tag'},
|
|
|
254 computation_id => $self->{'feat'}->{'computation_id'},
|
|
|
255 annotation_id => $self->{'feat'}->{'annotation_id'}
|
|
|
256 }
|
|
|
257 }
|
|
|
258
|
|
|
259
|
|
|
260 pop @{$self->{'Names'}};
|
|
|
261 pop @{$self->{'Nodes'}};
|
|
|
262
|
|
|
263 }
|
|
|
264
|
|
|
265 =head2 characters
|
|
|
266
|
|
|
267 Title : characters
|
|
|
268 Usage : $obj->end_element
|
|
|
269 Function: PerlSAX method called when text between XML tags is reached
|
|
|
270 Returns : nothing
|
|
|
271 Args : text
|
|
|
272
|
|
|
273 =cut
|
|
|
274
|
|
|
275 sub characters {
|
|
|
276 my ($self, $text) = @_;
|
|
|
277 $self->{'string'} .= $text->{'Data'};
|
|
|
278 }
|
|
|
279
|
|
|
280 =head2 in_element
|
|
|
281
|
|
|
282 Title : in_element
|
|
|
283 Usage : $obj->in_element
|
|
|
284 Function: PerlSAX method called to test if state is in a specific element
|
|
|
285 Returns : boolean
|
|
|
286 Args : name of element
|
|
|
287
|
|
|
288 =cut
|
|
|
289
|
|
|
290 sub in_element {
|
|
|
291 my ($self, $name) = @_;
|
|
|
292
|
|
|
293 return (defined $self->{'Names'}[-1] &&
|
|
|
294 $self->{'Names'}[-1] eq $name);
|
|
|
295 }
|
|
|
296
|
|
|
297 =head2 within_element
|
|
|
298
|
|
|
299 Title : within_element
|
|
|
300 Usage : $obj->within_element
|
|
|
301 Function: PerlSAX method called to list depth within specific element
|
|
|
302 Returns : boolean
|
|
|
303 Args : name of element
|
|
|
304
|
|
|
305 =cut
|
|
|
306
|
|
|
307 sub within_element {
|
|
|
308 my ($self, $name) = @_;
|
|
|
309
|
|
|
310 my $count = 0;
|
|
|
311 foreach my $el_name (@{$self->{'Names'}}) {
|
|
|
312 $count ++ if ($el_name eq $name);
|
|
|
313 }
|
|
|
314
|
|
|
315 return $count;
|
|
|
316 }
|
|
|
317
|
|
|
318 =head2 AUTOLOAD
|
|
|
319
|
|
|
320 Title : AUTOLOAD
|
|
|
321 Usage : do not use directly
|
|
|
322 Function: autoload handling of missing DESTROY method
|
|
|
323 Returns : nothing
|
|
|
324 Args : text
|
|
|
325
|
|
|
326 =cut
|
|
|
327
|
|
|
328 # Others
|
|
|
329 sub AUTOLOAD {
|
|
|
330 my $self = shift;
|
|
|
331
|
|
|
332 my $method = $AUTOLOAD;
|
|
|
333 $method =~ s/.*:://;
|
|
|
334 return if $method eq 'DESTROY';
|
|
|
335
|
|
|
336 print "UNRECOGNIZED $method\n";
|
|
|
337 }
|
|
|
338
|
|
|
339 1;
|
|
|
340
|
|
|
341 __END__
|
