0
|
1 # $Id: IO.pm,v 1.1 2002/11/04 11:47:49 heikki Exp $
|
|
2 #
|
|
3 # BioPerl module for Bio::Assembly::IO
|
|
4 #
|
|
5 # based on the Bio::SeqIO module
|
|
6 # by Ewan Birney <birney@sanger.ac.uk>
|
|
7 # and Lincoln Stein <lstein@cshl.org>
|
|
8 #
|
|
9 # Copyright Robson Francisco de Souza
|
|
10 #
|
|
11 # You may distribute this module under the same terms as perl itself
|
|
12 #
|
|
13 # _history
|
|
14
|
|
15 # POD documentation - main docs before the code
|
|
16
|
|
17 =head1 NAME
|
|
18
|
|
19 Bio::Assembly::IO - Handler for Assembly::IO Formats
|
|
20
|
|
21 =head1 SYNOPSIS
|
|
22
|
|
23 use Bio::Assembly::IO;
|
|
24
|
|
25 $in = Bio::Assembly::IO->new(-file=>"<inputfilename",
|
|
26 -format=>'phrap');
|
|
27 $out = Bio::Assembly::IO->new(-file=>">outputfilename",
|
|
28 -format=>'phrap');
|
|
29
|
|
30 while ( my $seq = $in->next_seq() ) {
|
|
31 $out->write_seq($seq);
|
|
32 }
|
|
33
|
|
34 =head1 DESCRIPTION
|
|
35
|
|
36 Bio::Assembly::IO is a handler module for formats in the Assembly::IO set
|
|
37 (e.g. Bio::Assembly::IO::phrap).
|
|
38
|
|
39 =head1 FEEDBACK
|
|
40
|
|
41 =head2 Mailing Lists
|
|
42
|
|
43 User feedback is an integral part of the evolution of this and other
|
|
44 Bioperl modules. Send your comments and suggestions preferably to the
|
|
45 Bioperl mailing lists Your participation is much appreciated.
|
|
46
|
|
47 bioperl-l@bioperl.org - General discussion
|
|
48 http://bio.perl.org/MailList.html - About the mailing lists
|
|
49
|
|
50 =head2 Reporting Bugs
|
|
51
|
|
52 Report bugs to the Bioperl bug tracking system to help us keep track
|
|
53 the bugs and their resolution. Bug reports can be submitted via email
|
|
54 or the web:
|
|
55
|
|
56 bioperl-bugs@bio.perl.org
|
|
57 http://bugzilla.bioperl.org/
|
|
58
|
|
59 =head1 AUTHOR
|
|
60
|
|
61 Robson Francisco de Souza
|
|
62
|
|
63 E-mail: rfsouza@citri.iq.usp.br
|
|
64
|
|
65 =head1 CONTRIBUTORS
|
|
66
|
|
67 #
|
|
68
|
|
69 =head1 APPENDIX
|
|
70
|
|
71 The rest of the documentation details each of the object
|
|
72 methods. Internal methods are usually preceded with a _
|
|
73
|
|
74 =cut
|
|
75
|
|
76 package Bio::Assembly::IO;
|
|
77
|
|
78 use Bio::Root::Root;
|
|
79 use Bio::Root::IO;
|
|
80
|
|
81 use strict;
|
|
82 use vars qw(@ISA);
|
|
83
|
|
84 @ISA = qw(Bio::Root::Root Bio::Root::IO);
|
|
85
|
|
86 =head2 new
|
|
87
|
|
88 Title : new
|
|
89 Usage : Bio::Assembly::IO->new(-file =>$filename,-format=>'format')
|
|
90 Function: Returns a new assembly stream
|
|
91 Returns : A Bio::Assembly::IO::Handler initialised
|
|
92 with the appropriate format
|
|
93 Args : -file => $filename
|
|
94 -format => format
|
|
95
|
|
96 =cut
|
|
97
|
|
98 sub new {
|
|
99 my ($caller,@args) = @_;
|
|
100 my $class = ref($caller) || $caller;
|
|
101
|
|
102 # or do we want to call SUPER on an object if $caller is an
|
|
103 # object?
|
|
104 if( $class =~ /Bio::Assembly::IO::(\S+)/ ) {
|
|
105 my ($self) = $class->SUPER::new(@args);
|
|
106 $self->_initialize(@args);
|
|
107 return $self;
|
|
108 } else {
|
|
109
|
|
110 my %param = @args;
|
|
111 @param{ map { lc $_ } keys %param } = values %param; # lowercase keys
|
|
112
|
|
113 $class->throw("Need at least a file name to proceed!")
|
|
114 unless (defined $param{'-file'} || defined $ARGV[0]);
|
|
115
|
|
116 my $format = $param{'-format'} ||
|
|
117 $class->_guess_format( $param{-file} || $ARGV[0] );
|
|
118 $format = "\L$format"; # normalize capitalization to lower case
|
|
119
|
|
120 # normalize capitalization
|
|
121 return undef unless( $class->_load_format_module($format) );
|
|
122 return "Bio::Assembly::IO::$format"->new(@args);
|
|
123 }
|
|
124 }
|
|
125
|
|
126 # _initialize is chained for all SeqIO classes
|
|
127
|
|
128 sub _initialize {
|
|
129 my($self, @args) = @_;
|
|
130 # initialize the IO part
|
|
131 $self->_initialize_io(@args);
|
|
132 }
|
|
133
|
|
134 =head2 next_assembly
|
|
135
|
|
136 Title : next_assembly
|
|
137 Usage : $cluster = $stream->next_assembly()
|
|
138 Function: Reads the next assembly object from the stream and returns it.
|
|
139 Returns : a Bio::Assembly::ScaffoldI compliant object
|
|
140 Args : none
|
|
141
|
|
142 =cut
|
|
143
|
|
144 sub next_assembly {
|
|
145 my ($self, $seq) = @_;
|
|
146 $self->throw("Sorry, you cannot read from a generic Bio::Assembly::IO object.");
|
|
147 }
|
|
148
|
|
149
|
|
150 =head2 _load_format_module
|
|
151
|
|
152 Title : _load_format_module
|
|
153 Usage : *INTERNAL Assembly::IO stuff*
|
|
154 Function: Loads up (like use) a module at run time on demand
|
|
155 Example :
|
|
156 Returns :
|
|
157 Args :
|
|
158
|
|
159 =cut
|
|
160
|
|
161 sub _load_format_module {
|
|
162 my ($self,$format) = @_;
|
|
163 my $module = "Bio::Assembly::IO::" . $format;
|
|
164 my $ok;
|
|
165
|
|
166 eval {
|
|
167 $ok = $self->_load_module($module);
|
|
168 };
|
|
169 if ( $@ ) {
|
|
170 print STDERR <<END;
|
|
171 $self: could not load $format - for more details on supported formats please see the Assembly::IO docs
|
|
172 Exception $@
|
|
173 END
|
|
174 ;
|
|
175 }
|
|
176 return $ok;
|
|
177 }
|
|
178
|
|
179 =head2 _guess_format
|
|
180
|
|
181 Title : _guess_format
|
|
182 Usage : $obj->_guess_format($filename)
|
|
183 Function: guess format based on file suffix
|
|
184 Example :
|
|
185 Returns : guessed format of filename (lower case)
|
|
186 Args :
|
|
187 Notes : formats that _filehandle() will guess includes
|
|
188 only phrap, by now.
|
|
189
|
|
190 =cut
|
|
191
|
|
192 sub _guess_format {
|
|
193 my $class = shift;
|
|
194 my $arg = shift;
|
|
195
|
|
196 return unless defined($arg);
|
|
197 return 'ace' if ($arg =~ /\.ace\.\d+$/i);
|
|
198 return 'phrap' if ($arg =~ /\.phrap\.out$/i);
|
|
199 }
|
|
200
|
|
201 sub DESTROY {
|
|
202 my $self = shift;
|
|
203
|
|
204 $self->close();
|
|
205 }
|
|
206
|
|
207 # I need some direction on these!! The module works so I haven't fiddled with them!
|
|
208 # Me neither! (rfsouza)
|
|
209
|
|
210 sub TIEHANDLE {
|
|
211 my ($class,$val) = @_;
|
|
212 return bless {'seqio' => $val}, $class;
|
|
213 }
|
|
214
|
|
215 sub READLINE {
|
|
216 my $self = shift;
|
|
217 return $self->{'seqio'}->next_seq() unless wantarray;
|
|
218 my (@list, $obj);
|
|
219 push @list, $obj while $obj = $self->{'seqio'}->next_seq();
|
|
220 return @list;
|
|
221 }
|
|
222
|
|
223 sub PRINT {
|
|
224 my $self = shift;
|
|
225 $self->{'seqio'}->write_seq(@_);
|
|
226 }
|
|
227
|
|
228 1;
|
|
229
|