Bio/DB/GFF/Adaptor/memory/iterator.pm

   1 =head1 NAME
   2
   3 Bio::DB::GFF::Adaptor::memory::iterator - iterator for Bio::DB::GFF::Adaptor::memory
   4
   5 =head1 SYNOPSIS
   6
   7 For internal use only
   8
   9 =head1 DESCRIPTION
  10
  11 This is an internal module that is used by the Bio::DB::GFF in-memory
  12 adaptor to return an iterator across a sequence feature query.  The
  13 object has a single method, next_feature(), that returns the next
  14 feature from the query.  The method next_seq() is an alias for
  15 next_feature().
  16
  17 =head1 BUGS
  18
  19 None known yet.
  20
  21 =head1 SEE ALSO
  22
  23 L<Bio::DB::GFF>,
  24
  25 =head1 AUTHOR
  26
  27 Lincoln Stein E<lt>lstein@cshl.orgE<gt>.
  28
  29 Copyright (c) 2001 Cold Spring Harbor Laboratory.
  30
  31 This library is free software; you can redistribute it and/or modify
  32 it under the same terms as Perl itself.
  33
  34 =cut
  35
  36 package Bio::DB::GFF::Adaptor::memory::iterator;
  37 use strict;
  38 # this module needs to be cleaned up and documented
  39 use Bio::Root::Version;
  40
  41 *next_seq = \&next_feature;
  42
  43 sub new {
  44   my $class = shift;
  45   my ($data,$callback) = @_;
  46   my $pos = 0;
  47   return bless {data     => $data,
  48                 pos      => $pos,
  49                 callback => $callback,
  50                 cache    => []},$class;
  51   #return bless [$sth,$callback,[]],$class;
  52 }
  53
  54 sub next_feature {
  55   my $self = shift;
  56   return shift @{$self->{cache}} if @{$self->{cache}};
  57
  58   my $data     = $self->{data} or return;
  59   my $callback = $self->{callback};
  60
  61   my $features;
  62   while (1) {
  63     my $feature = $data->[$self->{pos}++];
  64     if ($feature) {
  65       $features   = $callback->(@{$feature});
  66       last if $features;
  67     } else {
  68       $features = $callback->();
  69       undef $self->{pos};
  70       undef $self->{data};
  71       undef $self->{cache};
  72       last;
  73     }
  74   }
  75   $self->{cache} = $features or return;
  76   shift @{$self->{cache}};
  77 }
  78
  79 1;