|
0
|
1 # $Id: MapIO.pm,v 1.5 2002/10/22 07:45:09 lapp Exp $
|
|
|
2 #
|
|
|
3 # BioPerl module for Bio::MapIO
|
|
|
4 #
|
|
|
5 # Cared for by Jason Stajich <jason@bioperl.org>
|
|
|
6 #
|
|
|
7 # Copyright Jason Stajich
|
|
|
8 #
|
|
|
9 # You may distribute this module under the same terms as perl itself
|
|
|
10
|
|
|
11 # POD documentation - main docs before the code
|
|
|
12
|
|
|
13 =head1 NAME
|
|
|
14
|
|
|
15 Bio::MapIO - A Map Factory object
|
|
|
16
|
|
|
17 =head1 SYNOPSIS
|
|
|
18
|
|
|
19 use Bio::MapIO;
|
|
|
20 my $mapio = new Bio::MapIO(-format => "mapmaker",
|
|
|
21 -file => "mapfile.map");
|
|
|
22
|
|
|
23 while( my $map = $mapio->next_map ) {
|
|
|
24 # get each map
|
|
|
25 foreach my $marker ( $map->each_element ) {
|
|
|
26 # loop through the markers associated with the map
|
|
|
27 }
|
|
|
28 }
|
|
|
29
|
|
|
30 =head1 DESCRIPTION
|
|
|
31
|
|
|
32 This is the Factory object for reading Maps from a data stream or file.
|
|
|
33
|
|
|
34 =head1 FEEDBACK
|
|
|
35
|
|
|
36 =head2 Mailing Lists
|
|
|
37
|
|
|
38 User feedback is an integral part of the evolution of this and other
|
|
|
39 Bioperl modules. Send your comments and suggestions preferably to
|
|
|
40 the Bioperl mailing list. Your participation is much appreciated.
|
|
|
41
|
|
|
42 bioperl-l@bioperl.org - General discussion
|
|
|
43 http://bioperl.org/MailList.shtml - About the mailing lists
|
|
|
44
|
|
|
45 =head2 Reporting Bugs
|
|
|
46
|
|
|
47 Report bugs to the Bioperl bug tracking system to help us keep track
|
|
|
48 of the bugs and their resolution. Bug reports can be submitted via
|
|
|
49 email or the web:
|
|
|
50
|
|
|
51 bioperl-bugs@bioperl.org
|
|
|
52 http://bugzilla.bioperl.org/
|
|
|
53
|
|
|
54 =head1 AUTHOR - Jason Stajich
|
|
|
55
|
|
|
56 Email jason@bioperl.org
|
|
|
57
|
|
|
58 Describe contact details here
|
|
|
59
|
|
|
60 =head1 CONTRIBUTORS
|
|
|
61
|
|
|
62 Additional contributors names and emails here
|
|
|
63
|
|
|
64 =head1 APPENDIX
|
|
|
65
|
|
|
66 The rest of the documentation details each of the object methods.
|
|
|
67 Internal methods are usually preceded with a _
|
|
|
68
|
|
|
69 =cut
|
|
|
70
|
|
|
71
|
|
|
72 # Let the code begin...
|
|
|
73
|
|
|
74
|
|
|
75 package Bio::MapIO;
|
|
|
76 use vars qw(@ISA);
|
|
|
77 use strict;
|
|
|
78
|
|
|
79 use Bio::Root::Root;
|
|
|
80 use Bio::Root::IO;
|
|
|
81 use Bio::Factory::MapFactoryI;
|
|
|
82
|
|
|
83 @ISA = qw(Bio::Root::Root Bio::Root::IO Bio::Factory::MapFactoryI);
|
|
|
84
|
|
|
85 =head2 new
|
|
|
86
|
|
|
87 Title : new
|
|
|
88 Usage : my $obj = new Bio::MapIO();
|
|
|
89 Function: Builds a new Bio::MapIO object
|
|
|
90 Returns : Bio::MapIO
|
|
|
91 Args :
|
|
|
92
|
|
|
93
|
|
|
94 =cut
|
|
|
95
|
|
|
96 sub new {
|
|
|
97 my($caller,@args) = @_;
|
|
|
98
|
|
|
99 my $class = ref($caller) || $caller;
|
|
|
100
|
|
|
101 # or do we want to call SUPER on an object if $caller is an
|
|
|
102 # object?
|
|
|
103 if( $class =~ /Bio::MapIO::(\S+)/ ) {
|
|
|
104 my ($self) = $class->SUPER::new(@args);
|
|
|
105 $self->_initialize(@args);
|
|
|
106 return $self;
|
|
|
107 } else {
|
|
|
108
|
|
|
109 my %param = @args;
|
|
|
110 @param{ map { lc $_ } keys %param } = values %param; # lowercase keys
|
|
|
111 my $format = $param{'-format'} ||
|
|
|
112 $class->_guess_format( $param{'-file'} || $ARGV[0] ) ||
|
|
|
113 'mapmaker';
|
|
|
114 $format = "\L$format"; # normalize capitalization to lower case
|
|
|
115
|
|
|
116 # normalize capitalization
|
|
|
117 return undef unless( $class->_load_format_module($format) );
|
|
|
118 return "Bio::MapIO::$format"->new(@args);
|
|
|
119 }
|
|
|
120
|
|
|
121 }
|
|
|
122
|
|
|
123 =head2 Bio::Factory::MapFactoryI methods
|
|
|
124
|
|
|
125 =cut
|
|
|
126
|
|
|
127 =head2 next_map
|
|
|
128
|
|
|
129 Title : next_tree
|
|
|
130 Usage : my $map = $factory->next_map;
|
|
|
131 Function: Get a map from the factory
|
|
|
132 Returns : L<Bio::Map::MapI>
|
|
|
133 Args : none
|
|
|
134
|
|
|
135
|
|
|
136 =head2 write_map
|
|
|
137
|
|
|
138 Title : write_tree
|
|
|
139 Usage : $factory->write_map($map);
|
|
|
140 Function: Write a map out through the factory
|
|
|
141 Returns : none
|
|
|
142 Args : L<Bio::Map::MapI>
|
|
|
143
|
|
|
144 =cut
|
|
|
145
|
|
|
146
|
|
|
147 =head2 attach_EventHandler
|
|
|
148
|
|
|
149 Title : attach_EventHandler
|
|
|
150 Usage : $parser->attatch_EventHandler($handler)
|
|
|
151 Function: Adds an event handler to listen for events
|
|
|
152 Returns : none
|
|
|
153 Args : L<Bio::Event::EventHandlerI>
|
|
|
154
|
|
|
155 =cut
|
|
|
156
|
|
|
157 sub attach_EventHandler{
|
|
|
158 my ($self,$handler) = @_;
|
|
|
159 return if( ! $handler );
|
|
|
160 if( ! $handler->isa('Bio::Event::EventHandlerI') ) {
|
|
|
161 $self->warn("Ignoring request to attatch handler ".ref($handler). ' because it is not a Bio::Event::EventHandlerI');
|
|
|
162 }
|
|
|
163 $self->{'_handler'} = $handler;
|
|
|
164 return;
|
|
|
165 }
|
|
|
166
|
|
|
167 =head2 _eventHandler
|
|
|
168
|
|
|
169 Title : _eventHandler
|
|
|
170 Usage : private
|
|
|
171 Function: Get the EventHandler
|
|
|
172 Returns : L<Bio::Event::EventHandlerI>
|
|
|
173 Args : none
|
|
|
174
|
|
|
175
|
|
|
176 =cut
|
|
|
177
|
|
|
178 sub _eventHandler{
|
|
|
179 my ($self) = @_;
|
|
|
180 return $self->{'_handler'};
|
|
|
181 }
|
|
|
182
|
|
|
183 sub _initialize {
|
|
|
184 my($self, @args) = @_;
|
|
|
185 $self->{'_handler'} = undef;
|
|
|
186
|
|
|
187 # initialize the IO part
|
|
|
188 $self->_initialize_io(@args);
|
|
|
189 # $self->attach_EventHandler(new Bio::MapIO::MapEventBuilder());
|
|
|
190 }
|
|
|
191
|
|
|
192 =head2 _load_format_module
|
|
|
193
|
|
|
194 Title : _load_format_module
|
|
|
195 Usage : *INTERNAL MapIO stuff*
|
|
|
196 Function: Loads up (like use) a module at run time on demand
|
|
|
197 Example :
|
|
|
198 Returns :
|
|
|
199 Args :
|
|
|
200
|
|
|
201 =cut
|
|
|
202
|
|
|
203 sub _load_format_module {
|
|
|
204 my ($self,$format) = @_;
|
|
|
205 my $module = "Bio::MapIO::" . $format;
|
|
|
206 my $ok;
|
|
|
207 eval {
|
|
|
208 $ok = $self->_load_module($module);
|
|
|
209 };
|
|
|
210 if ( $@ ) {
|
|
|
211 print STDERR <<END;
|
|
|
212 $self: $format cannot be found
|
|
|
213 Exception $@
|
|
|
214 For more information about the MapIO system please see the MapIO docs.
|
|
|
215 This includes ways of checking for formats at compile time, not run time
|
|
|
216 END
|
|
|
217 ;
|
|
|
218 }
|
|
|
219 return $ok;
|
|
|
220 }
|
|
|
221
|
|
|
222
|
|
|
223 =head2 _guess_format
|
|
|
224
|
|
|
225 Title : _guess_format
|
|
|
226 Usage : $obj->_guess_format($filename)
|
|
|
227 Function:
|
|
|
228 Example :
|
|
|
229 Returns : guessed format of filename (lower case)
|
|
|
230 Args :
|
|
|
231
|
|
|
232 =cut
|
|
|
233
|
|
|
234 sub _guess_format {
|
|
|
235 my $class = shift;
|
|
|
236 return unless $_ = shift;
|
|
|
237 return 'mapmaker' if /\.(map)$/i;
|
|
|
238 return 'mapxml' if /\.(xml)$/i;
|
|
|
239 }
|
|
|
240
|
|
|
241 sub DESTROY {
|
|
|
242 my $self = shift;
|
|
|
243
|
|
|
244 $self->close();
|
|
|
245 }
|
|
|
246
|
|
|
247 1;
|
