view release on metacpan or  search on metacpan

Bio/DB/GFF/Adaptor/berkeleydb.pm  view on Meta::CPAN

  my $self = shift;
  my $db   = $self->db;
  my ($key,$value) = ('__class__',undef);
  my %classes;
  for (my $status = $db->seq($key,$value,R_CURSOR);
       $status == 0;
       $status = $db->seq($key,$value,R_NEXT)) {
    my ($class) = $key =~ /^__class__(.+)/ or last;
    $classes{$class}++ if $value > 0;
  }
  my @classes = sort keys %classes;
  return @classes;
}

sub do_initialize {
  my $self  = shift;
  my $erase = shift;
  my $spare_fasta = shift; # used internally only!
  if ($erase) {
    $self->_close_databases;
    unlink $self->_index_file;
    unlink $self->_data_file;
    unlink $self->_notes_file;
    unless ($spare_fasta) {
      unlink $self->_fasta_file;
      unlink $self->_fasta_file.'.index';
    }
    unlink $self->_timestamp_file;
    $self->_open_databases(1,1);
  }
  1;
}

# load_sequence($fasta_filehandle,$first_sequence_id)
sub load_sequence {
  my $self = shift;
  my ($io_handle,$id) = @_;
  my $file = $self->_fasta_file;
  my $loaded = 0;

  open my $F, '>>', $file or $self->throw("Could not append file '$file': $!");

  if (defined $id) {
    print $F ">$id\n";
    $loaded++;
  }

  while (<$io_handle>) {
    $loaded++ if /^>/;
    print $F $_;
  }
  close $F;
  my $dna_db = Bio::DB::Fasta->new($file) or $self->throw("Can't reindex sequence file: $@");
  $self->dna_db($dna_db);
  $self->_touch_timestamp;
  return $loaded;
}

sub _mtime {
  my $file = shift;
  my @stat = stat($file);
  return $stat[9];
}

sub _index_file {
  my $self = shift;
  return $self->dsn . "/bdb_features.btree";
}

sub _data_file {
  my $self = shift;
  return $self->dsn . "/bdb_features.data";
}

sub _fasta_file {
  my $self = shift;
  return $self->dsn . "/bdb_sequence.fa";
}

sub _notes_file {
  my $self = shift;
  return $self->dsn . "/bdb_notes.idx";
}

sub _temp_file {
  my $self = shift;
  local $^W=0;
  my (undef,$filename) = tempfile("bdb_temp_XXXXXX",DIR=>$self->tmpdir,OPEN=>0);
  return $filename;
}

sub _timestamp_file {
  my $self = shift;
  return $self->dsn ."/bdb_timestamp";
}

sub db {
  my $db   = shift()->{db} or return;
  return tied(%$db);
}

sub dsn {
  my $self = shift;
  my $d    = $self->{dsn};
  $self->{dsn} = shift if @_;
  $d;
}

sub tmpdir {
  my $self = shift;
  my $d    = $self->{tmpdir};
  $self->{tmpdir} = shift if @_;
  $d;
}

sub load_gff_line {

  my ($self, $feat) = @_;

  $feat->{strand} = '' if $feat->{strand} && $feat->{strand} eq '.';
  $feat->{phase} = ''  if $feat->{phase}  && $feat->{phase}  eq '.';