|
0
|
1 # $Id: idHandler.pm,v 1.8 2001/11/20 02:09:38 lstein Exp $
|
|
|
2 #
|
|
|
3 # BioPerl module for Bio::SeqIO::game::idHandler
|
|
|
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::idHandler - GAME helper via PerlSAX helper.
|
|
|
18
|
|
|
19 =head1 SYNOPSIS
|
|
|
20
|
|
|
21 GAME helper for parsing new ID 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::idHandler;
|
|
|
52 use Bio::Root::Root;
|
|
|
53
|
|
|
54 use vars qw{ $AUTOLOAD @ISA };
|
|
|
55 use strict;
|
|
|
56 @ISA = qw(Bio::Root::Root);
|
|
|
57 sub new {
|
|
|
58 my ($class,@args) = @_;
|
|
|
59 my $self = $class->SUPER::new(@args);
|
|
|
60
|
|
|
61 # initialize ids
|
|
|
62 $self->{'ids'} = [];
|
|
|
63
|
|
|
64 return $self;
|
|
|
65 }
|
|
|
66
|
|
|
67 =head2 start_document
|
|
|
68
|
|
|
69 Title : start_document
|
|
|
70 Usage : $obj->start_document
|
|
|
71 Function: PerlSAX method called when a new document is initialized
|
|
|
72 Returns : nothing
|
|
|
73 Args : document name
|
|
|
74
|
|
|
75 =cut
|
|
|
76
|
|
|
77 # Basic PerlSAX
|
|
|
78 sub start_document {
|
|
|
79 my ($self, $document) = @_;
|
|
|
80 }
|
|
|
81
|
|
|
82 =head2 end_document
|
|
|
83
|
|
|
84 Title : end_document
|
|
|
85 Usage : $obj->end_document
|
|
|
86 Function: PerlSAX method called when a document is finished for cleaning up
|
|
|
87 Returns : list of ids seen
|
|
|
88 Args : document name
|
|
|
89
|
|
|
90 =cut
|
|
|
91
|
|
|
92 sub end_document {
|
|
|
93 my ($self, $document) = @_;
|
|
|
94 return $self->{'ids'};
|
|
|
95 }
|
|
|
96
|
|
|
97 =head2 start_element
|
|
|
98
|
|
|
99 Title : start_element
|
|
|
100 Usage : $obj->start_element
|
|
|
101 Function: PerlSAX method called when a new element is reached
|
|
|
102 Returns : nothing
|
|
|
103 Args : element object
|
|
|
104
|
|
|
105 =cut
|
|
|
106
|
|
|
107 sub start_element {
|
|
|
108 my ($self, $element) = @_;
|
|
|
109
|
|
|
110 if ($element->{'Name'} eq 'bx-seq:seq') {
|
|
|
111 if ($element->{'Attributes'}->{'bx-seq:id'}) {
|
|
|
112 push @{$self->{'ids'}}, $element->{'Attributes'}->{'bx-seq:id'};
|
|
|
113 } else {
|
|
|
114 if ($self->can('warn')) {
|
|
|
115 $self->warn('WARNING: Attribute bx-seq:id is required on bx-seq:seq. Sequence will not be parsed.');
|
|
|
116 } else {
|
|
|
117 warn('WARNING: Attribute bx-seq:id is required on bx-seq:seq. Sequence will not be parsed.');
|
|
|
118 }
|
|
|
119 }
|
|
|
120 }
|
|
|
121 return 0;
|
|
|
122 }
|
|
|
123
|
|
|
124 =head2 end_element
|
|
|
125
|
|
|
126 Title : end_element
|
|
|
127 Usage : $obj->end_element
|
|
|
128 Function: PerlSAX method called when an element is finished
|
|
|
129 Returns : nothing
|
|
|
130 Args : element object
|
|
|
131
|
|
|
132 =cut
|
|
|
133
|
|
|
134 sub end_element {
|
|
|
135 my ($self, $element) = @_;
|
|
|
136
|
|
|
137 }
|
|
|
138
|
|
|
139 =head2 characters
|
|
|
140
|
|
|
141 Title : characters
|
|
|
142 Usage : $obj->end_element
|
|
|
143 Function: PerlSAX method called when text between XML tags is reached
|
|
|
144 Returns : nothing
|
|
|
145 Args : text
|
|
|
146
|
|
|
147 =cut
|
|
|
148
|
|
|
149 sub characters {
|
|
|
150 my ($self, $text) = @_;
|
|
|
151 }
|
|
|
152
|
|
|
153
|
|
|
154 =head2 AUTOLOAD
|
|
|
155
|
|
|
156 Title : AUTOLOAD
|
|
|
157 Usage : do not use directly
|
|
|
158 Function: autoload handling of missing DESTROY method
|
|
|
159 Returns : nothing
|
|
|
160 Args : text
|
|
|
161
|
|
|
162 =cut
|
|
|
163
|
|
|
164 # Others
|
|
|
165 sub AUTOLOAD {
|
|
|
166 my $self = shift;
|
|
|
167
|
|
|
168 my $method = $AUTOLOAD;
|
|
|
169 $method =~ s/.*:://;
|
|
|
170 return if $method eq 'DESTROY';
|
|
|
171
|
|
|
172 print "UNRECOGNIZED $method\n";
|
|
|
173 }
|
|
|
174
|
|
|
175 1;
|
|
|
176
|
|
|
177 __END__
|
