view release on metacpan or  search on metacpan

Bio/DB/SeqFeature/Store/DBI/SQLite.pm  view on Meta::CPAN

  my $autoindex = $self->autoindex;

  for my $obj (@_) {
    my $id       = $self->next_id;
    my ($seqid,$start,$end,$strand) = $indexed ? $self->_get_location_and_bin($obj) : (undef)x4;
    my $primary_tag = $obj->primary_tag;
    my $source_tag  = $obj->source_tag || '';
    $primary_tag    .= ":$source_tag";
    my $typeid   = $self->_typeid($primary_tag,1);

    # Encode BLOB in hex so we can more easily import it into SQLite
    print $store_fh
    join("\t",$id,$typeid,$strand,$indexed,
         unpack('H*', $self->freeze($obj))),"\n";
    $obj->primary_id($id);
    $self->_update_indexes($obj) if $indexed && $autoindex;
    $count++;
  }

  # remember whether we are have ever stored a non-indexed feature
  unless ($indexed or $self->{indexed_flag}++) {
    $self->subfeatures_are_indexed(0);
  }
  $count;
}

sub _dump_update_name_index {
  my $self = shift;
  my ($obj,$id) = @_;
  my $fh      = $self->dump_filehandle('name');
  my $dbh     = $self->dbh;
  my ($names,$aliases) = $self->feature_names($obj);
  # unlike DBI::mysql, don't quote, as quotes will be quoted when loaded
  print $fh join("\t",$id,$_,1),"\n" foreach @$names;
  print $fh join("\t",$id,$_,0),"\n" foreach @$aliases;
}

sub _update_name_index {
  my $self = shift;
  my ($obj,$id) = @_;
  my $name = $self->_name_table;
  my $primary_id = $obj->primary_id;

  $self->_delete_index($name,$id);
  my ($names,$aliases) = $self->feature_names($obj);

  my $sth = $self->_prepare("INSERT INTO $name (id,name,display_name) VALUES (?,?,?)");

  $sth->execute($id,$_,1) or $self->throw($sth->errstr)   foreach @$names;
  $sth->execute($id,$_,0) or $self->throw($sth->errstr) foreach @$aliases;
  $sth->finish;
}


sub _dump_update_attribute_index {
  my $self = shift;
  my ($obj,$id) = @_;
  my $fh        = $self->dump_filehandle('attribute');
  my $dbh       = $self->dbh;
  for my $tag ($obj->all_tags) {
    my $tagid = $self->_attributeid($tag);
    for my $value ($obj->each_tag_value($tag)) {
      # unlike DBI::mysql, don't quote, as quotes will be quoted when loaded
      print $fh join("\t",$id,$tagid,$value),"\n";
    }
  }
}

sub _update_indexes {
    my $self = shift;
    my $obj  = shift;
    defined (my $id   = $obj->primary_id) or return;
    $self->SUPER::_update_indexes($obj);

    if ($self->{bulk_update_in_progress}) {
	$self->_dump_update_location_index($obj,$id);
    } else {
	$self->_update_location_index($obj,$id);
    }
}

sub _update_location_index {
    my $self = shift;
    my ($obj,$id) = @_;
    my ($seqid,$start,$end,$strand,$bin) = $self->_get_location_and_bin($obj);

    my $table = $self->_feature_index_table;
    $self->_delete_index($table,$id);

    my ($sql,@args);

    if ($self->_has_spatial_index) {
	$sql    = "INSERT INTO $table (id,seqid,bin,start,end) values (?,?,?,?,?)";
	@args   = ($id,$seqid,$bin,$start,$end);
    } else {
	$sql    = "INSERT INTO $table (id,seqid,bin,start,end) values (?,?,?,?,?)";
	@args   = ($id,$seqid,$bin,$start,$end);
    }

    my $sth  = $self->_prepare($sql);
    $sth->execute(@args);
    $sth->finish;
}

sub _dump_update_location_index {
    my $self = shift;
    my ($obj,$id) = @_;
    my $table   = $self->_feature_index_table;
    my $fh      = $self->dump_filehandle($table);
    my $dbh     = $self->dbh;
    my ($seqid,$start,$end,$strand,$bin) = $self->_get_location_and_bin($obj);
    my @args = $self->_has_spatial_index ? ($id,$seqid,$bin,$start,$end)
	                                 : ($id,$seqid,$bin,$start,$end);
    print $fh join("\t",@args),"\n";
}

sub DESTROY {
    my $self = shift;
    # Remove filehandles, so temporal files can be properly deleted
    if (%DBI::installed_drh) {
	DBI->disconnect_all;
	%DBI::installed_drh = ();
    }
    undef $self->{dbh};