lib/Bio/DB/GFF/Adaptor/berkeleydb/iterator.pm

   1 =head1 NAME
   2
   3 Bio::DB::GFF::Adaptor::berkeleydb::iterator - iterator for Bio::DB::GFF::Adaptor::berkeleydb
   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::berkeleydb::iterator;
  37 use strict;
  38 use DB_File qw(R_FIRST R_NEXT);
  39
  40 # this module needs to be cleaned up and documented
  41 use Bio::Root::Version;
  42 *next_seq = \&next_feature;
  43
  44 sub new {
  45   my $class = shift;
  46   my ($data,$callback,$tmpfile) = @_;
  47   return bless {data     => $data,
  48                 callback => $callback,
  49                 tmpfile  => $tmpfile,
  50                 cache    => []},$class;
  51 }
  52
  53 sub next_feature {
  54   my $self = shift;
  55   return shift @{$self->{cache}} if @{$self->{cache}};
  56
  57   my $data     = $self->{data} or return;
  58   my $callback = $self->{callback};
  59
  60   my $features;
  61   my $db = tied(%$data);
  62   my ($key,$value);
  63
  64   for (my $status = $db->seq($key,$value,$self->{iter}++ ? R_NEXT : R_FIRST);
  65        $status == 0;
  66        $status = $db->seq($key,$value,R_NEXT)) {
  67     my @feature       = split ($;,$value);
  68     $features   = $callback->(@feature);
  69     last if $features;
  70   }
  71
  72   unless ($features) {
  73     $features = $callback->();
  74     undef $self->{data};
  75     undef $self->{cache};
  76     unlink $self->{tmpfile};
  77   }
  78
  79   $self->{cache} = $features or return;
  80   shift @{$self->{cache}};
  81 }
  82
  83 1;