Bio/DB/SeqFeature/Store/bdb.pm

   1 package Bio::DB::SeqFeature::Store::bdb;
   2
   3
   4 =head1 NAME
   5
   6 Bio::DB::SeqFeature::Store::bdb - fetch and store objects from a BerkeleyDB
   7
   8 =head1 DESCRIPTION
   9
  10 This is a partial implementation -- just enough has been implemented so that we can
  11 fetch and store objects. It is used as a temporary failsafe store by the GFF3Loader module
  12
  13 =cut
  14
  15 use strict;
  16 use base 'Bio::DB::SeqFeature::Store';
  17 use Bio::DB::GFF::Util::Rearrange 'rearrange';
  18 use DB_File;
  19 use Fcntl qw(O_RDWR O_CREAT);
  20 use File::Temp 'tempdir';
  21 use File::Path 'rmtree';
  22
  23 ###
  24 # object initialization
  25 #
  26 sub init {
  27   my $self          = shift;
  28   my ($directory,
  29       $is_temporary) = rearrange([['DSN','DIR','DIRECTORY'],
  30                                  ['TMP','TEMP','TEMPORARY']
  31                                  ],@_);
  32   $directory ||= $is_temporary ? File::Spec->tmpdir : '.';
  33   $directory = tempdir(__PACKAGE__.'_XXXXXX',TMPDIR=>1,CLEANUP=>1,DIR=>$directory) if $is_temporary;
  34   -d $directory && -w _ or $self->throw("Can't write into the directory $directory");
  35   $self->default_settings;
  36   $self->directory($directory);
  37   $self->temporary($is_temporary);
  38
  39   my %h;
  40   tie (%h,'DB_File',$self->path,O_RDWR|O_CREAT,0666,$DB_HASH) or $self->throw("Couldn't tie: $!");
  41   $self->db(\%h);
  42   $h{'.next_id'} ||= 1;
  43 }
  44
  45 sub _store {
  46   my $self = shift;
  47   my $indexed = shift;
  48   my $db   = $self->db;
  49   my $count = 0;
  50   for my $obj (@_) {
  51     my $primary_id = $obj->primary_id;
  52     $primary_id    = $db->{'.next_id'}++ unless defined $primary_id;
  53     $db->{$primary_id} = $self->freeze($obj);
  54     $obj->primary_id($primary_id);
  55     $count++;
  56   }
  57   $count;
  58 }
  59
  60 sub _update {
  61   my $self = shift;
  62   my ($object,$primary_id) = @_;
  63   my $db = $self->db;
  64   $self->throw("$object is not in database") unless exists $db->{$primary_id};
  65   $db->{$primary_id} = $self->freeze($object);
  66 }
  67
  68 sub _fetch {
  69   my $self = shift;
  70   my $id   = shift;
  71   my $db = $self->db;
  72   my $obj = $self->thaw($db->{$id},$id);
  73   $obj;
  74 }
  75
  76 sub db {
  77   my $self = shift;
  78   my $d = $self->setting('db');
  79   $self->setting(db=>shift) if @_;
  80   $d;
  81 }
  82
  83 sub directory {
  84   my $self = shift;
  85   my $d = $self->setting('directory');
  86   $self->setting(directory=>shift) if @_;
  87   $d;
  88 }
  89
  90 sub temporary {
  91   my $self = shift;
  92   my $d = $self->setting('temporary');
  93   $self->setting(temporary=>shift) if @_;
  94   $d;
  95 }
  96
  97 sub path {
  98   my $self = shift;
  99   return $self->directory .'/' . 'feature.bdb';
 100 }
 101
 102 sub DESTROY {
 103   my $self = shift;
 104   my $db   = $self->db;
 105   untie %$db;
 106   rmtree($self->directory,0,1) if $self->temporary;
 107 }
 108
 109 1;