—

              
package Bio::DB::SeqFeature::Store::bdb;
# $Id: bdb.pm,v 1.3.4.1 2006/10/02 23:10:17 sendu Exp $
HideShow 6 lines of Pod
=head1 NAME
Bio::DB::SeqFeature::Store::bdb - fetch and store objects from a BerkeleyDB
=cut
use strict;
use base 'Bio::DB::SeqFeature::Store';
use Bio::DB::GFF::Util::Rearrange 'rearrange';
use DB_File;
use Fcntl qw(O_RDWR O_CREAT);
use File::Temp 'tempdir';
use File::Path 'rmtree';
# this is a partial implementation -- just enough has been implemented so that we can
# fetch and store objects. It is used as a temporary failsafe store by the GFF3Loader module
###
# object initialization
#
sub init {
  my $self          = shift;
  my ($directory,
      $is_temporary) = rearrange([['DSN','DIR','DIRECTORY'],
                                 ['TMP','TEMP','TEMPORARY']
                                 ],@_);
  $directory ||= $is_temporary ? File::Spec->tmpdir : '.';
  $directory = tempdir(__PACKAGE__.'_XXXXXX',TMPDIR=>1,CLEANUP=>1,DIR=>$directory) if $is_temporary;
  -d $directory && -w _ or $self->throw("Can't write into the directory $directory");
  $self->default_settings;
  $self->directory($directory);
  $self->temporary($is_temporary);
  my %h;
  tie (%h,'DB_File',$self->path,O_RDWR|O_CREAT,0666,$DB_HASH) or $self->throw("Couldn't tie: $!");
  $self->db(\%h);
  $h{'.next_id'} ||= 1;
}
sub _store {
  my $self = shift;
  my $indexed = shift;
  my $db   = $self->db;
  my $count = 0;
  for my $obj (@_) {
    my $primary_id = $obj->primary_id;
    $primary_id    = $db->{'.next_id'}++ unless defined $primary_id;
    $db->{$primary_id} = $self->freeze($obj);
    $obj->primary_id($primary_id);
    $count++;
  }
  $count;
}
sub _update {
  my $self = shift;
  my ($object,$primary_id) = @_;
  my $db = $self->db;
  $self->throw("$object is not in database") unless exists $db->{$primary_id};
  $db->{$primary_id} = $self->freeze($object);
}
sub _fetch {
  my $self = shift;
  my $id   = shift;
  my $db = $self->db;
  my $obj = $self->thaw($db->{$id},$id);
  $obj;
}
sub db {
  my $self = shift;
  my $d = $self->setting('db');
  $self->setting(db=>shift) if @_;
  $d;
}
sub directory {
  my $self = shift;
  my $d = $self->setting('directory');
  $self->setting(directory=>shift) if @_;
  $d;
}
sub temporary {
  my $self = shift;
  my $d = $self->setting('temporary');
  $self->setting(temporary=>shift) if @_;
  $d;
}
sub path {
  my $self = shift;
  return $self->directory .'/' . 'feature.bdb';
}
sub DESTROY {
  my $self = shift;
  my $db   = $self->db;
  warn "CLEANING UP";
  untie %$db;
  rmtree($self->directory,0,1) if $self->temporary;
}
1;