view release on metacpan or  search on metacpan

Bio/DB/IndexedBase.pm  view on Meta::CPAN

}


=head2 get_PrimarySeq_stream

 Title   : get_PrimarySeq_stream
 Usage   : my $stream = $db->get_PrimarySeq_stream();
 Function: Get a SeqIO-like stream of sequence objects. The stream supports a
           single method, next_seq(). Each call to next_seq() returns a new
           PrimarySeqI compliant sequence object, until no more sequences remain.
           This is a Bio::DB::SeqI method implementation.
 Returns : A Bio::DB::Indexed::Stream object
 Args    : None

=cut

sub get_PrimarySeq_stream {
    my $self = shift;
    return Bio::DB::Indexed::Stream->new($self);
}


=head2 get_Seq_by_id

 Title   : get_Seq_by_id, get_Seq_by_acc, get_Seq_by_version, get_Seq_by_primary_id
 Usage   : my $seq = $db->get_Seq_by_id($id);
 Function: Given an ID, fetch the corresponding sequence from the database.
           This is a Bio::DB::SeqI and Bio::DB::RandomAccessI method implementation.
 Returns : A sequence object
 Args    : ID

=cut

sub get_Seq_by_id {
    my ($self, $id) = @_;
    $self->throw('Need to provide a sequence ID') if not defined $id;
    return if not exists $self->{offsets}{$id};
    return $self->{obj_class}->new($self, $id);
}

{
no warnings 'once';
*get_Seq_by_version = *get_Seq_by_primary_id = *get_Seq_by_acc = \&get_Seq_by_id;
}


=head2 _calculate_offsets

 Title   : _calculate_offsets
 Usage   : $db->_calculate_offsets($filename, $offsets);
 Function: This method calculates the sequence offsets in a file based on ID and
           should be implemented by classes that use Bio::DB::IndexedBase.
 Returns : Hash of offsets
 Args    : File to process
           Hashref of file offsets keyed by IDs.

=cut

sub _calculate_offsets {
    my $self = shift;
    $self->throw_not_implemented();
}


sub _index_files {
    # Do the indexing of the given files using the index file on record
    my ($self, $files, $force_reindex) = @_;

    $self->_set_pack_method( @$files );

    # Get name of index file
    my $index = $self->index_name;

    # If caller has requested reindexing, unlink the index file.
    if ($force_reindex) {
        # Tied-hash in Strawberry Perl creates "$file.index"
        unlink $index if -e $index;
        # Tied-hash in ActivePerl creates "$file.index.pag" and "$file.index.dir"
        unlink "$index.dir" if -e "$index.dir";
        unlink "$index.pag" if -e "$index.pag";
    }

    # Get the modification time of the index
    my $indextime = (stat $index)[9] || 0;

    # Register files and find if there has been any update
    my $modtime = 0;
    my @updated;
    for my $file (@$files) {
        # Register file
        $self->_path2fileno(basename($file));
        # Any update?
        my $m = (stat $file)[9] || 0;
        if ($m > $modtime) {
           $modtime = $m;
        }
        if ($m > $indextime) {
           push @updated, $file;
        }
    }

    # Get termination length from first file
    $self->{termination_length} = $self->_calc_termination_length( $files->[0] );

    # Reindex contents of changed files if needed
    my $reindex      = $force_reindex || (scalar @updated > 0);
    $self->{offsets} = $self->_open_index($index, $reindex) or return;
    if ($reindex) {
        $self->{indexing} = $index;
        for my $file (@updated) {
            my $fileno = $self->_path2fileno(basename($file));
            &{$self->{offset_meth}}($self, $fileno, $file, $self->{offsets});
        }
        delete $self->{indexing};
    }

    # Closing and reopening might help corrupted index file problem on Windows
    $self->_close_index($self->{offsets});

    return $self->{offsets} = $self->_open_index($index);
}