lib/Bio/Seq/BaseSeqProcessor.pm

   1 #
   2 # BioPerl module for Bio::Seq::BaseSeqProcessor
   3 #
   4 # Please direct questions and support issues to <bioperl-l@bioperl.org>
   5 #
   6 # Cared for by Hilmar Lapp <hlapp at gmx.net>
   7 #
   8 # Copyright Hilmar Lapp
   9 #
  10 # You may distribute this module under the same terms as perl itself
  11
  12 #
  13 # (c) Hilmar Lapp, hlapp at gmx.net, 2002.
  14 # (c) GNF, Genomics Institute of the Novartis Research Foundation, 2002.
  15 #
  16 # You may distribute this module under the same terms as perl itself.
  17 # Refer to the Perl Artistic License (see the license accompanying this
  18 # software package, or see http://www.perl.com/language/misc/Artistic.html)
  19 # for the terms under which you may use, modify, and redistribute this module.
  20 #
  21 # THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED
  22 # WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
  23 # MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
  24 #
  25
  26 # POD documentation - main docs before the code
  27
  28 =head1 NAME
  29
  30 Bio::Seq::BaseSeqProcessor - Base implementation for a SequenceProcessor
  31
  32 =head1 SYNOPSIS
  33
  34     # you need to derive your own processor from this one
  35
  36 =head1 DESCRIPTION
  37
  38 This provides just a basic framework for implementations of
  39 L<Bio::Factory::SequenceProcessorI>.
  40
  41 Essentially what it does is support a parameter to new() to set
  42 sequence factory and source stream, and a next_seq() implementation
  43 that will use a queue to be filled by a class overriding
  44 process_seq().
  45
  46 =head1 FEEDBACK
  47
  48 =head2 Mailing Lists
  49
  50 User feedback is an integral part of the evolution of this and other
  51 Bioperl modules. Send your comments and suggestions preferably to
  52 the Bioperl mailing list.  Your participation is much appreciated.
  53
  54   bioperl-l@bioperl.org                  - General discussion
  55   http://bioperl.org/wiki/Mailing_lists  - About the mailing lists
  56
  57 =head2 Support
  58
  59 Please direct usage questions or support issues to the mailing list:
  60
  61 I<bioperl-l@bioperl.org>
  62
  63 rather than to the module maintainer directly. Many experienced and
  64 reponsive experts will be able look at the problem and quickly
  65 address it. Please include a thorough description of the problem
  66 with code and data examples if at all possible.
  67
  68 =head2 Reporting Bugs
  69
  70 Report bugs to the Bioperl bug tracking system to help us keep track
  71 of the bugs and their resolution. Bug reports can be submitted via the
  72 web:
  73
  74   https://github.com/bioperl/bioperl-live/issues
  75
  76 =head1 AUTHOR - Hilmar Lapp
  77
  78 Email hlapp at gmx.net
  79
  80 =head1 APPENDIX
  81
  82 The rest of the documentation details each of the object methods.
  83 Internal methods are usually preceded with a _
  84
  85 =cut
  86
  87
  88 # Let the code begin...
  89
  90
  91 package Bio::Seq::BaseSeqProcessor;
  92
  93 use strict;
  94
  95 # Object preamble - inherits from Bio::Root::Root
  96
  97
  98 use base qw(Bio::Root::Root Bio::Factory::SequenceProcessorI);
  99
 100 =head2 new
 101
 102  Title   : new
 103  Usage   : my $obj = Bio::Seq::BaseSeqProcessor->new();
 104  Function: Builds a new Bio::Seq::BaseSeqProcessor object
 105  Returns : an instance of Bio::Seq::BaseSeqProcessor
 106  Args    : Named parameters. Currently supported are
 107              -seqfactory  the Bio::Factory::SequenceFactoryI object to use
 108              -source_stream the Bio::Factory::SequenceStreamI object to
 109                           which we are chained
 110
 111
 112 =cut
 113
 114 sub new {
 115     my($class,@args) = @_;
 116
 117     my $self = $class->SUPER::new(@args);
 118
 119     my ($stream,$fact) =
 120         $self->_rearrange([qw(SOURCE_STREAM SEQFACTORY)], @args);
 121
 122     $self->{'_queue'} = [];
 123     $self->sequence_factory($fact) if $fact;
 124     $self->source_stream($stream) if $stream;
 125
 126     return $self;
 127 }
 128
 129 =head1 L<Bio::Factory::SequenceProcessorI> methods
 130
 131 =cut
 132
 133 =head2 source_stream
 134
 135  Title   : source_stream
 136  Usage   : $obj->source_stream($newval)
 137  Function: Get/set the source sequence stream for this sequence
 138            processor.
 139
 140  Example :
 141  Returns : A Bio::Factory::SequenceStreamI compliant object
 142  Args    : on set, new value (a Bio::Factory::SequenceStreamI compliant
 143            object)
 144
 145
 146 =cut
 147
 148 sub source_stream{
 149     my $self = shift;
 150
 151     if(@_) {
 152         my $stream = shift;
 153         my $fact = $stream->sequence_factory();
 154         $self->sequence_factory($fact)
 155             unless $self->sequence_factory() || (! $fact);
 156         return $self->{'source_stream'} = $stream;
 157     }
 158     return $self->{'source_stream'};
 159 }
 160
 161 =head1 L<Bio::Factory::SequenceStreamI> methods
 162
 163 =cut
 164
 165 =head2 next_seq
 166
 167  Title   : next_seq
 168  Usage   : $seq = stream->next_seq
 169  Function: Reads the next sequence object from the stream and returns it.
 170
 171            This implementation will obtain objects from the source
 172            stream as necessary and pass them to process_seq() for
 173            processing. This method will return the objects one at a
 174            time that process_seq() returns.
 175
 176  Returns : a Bio::Seq sequence object
 177  Args    : none
 178
 179 See L<Bio::Factory::SequenceStreamI::next_seq>
 180
 181 =cut
 182
 183 sub next_seq{
 184     my $self = shift;
 185     my $seq;
 186
 187     # if the queue is empty, fetch next from source and process it
 188     if(@{$self->{'_queue'}} == 0) {
 189         my @seqs = ();
 190         while($seq = $self->source_stream->next_seq()) {
 191             @seqs = $self->process_seq($seq);
 192             # we may get zero seqs returned
 193             last if @seqs;
 194         }
 195         push(@{$self->{'_queue'}}, @seqs) if @seqs;
 196     }
 197     # take next from the queue of seqs
 198     $seq = shift(@{$self->{'_queue'}});
 199     return $seq;
 200 }
 201
 202 =head2 write_seq
 203
 204  Title   : write_seq
 205  Usage   : $stream->write_seq($seq)
 206  Function: Writes the result(s) of processing the sequence object into
 207            the stream.
 208
 209            You need to override this method in order not to alter
 210            (process) sequence objects before output.
 211
 212  Returns : 1 for success and 0 for error. The method stops attempting
 213            to write objects after the first error returned from the
 214            source stream. Otherwise the return value is the value
 215            returned from the source stream from writing the last
 216            object resulting from processing the last sequence object
 217            given as argument.
 218
 219  Args    : Bio::SeqI object, or an array of such objects
 220
 221 =cut
 222
 223 sub write_seq{
 224     my ($self, @seqs) = @_;
 225     my $ret;
 226     foreach my $seq (@seqs) {
 227         foreach my $processed ($self->process_seq($seq)) {
 228             $ret = $self->source_stream->write_seq($seq);
 229             return unless $ret;
 230         }
 231     }
 232     return $ret;
 233 }
 234
 235 =head2 sequence_factory
 236
 237  Title   : sequence_factory
 238  Usage   : $seqio->sequence_factory($seqfactory)
 239  Function: Get the Bio::Factory::SequenceFactoryI
 240  Returns : Bio::Factory::SequenceFactoryI
 241  Args    : none
 242
 243
 244 =cut
 245
 246 sub sequence_factory{
 247     my $self = shift;
 248
 249     return $self->{'sequence_factory'} = shift if @_;
 250     return $self->{'sequence_factory'};
 251 }
 252
 253 =head2 object_factory
 254
 255  Title   : object_factory
 256  Usage   : $obj->object_factory($newval)
 257  Function: This is an alias to sequence_factory with a more generic name.
 258  Example :
 259  Returns : a L<Bio::Factory::ObjectFactoryI> compliant object
 260  Args    : on set, new value (a L<Bio::Factory::ObjectFactoryI>
 261            compliant object or undef, optional)
 262
 263
 264 =cut
 265
 266 sub object_factory{
 267     return shift->sequence_factory(@_);
 268 }
 269
 270 =head2 close
 271
 272  Title   : close
 273  Usage   :
 274  Function: Closes the stream. We override this here in order to cascade
 275            to the source stream.
 276  Example :
 277  Returns :
 278  Args    : none
 279
 280
 281 =cut
 282
 283 sub close{
 284     my $self = shift;
 285     return $self->source_stream() ? $self->source_stream->close(@_) : 1;
 286 }
 287
 288 =head1 To be overridden by a derived class
 289
 290 =cut
 291
 292 =head2 process_seq
 293
 294  Title   : process_seq
 295  Usage   :
 296  Function: This is the method that is supposed to do the actual
 297            processing. It needs to be overridden to do what you want
 298            it to do.
 299
 300            Generally, you do not have to override or implement any other
 301            method to derive your own sequence processor.
 302
 303            The implementation provided here just returns the unaltered
 304            input sequence and hence is not very useful other than
 305            serving as a neutral default processor.
 306
 307  Example :
 308  Returns : An array of zero or more Bio::PrimarySeqI (or derived
 309            interface) compliant object as the result of processing the
 310            input sequence.
 311  Args    : A Bio::PrimarySeqI (or derived interface) compliant object
 312            to be processed.
 313
 314
 315 =cut
 316
 317 sub process_seq{
 318     my ($self,$seq) = @_;
 319
 320     return ($seq);
 321 }
 322
 323 1;