maint: restructure to use Dist::Zilla
[bioperl-live.git] / lib / Bio / PullParserI.pm
blob08f3121a50c2ed26ec50d0c1b29fe8b82cc644fa
2 # BioPerl module for Bio::PullParserI
4 # Please direct questions and support issues to <bioperl-l@bioperl.org>
6 # Cared for by Sendu Bala <bix@sendu.me.uk>
8 # Copyright Sendu Bala
10 # You may distribute this module under the same terms as perl itself
12 # POD documentation - main docs before the code
14 =head1 NAME
16 Bio::PullParserI - A base module for fast 'pull' parsing
18 =head1 SYNOPSIS
20 # do not use this class, it is intended for parser module
21 # writers only
23 =head1 DESCRIPTION
25 If you are writing a module to parse some new format, you may wish to use
26 a 'pull' approach whereby you only do work (reading file data, parsing it,
27 turning the parsed data in an object) when absolutely necessary.
29 PullParserI provides a system for doing exactly that. As a PullParser you
30 need a chunk. A chunk is just a Bio::Root::IO that contains all the raw data
31 you would want to parse. You can use the chunk() method to create a chunk from
32 a filename, existing filehandle or even a string. If you make a chunk from a
33 large file, but actually only want your chunk to be some portion of the whole
34 file, supply start and end amounts in bytes to chunk() at the same time.
35 The methods _chunk_seek() and _chunk_tell() provide seeks and tells that are
36 relative to the start and end of your chunk, not the whole file.
38 The other thing you will need to decide when making a chunk is how to handle
39 piped input. A PullParser typically needs seekable data to parse, so if your
40 data is piped in and unseekable, you must decide between creating a temp file
41 or reading the input into memory, which will be done before the chunk becomes
42 usable and you can begin any parsing. Alternatively you can choose to force
43 a sequential read, in which case you can make use of _dependencies() to define
44 the linear order of methods that would result in the file being read
45 sequentially. The return value of _sequential() is also useful here, if you
46 would need to cache some data or otherwise behave differently during a
47 sequential read.
49 The main method in the system is get_field(). This method relies on the
50 existence of a private hash reference accessible to it with the method
51 _fields(). That hash ref should have as keys all the sorts of data you will want
52 to parse (eg. 'score'), and prior to parsing the values would be undefined. A
53 user of your module can then call either $module-E<gt>get_field('score') or
54 $module-E<gt>score and get_field will either return the answer from
55 $self-E<gt>_fields-E<gt>{score} if it is defined, or call a method _discover_score()
56 first if not. So for the system to work you need to define a _discover_*()
57 method for every field in the fields hash, and ensure that the method stores an
58 answer in the fields hash.
60 How you implement your _discover_* methods is up to you, though you should never
61 call a _discover_* method directly yourself; always use get_field(), since
62 get_field() will deal with calling dependent methods for you if a forced
63 sequenctial read is in progress due to piped input. You will almost certainly
64 want to make use of the various chunk-related methods of this class (that are
65 denoted private by the leading '_'; this means you can use them as the author of
66 a parser class, but users of your parser should not).
68 Primary amongst them is _*_chunk_by_end() to which you provide text that
69 represents the end of your desired chunk and it does a readline with your
70 argument as $/. The chunk knows about its line-endings, so if you want your
71 end definition to include a new line, just always use "\n" and PullParserI will
72 do any necessary conversion for you.
74 If your input data is hierarchical (eg. report-E<gt>many results-E<gt>many hits-E<gt>many
75 hsps), and you want an object at the leaf of the hierarchy to have access to
76 information that is shared amongst all of them (is parsed in the root), you
77 don't have to copy the data to each leaf object; simply by defining parent(),
78 when you call get_field() and the requested field isn't in your leaf's fields
79 hash, the leaf's parent will be asked for the field instead, and so on till
80 root.
82 See Bio::SearchIO::hmmer_pull for an example of implementing a parser using
83 PullParserI.
85 =head1 FEEDBACK
87 =head2 Mailing Lists
89 User feedback is an integral part of the evolution of this and other
90 Bioperl modules. Send your comments and suggestions preferably to
91 the Bioperl mailing list. Your participation is much appreciated.
93 bioperl-l@bioperl.org - General discussion
94 http://bioperl.org/wiki/Mailing_lists - About the mailing lists
96 =head2 Support
98 Please direct usage questions or support issues to the mailing list:
100 I<bioperl-l@bioperl.org>
102 rather than to the module maintainer directly. Many experienced and
103 reponsive experts will be able look at the problem and quickly
104 address it. Please include a thorough description of the problem
105 with code and data examples if at all possible.
107 =head2 Reporting Bugs
109 Report bugs to the Bioperl bug tracking system to help us keep track
110 of the bugs and their resolution. Bug reports can be submitted via the
111 web:
113 https://github.com/bioperl/bioperl-live/issues
115 =head1 AUTHOR - Sendu Bala
117 Email bix@sendu.me.uk
119 =head1 CONTRIBUTORS
121 Inspired by a posting by Aaron J. Mackey
123 =head1 APPENDIX
125 The rest of the documentation details each of the object methods.
126 Internal methods are usually preceded with a _
128 =cut
130 # Let the code begin...
132 package Bio::PullParserI;
134 use vars qw($AUTOLOAD $FORCE_TEMP_FILE);
135 use strict;
137 use Bio::Root::IO;
139 use base qw(Bio::Root::RootI);
141 BEGIN {
142 # chunk() needs perl 5.8 feature for modes other than temp_file, so will
143 # workaround by forcing temp_file mode in <5.8. Could also rewrite using
144 # IO::String, but don't want to.
145 if ($] < 5.008) {
146 $FORCE_TEMP_FILE = 1;
150 =head2 _fields
152 Title : _fields
153 Usage : $obj->_fields( { field1 => undef } );
154 my $fields_ref = $obj->_fields;
155 Function: Get/set the hash reference containing all the fields for this parser
156 Returns : hash ref
157 Args : none to get, OR hash ref to set
159 =cut
161 sub _fields {
162 my $self = shift;
163 if (@_) {
164 $self->{_fields} = shift;
166 unless (defined $self->{_fields}) {
167 $self->{_fields} = { };
169 return $self->{_fields};
172 =head2 has_field
174 Title : has_field
175 Usage : if ($obj->has_field('field_name') {...}
176 Function: Ask if a particular object has a given field (doesn't ask ancestors)
177 Returns : boolean
178 Args : string (the field name to test)
180 =cut
182 sub has_field {
183 my ($self, $desired) = @_;
184 $desired || return;
185 return exists $self->_fields->{$desired};
188 =head2 get_field
190 Title : get_field
191 Usage : my $field_value = $obj->get_field('field_name');
192 Function: Get the value of a given field. If this $obj doesn't have the field,
193 it's parent() will be asked, and so on until there are no more
194 parents.
195 Returns : scalar, warns if a value for the field couldn't be found and returns
196 undef.
197 Args : string (the field to get)
199 =cut
201 sub get_field {
202 my $self = shift;
203 my $desired = shift || return keys %{$self->_fields};
204 if (exists $self->_fields->{$desired}) {
205 unless (defined $self->_fields->{$desired}) {
206 my $method = '_discover_'.$desired;
208 my $dependency = $self->_dependencies($desired);
209 if ($dependency && ! defined $self->_fields->{$dependency}) {
210 $self->get_field($dependency);
213 # it might exist now
214 $self->$method unless defined $self->_fields->{$desired};
216 return $self->_fields->{$desired};
219 # is it a field of our parent? (checks all ancestors)
220 if (my $parent = $self->parent) {
221 return $parent->get_field($desired);
224 $desired =~ s/_discover_//;
225 $self->warn("This report does not hold information about '$desired'");
226 return;
229 =head2 parent
231 Title : parent
232 Usage : $obj->parent($parent_obj);
233 my $parent_obj = $obj->parent;
234 Function: Get/set the parent object of this one.
235 Returns : Bio::PullParserI
236 Args : none to get, OR Bio::PullParserI to set
238 =cut
240 sub parent {
241 my $self = shift;
242 if (@_) { $self->{parent} = shift }
243 return $self->{parent} || return;
246 =head2 chunk
248 Title : chunk
249 Usage : $obj->chunk($filename);
250 my $chunk = $obj->chunk;
251 Function: Get/set the chunk of this parser.
252 Returns : Bio:Root::IO
253 Args : none to get, OR
254 First argument of a GLOB reference, filename string, string data to
255 treat as the chunk, or Bio::Root::IO.
256 Optionally, also provide:
257 -start => int : the byte position within the thing described by the
258 first argument to consider as the start of this
259 chunk (default 0)
260 -end => int : the byte position to consider as the end (default
261 true end)
262 -piped_behaviour => 'memory'|'temp_file'|'sequential_read'
264 The last option comes into effect when the first argument is
265 something that cannot be seeked (eg. piped input filehandle).
266 'memory' means read all the piped input into a string
267 first, then set the chunk to that string.
268 'temp_file' means read all the piped input and output it to
269 a temp file, then set the chunk to that temp file.
270 'sequential_read' means that the piped input should be read
271 sequentially and your parsing code must cope with
272 not being able to seek.
273 'memory' is the fastest but uses the most memory. 'temp_file' and
274 'sequential_read' can be slow, with 'temp_file' being the most memory
275 efficient but requiring disc space. The default is 'sequential_read'.
276 Note that in versions of perl earlier than 5.8 only temp_file works
277 and will be used regardless of what value is supplied here.
279 =cut
281 sub chunk {
282 my $self = shift;
284 if (@_) {
285 my $thing = shift || $self->throw("Trying to set chunk() to an undefined value");
286 if (ref($thing) eq 'GLOB') {
287 $self->{_chunk} = Bio::Root::IO->new(-fh => $thing);
289 elsif (ref(\$thing) eq 'SCALAR') {
290 if ($thing !~ /\n/ && -e $thing) {
291 $self->{_chunk} = Bio::Root::IO->new(-file => $thing);
293 else {
294 unless ($FORCE_TEMP_FILE) {
295 # treat a string as a filehandle
296 open my $fake_fh, "+<", \$thing or $self->throw("Could not open file '$thing': $!"); # requires perl 5.8
297 $self->{_chunk} = Bio::Root::IO->new(-fh => $fake_fh);
299 else {
300 my ($handle) = $self->{_chunk}->tempfile();
301 print $handle $thing;
302 $self->{_chunk} = Bio::Root::IO->new(-fh => $handle);
306 elsif ($thing->isa('Bio::Root::IO')) {
307 $self->{_chunk} = $thing;
309 else {
310 $self->throw("Unknown input into chunk()");
313 my ($piped_behaviour, $start, $end);
314 if (@_) {
315 ($piped_behaviour, $start, $end) =
316 $self->_rearrange([qw(PIPED_BEHAVIOUR START END)], @_);
318 $piped_behaviour ||= 'sequential_read';
319 $FORCE_TEMP_FILE && ($piped_behaviour = 'temp_file');
320 $start ||= 0;
321 $self->_chunk_true_start($start);
322 $self->_chunk_true_end($end);
324 # determine if the chunk is seekable
325 my $fh = $self->{_chunk}->_fh;
326 seek($fh, 0, 0);
327 my $first_line = <$fh>;
328 seek($fh, 0, 0);
329 my $seekable = tell($fh) == 0;
330 unless ($seekable) {
331 if ($piped_behaviour eq 'memory') {
332 my $string = $first_line;
333 while (<$fh>) {
334 $string .= $_;
336 $self->chunk($string);
338 elsif ($piped_behaviour eq 'temp_file') {
339 my ($handle) = $self->{_chunk}->tempfile();
340 print $handle $first_line;
341 while (<$fh>) {
342 print $handle $_;
344 seek($handle, 0, 0);
345 $self->chunk($handle);
347 elsif ($piped_behaviour eq 'sequential_read') {
348 $self->{_chunk}->_pushback($first_line);
349 $self->_sequential(1);
351 else {
352 $self->throw("Unknown piped behaviour type '$piped_behaviour'");
356 # determine our line ending
357 if ($first_line =~ /\r\n/) {
358 $self->_line_ending("\r\n");
360 elsif ($first_line =~ /\r/) {
361 $self->_line_ending("\r");
363 else {
364 $self->_line_ending("\n");
368 return $self->{_chunk} || return;
371 =head2 _sequential
373 Title : _sequential
374 Usage : if ($obj->_sequential) {...}
375 Function: Ask if we have to do operations such that the input is read
376 sequentially.
377 Returns : boolean
378 Args : none to get, OR boolean to set (typically, you should never set this
379 yourself)
381 =cut
383 sub _sequential {
384 my $self = shift;
385 if (@_) {
386 $self->{_sequential} = shift;
388 return $self->{_sequential} || 0;
391 =head2 _dependencies
393 Title : _dependencies
394 Usage : $obj->_dependencies( { field1 => field2 } );
395 my $dependancy = $obj->_dependencies('field_name');
396 Function: Set the fields that are dependent on each other, or get the field
397 than another is dependent upon.
398 Returns : string (a field name)
399 Args : string (a field name) to get, OR hash ref to initially set, with
400 field names as keys and values, key field being dependent upon value
401 field.
403 =cut
405 sub _dependencies {
406 my ($self, $thing) = @_;
407 $thing || return;
408 if (ref($thing) eq 'HASH') {
409 $self->{_dependencies} = $thing;
411 else {
412 return $self->{_dependencies}->{$thing};
416 =head2 _chunk_true_start
418 Title : _chunk_true_start
419 Usage : my $true_start = $obj->_chunk_true_start;
420 Function: Get/set the true start position of the chunk within the filehandle
421 it is part of.
422 Returns : int
423 Args : none to get, OR int to set (typically, you won't set this yourself)
425 =cut
427 sub _chunk_true_start {
428 my $self = shift;
429 if (@_) {
430 $self->{_chunk_start} = shift;
432 return $self->{_chunk_start} || 0;
435 =head2 _chunk_true_end
437 Title : _chunk_true_end
438 Usage : my $true_end = $obj->_chunk_true_end;
439 Function: Get/set for the true end position of the chunk within the filehandle
440 it is part of.
441 Returns : int
442 Args : none to get, OR int to set (typically, you won't set this yourself)
444 =cut
446 sub _chunk_true_end {
447 my $self = shift;
448 if (@_) {
449 $self->{_chunk_end} = shift;
451 return $self->{_chunk_end};
454 =head2 _line_ending
456 Title : _line_ending
457 Usage : my $line_ending = $obj->_line_ending;
458 Function: Get/set for the line ending for the chunk.
459 Returns : string
460 Args : none to get, OR string to set (typically, you won't set this
461 yourself)
463 =cut
465 sub _line_ending {
466 my $self = shift;
467 if (@_) {
468 $self->{_chunk_line_ending} = shift;
470 return $self->{_chunk_line_ending};
473 =head2 _chunk_seek
475 Title : _chunk_seek
476 Usage : $obj->_chunk_seek($pos);
477 Function: seek() the chunk to the provided position in bytes, relative to the
478 defined start of the chunk within its filehandle.
480 In _sequential() mode, this function does nothing.
482 Returns : n/a
483 Args : int
485 =cut
487 sub _chunk_seek {
488 my ($self, $pos) = @_;
489 $self->throw("Undefined position passed") unless defined $pos;
490 return if $self->_sequential;
492 my $fh = $self->chunk->_fh;
494 # seek to the defined start
495 seek($fh, $self->_chunk_true_start, 0);
497 # now seek to desired position relative to defined start
498 seek($fh, $pos, 1);
501 =head2 _chunk_tell
503 Title : _chunk_seek
504 Usage : my $pos = $obj->_chunk_tell;
505 Function: Get the current tell() position within the chunk, relative to the
506 defined start of the chunk within its filehandle.
508 In _sequential() mode, this function does nothing.
510 Returns : int
511 Args : none
513 =cut
515 sub _chunk_tell {
516 my $self = shift;
517 return if $self->_sequential;
519 my $fh = $self->chunk->_fh;
520 return tell($fh) - $self->_chunk_true_start;
523 =head2 _get_chunk_by_nol
525 Title : _chunk_seek
526 Usage : my $string = $obj->_get_chunk_by_nol;
527 Function: Get a chunk of chunk() from the current position onward for the given
528 number of lines.
529 Returns : string
530 Args : int (number of lines you want)
532 =cut
534 sub _get_chunk_by_nol {
535 my ($self, $nol) = @_;
536 $nol > 0 || $self->throw("Can't request a chunk of fewer than 1 lines");
538 # hope that $/ is \n
540 my ($line, $count);
541 while (defined($_ = $self->chunk->_readline)) {
542 $line .= $_;
543 $count++;
544 last if $count == $nol;
547 my $current = $self->_chunk_tell;
548 my $end = ($current || 0) + $self->_chunk_true_start;
549 if (! $current || ($self->_chunk_true_end ? $end <= $self->_chunk_true_end : 1)) {
550 return $line;
552 return;
555 =head2 _get_chunk_by_end
557 Title : _get_chunk_by_end
558 Usage : my $string = $obj->_get_chunk_by_end;
559 Function: Get a chunk of chunk() from the current position onward till the end
560 of the line, as defined by the supplied argument.
561 Returns : string
562 Args : string (line ending - if you want the line ending to include a new
563 line, always use \n)
565 =cut
567 sub _get_chunk_by_end {
568 my ($self, $chunk_ending) = @_;
570 my $start = $self->_chunk_tell;
572 my $line_ending = $self->_line_ending;
573 $chunk_ending =~ s/\n/$line_ending/g;
574 local $/ = $chunk_ending || '';
575 my $line = $self->chunk->_readline;
577 my $current = $self->_chunk_tell;
578 my $end = ($current || 0) + $self->_chunk_true_start;
579 if (! $current || ($self->_chunk_true_end ? $end <= $self->_chunk_true_end : 1)) {
580 return $line;
583 $self->_chunk_seek($start);
584 return;
587 =head2 _find_chunk_by_end
589 Title : _find_chunk_by_end
590 Usage : my $string = $obj->_find_chunk_by_end;
591 Function: Get the start and end of what would be a chunk of chunk() from the
592 current position onward till the end of the line, as defined by the
593 supplied argument.
595 In _sequential() mode, this function does nothing.
597 Returns : _chunk_tell values for start and end in 2 element list
598 Args : string (line ending - if you want the line ending to include a new
599 line, always use \n)
601 =cut
603 sub _find_chunk_by_end {
604 my ($self, $chunk_ending) = @_;
605 return if $self->_sequential;
607 my $line_ending = $self->_line_ending;
608 $chunk_ending =~ s/\n/$line_ending/g;
609 local $/ = $chunk_ending || '';
611 my $start = $self->_chunk_tell;
612 $self->chunk->_readline;
613 my $end = $self->_chunk_tell;
615 my $comp_end = $end + $self->_chunk_true_start;
616 if ($self->_chunk_true_end ? $comp_end <= $self->_chunk_true_end : 1) {
617 return ($start, $end);
620 $self->_chunk_seek($start);
621 return;
624 =head2 AUTOLOAD
626 Title : AUTOLOAD
627 Usage : n/a
628 Function: Assumes that any unknown method called should be treated as
629 get_field($method_name).
630 Returns : n/a
631 Args : n/a
633 =cut
635 sub AUTOLOAD {
636 my $self = shift;
637 ref($self) || return;
639 my $name = $AUTOLOAD;
640 $name =~ s/.*://; # strip fully-qualified portion
642 # is it one of our fields?
643 return $self->get_field($name);