Other packages in the module: Bio::DB::GFF::Adaptor::berkeleydb

Toolbar

Package variables

Included modules

Inherit

Bio::Root::Root

Synopsis

No synopsis!

Description

No description!

Methods

Methods description

None available.

Methods code

sub new {

  my $class  = shift;
  my $dbname = shift    or $class->throw("must provide a filepath argument");
  my ($write,$create) = @_;

  my $mode =  $create  ? "+>"
            : $write   ? "+>>"
            : "<";

  open (my $F,$mode,$dbname) or $class->throw("$dbname: $!");
  my $self = bless {
		    fh        => $F,
		    next_idx  => 0,
		    last_id   => 0,
		   },$class;
  return $self;

}

sub put {

  my $self   = shift;
  my $feature = shift;
  my $fh = $self->{fh};
  seek($fh,0,SEEK_END);
  my $offset = tell($fh) || 0;

  $self->{last_id} = $offset;

  my $id = pack("L",$offset);
  $feature->{feature_id} = $id;
  my $value = feature2string($feature);
  print $fh pack("n/a*",$value) or $self->throw("An error occurred while updating the data file: $!");


  return $id;

}

sub last_id {

  shift->{last_id};

}

sub get {

  my $self     = shift;
  my $idx      = shift;
  my $offset   = unpack("L",$idx);
  my $fh = $self->{fh};

  my ($value,$length);
  $offset ||= 0;
  seek($fh,$offset,SEEK_SET);
  return unless read($fh,$length,2);
  return unless read($fh,$value,unpack("n",$length));
  $self->{next_idx} = tell($fh);
  return if substr($value,0,1) eq "\0";
  return string2feature($value);

}

sub next {

  my $self = shift;
  my $fh     = $self->{fh};
  my $result;
  do {
    $result = $self->get(pack("L",$self->{next_idx}));
  } until $result || eof($fh);
  $self->{next_idx} = 0 unless $result;
  $result;

}

sub remove {

  my $self   = shift;
  my $id     = shift;
  my $offset = unpack("L",$id);
  my $fh     = $self->{fh};
  my ($value,$length);
  seek($fh,$offset,SEEK_SET);
  return unless read($fh,$length,2);
  print $fh "\0"x$length;  # null it out
  1;

}

sub _seek {

  my $self = shift;
  my $idx  = shift;
  my $offset   = unpack("L",$idx);
  seek($self->{fh},$offset,SEEK_SET);
  $self->{next_idx} = tell($self->{fh});

}

sub reset {

  my $self = shift;
  $self->_seek(pack("L",0));

}

sub _feature2string {

  my $feature = shift;
  my @a = @{$feature}{@hash2array_map};
  push @a,map {@$_} @{$feature->{attributes}} if $feature->{attributes};
  return join $;,@a;

}

sub _string2feature {

  my $string  = shift;
  my (%feature,@attributes);

  (@feature{@hash2array_map},@attributes) = split $;,$string;
  while (@attributes) {
    my ($key,$value) = splice(@attributes,0,2);
    push @{$feature{attributes}},[$key,$value];
  }
  $feature{group_id} = undef;\%
  feature;
}


1;

}

General documentation