[Bioperl-guts-l] bioperl-live/Bio/DB/GFF/Adaptor/berkeleydb iterator.pm, NONE, 1.1

[Lincoln Stein]

Update of /home/repository/bioperl/bioperl-live/Bio/DB/GFF/Adaptor/berkeleydb
In directory pub.open-bio.org:/tmp/cvs-serv31146/Bio/DB/GFF/Adaptor/berkeleydb

Added Files:
	iterator.pm 
Log Message:
berkeley adaptor no longer requires in-memory sorting for iterator to work; normalized names of the memory_iterator to memory::iterator


--- NEW FILE: iterator.pm ---
=head1 NAME

Bio::DB::GFF::Adaptor::berkeleydb::iterator - iterator for Bio::DB::GFF::Adaptor::berkeleydb

=head1 SYNOPSIS

For internal use only

=head1 DESCRIPTION

This is an internal module that is used by the Bio::DB::GFF in-memory
adaptor to return an iterator across a sequence feature query.  The
object has a single method, next_feature(), that returns the next
feature from the query.  The method next_seq() is an alias for
next_feature().

=head1 BUGS

None known yet.

=head1 SEE ALSO

L<Bio::DB::GFF>,

=head1 AUTHOR

Lincoln Stein E<lt>lstein at cshl.orgE<gt>.

Copyright (c) 2001 Cold Spring Harbor Laboratory.

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.

=cut

package Bio::DB::GFF::Adaptor::berkeleydb::iterator;
use strict;
use Storable 'thaw';
# $Id: iterator.pm,v 1.1 2005/07/27 22:15:15 lstein Exp $

# this module needs to be cleaned up and documented
use Bio::Root::Version;
*next_seq = \&next_feature;

sub new {
  my $class = shift;
  my ($data,$callback,$tmpfile) = @_;
  return bless {data     => $data,
		callback => $callback,
		tmpfile  => $tmpfile,
                cache    => []},$class;
}

sub next_feature {
  my $self = shift;
  return shift @{$self->{cache}} if @{$self->{cache}};

  my $data     = $self->{data} or return;
  my $callback = $self->{callback};

  my $features;
  while (1) {
    my (undef,$value) = each %$data;
    my $feature       = thaw($value);
    if ($feature) {
      $features   = $callback->(@{$feature});
      last if $features;
    } else {
      $features = $callback->();
      undef $self->{data};
      undef $self->{cache};
      unlink $self->{tmpfile};
      last;
    }
  }
  $self->{cache} = $features or return;
  shift @{$self->{cache}};
}

1;