lib/Bio/Index/AbstractSeq.pm

   1 #
   2 # BioPerl module for Bio::Index::AbstractSeq
   3 #
   4 # Please direct questions and support issues to <bioperl-l@bioperl.org>
   5 #
   6 # Cared for by Ewan Birney <birney@ebi.ac.uk>
   7 #
   8 # Copyright Ewan Birney
   9 #
  10 # You may distribute this module under the same terms as perl itself
  11
  12 # POD documentation - main docs before the code
  13
  14 =head1 NAME
  15
  16 Bio::Index::AbstractSeq - base class for AbstractSeq
  17
  18 =head1 SYNOPSIS
  19
  20   # Make a new sequence file indexing package
  21
  22   package MyShinyNewIndexer;
  23
  24   use base qw(Bio::Index::AbstractSeq);
  25
  26   # Now provide the necessary methods...
  27
  28 =head1 DESCRIPTION
  29
  30 Provides a common base class for multiple sequence files built using
  31 the Bio::Index::Abstract system, and provides a Bio::DB::SeqI
  32 interface.
  33
  34 =head1 FEEDBACK
  35
  36 =head2 Mailing Lists
  37
  38 User feedback is an integral part of the evolution of this
  39 and other Bioperl modules. Send your comments and suggestions
  40 preferably to one of the Bioperl mailing lists.
  41 Your participation is much appreciated.
  42
  43   bioperl-l@bioperl.org                  - General discussion
  44   http://bioperl.org/wiki/Mailing_lists  - About the mailing lists
  45
  46 =head2 Support
  47
  48 Please direct usage questions or support issues to the mailing list:
  49
  50 I<bioperl-l@bioperl.org>
  51
  52 rather than to the module maintainer directly. Many experienced and
  53 reponsive experts will be able look at the problem and quickly
  54 address it. Please include a thorough description of the problem
  55 with code and data examples if at all possible.
  56
  57 =head2 Reporting Bugs
  58
  59 Report bugs to the Bioperl bug tracking system to help us keep track
  60 the bugs and their resolution.  Bug reports can be submitted via the
  61 web:
  62
  63   https://github.com/bioperl/bioperl-live/issues
  64
  65 =head1 AUTHOR - Ewan Birney
  66
  67 Email birney@ebi.ac.uk
  68
  69 =head1 APPENDIX
  70
  71 The rest of the documentation details each of the object methods.
  72 Internal methods are usually preceded with a _
  73
  74 =head1 SEE ALSO
  75
  76 L<Bio::Index::Abstract>, which provides dbm indexing for flat files of
  77 any type, containing sequence or not. L<Bio::Index::AbstractSeq> inherits
  78 from L<Bio::Index::Abstract>
  79
  80 =cut
  81
  82 # Let's begin the code ...
  83
  84 package Bio::Index::AbstractSeq;
  85
  86 use strict;
  87
  88 use Bio::SeqIO::MultiFile;
  89
  90 use base qw(Bio::Index::Abstract Bio::DB::SeqI);
  91
  92 sub new {
  93         my ($class, @args) = @_;
  94         my $self = $class->SUPER::new(@args);
  95
  96         $self->{'_seqio_cache'} = [];
  97         return $self;
  98 }
  99
 100 =head2 _file_format
 101
 102  Title   : _file_format
 103  Usage   : $self->_file_format
 104  Function: Derived classes should override this
 105            method (it throws an exception here)
 106            to give the file format of the files used
 107  Example :
 108  Returns :
 109  Args    :
 110
 111 =cut
 112
 113 sub _file_format {
 114    my ($self,@args) = @_;
 115
 116    my $pkg = ref($self);
 117    $self->throw("Class '$pkg' must provide a file format method correctly");
 118 }
 119
 120 =head2 fetch
 121
 122   Title   : fetch
 123   Usage   : $index->fetch( $id )
 124   Function: Returns a Bio::Seq object from the index
 125   Example : $seq = $index->fetch( 'dJ67B12' )
 126   Returns : Bio::Seq object
 127   Args    : ID
 128
 129 =cut
 130
 131 sub fetch {
 132         my( $self, $id ) = @_;
 133         my $db = $self->db();
 134         my $seq;
 135
 136         if (my $rec = $db->{ $id }) {
 137                 my ($file, $begin) = $self->unpack_record( $rec );
 138
 139                 # Get the (possibly cached) SeqIO object
 140                 my $seqio = $self->_get_SeqIO_object( $file );
 141                 my $fh = $seqio->_fh();
 142
 143                 # move to start of record
 144                 # $begin-- if( $^O =~ /mswin/i); # workaround for Win DB_File bug
 145                 seek($fh, $begin, 0);
 146
 147                 $seq = $seqio->next_seq();
 148         }
 149
 150         # we essentially assume that the primary_id for the database
 151         # is the display_id
 152         if (ref($seq) && $seq->isa('Bio::PrimarySeqI') &&
 153                  $seq->primary_id =~ /^\D+$/) {
 154                 $seq->primary_id( $seq->display_id() );
 155         }
 156         return $seq;
 157 }
 158
 159 =head2 _get_SeqIO_object
 160
 161   Title   : _get_SeqIO_object
 162   Usage   : $index->_get_SeqIO_object( $file )
 163   Function: Returns a Bio::SeqIO object for the file
 164   Example : $seq = $index->_get_SeqIO_object( 0 )
 165   Returns : Bio::SeqIO object
 166   Args    : File number (an integer)
 167
 168 =cut
 169
 170 sub _get_SeqIO_object {
 171     my( $self, $i ) = @_;
 172
 173     unless ($self->{'_seqio_cache'}[$i]) {
 174         my $fh = $self->_file_handle($i);
 175         # make a new SeqIO object
 176         my $seqio = Bio::SeqIO->new( -Format => $self->_file_format,
 177                                      -fh     => $fh);
 178         $self->{'_seqio_cache'}[$i] = $seqio;
 179     }
 180     return $self->{'_seqio_cache'}[$i];
 181 }
 182
 183 =head2 get_Seq_by_id
 184
 185  Title   : get_Seq_by_id
 186  Usage   : $seq = $db->get_Seq_by_id()
 187  Function: retrieves a sequence object, identically to
 188            ->fetch, but here behaving as a Bio::DB::BioSeqI
 189  Returns : new Bio::Seq object
 190  Args    : string represents the id
 191
 192
 193 =cut
 194
 195 sub get_Seq_by_id {
 196    my ($self,$id) = @_;
 197
 198    return $self->fetch($id);
 199 }
 200
 201 =head2 get_Seq_by_acc
 202
 203  Title   : get_Seq_by_acc
 204  Usage   : $seq = $db->get_Seq_by_acc()
 205  Function: retrieves a sequence object, identically to
 206            ->fetch, but here behaving as a Bio::DB::BioSeqI
 207  Returns : new Bio::Seq object
 208  Args    : string represents the accession number
 209
 210
 211 =cut
 212
 213 sub get_Seq_by_acc {
 214    my ($self,$id) = @_;
 215
 216    return $self->fetch($id);
 217 }
 218
 219 =head2 get_PrimarySeq_stream
 220
 221  Title   : get_PrimarySeq_stream
 222  Usage   : $stream = get_PrimarySeq_stream
 223  Function: Makes a Bio::DB::SeqStreamI compliant object
 224            which provides a single method, next_primary_seq
 225  Returns : Bio::DB::SeqStreamI
 226  Args    : none
 227
 228
 229 =cut
 230
 231 sub get_PrimarySeq_stream {
 232     my $self = shift;
 233     my $num  = $self->_file_count() || 0;
 234     my @file;
 235
 236     for (my $i = 0; $i < $num; $i++) {
 237         my( $file, $stored_size ) = $self->unpack_record( $self->db->{"__FILE_$i"} );
 238         push(@file,$file);
 239     }
 240
 241     my $out = Bio::SeqIO::MultiFile->new( '-format' => $self->_file_format , -files => \@file);
 242     return $out;
 243 }
 244
 245 =head2 get_all_primary_ids
 246
 247  Title   : get_all_primary_ids
 248  Usage   : @ids = $seqdb->get_all_primary_ids()
 249  Function: gives an array of all the primary_ids of the
 250            sequence objects in the database. These
 251            maybe ids (display style) or accession numbers
 252            or something else completely different - they
 253            *are not* meaningful outside of this database
 254            implementation.
 255  Example :
 256  Returns : an array of strings
 257  Args    : none
 258
 259
 260 =cut
 261
 262 sub get_all_primary_ids {
 263    my ($self,@args) = @_;
 264     my $db = $self->db;
 265
 266    # the problem is here that we have indexed things both on
 267    # accession number and name.
 268
 269    # We could take two options
 270    # here - loop over the database, returning only one copy of each
 271    # id that points to the same byte position, or we rely on semantics
 272    # of accession numbers.
 273
 274    # someone is going to index a database with no accession numbers.
 275    # doh!. We have to uniquify the index...
 276
 277    my( %bytepos );
 278    while (my($id, $rec) = each %$db) {
 279        if( $id =~ /^__/ ) {
 280            # internal info
 281            next;
 282        }
 283        my ($file, $begin) = $self->unpack_record( $rec );
 284
 285        $bytepos{"$file:$begin"} = $id;
 286    }
 287
 288    return values %bytepos;
 289 }
 290
 291
 292 =head2 get_Seq_by_primary_id
 293
 294  Title   : get_Seq_by_primary_id
 295  Usage   : $seq = $db->get_Seq_by_primary_id($primary_id_string);
 296  Function: Gets a Bio::Seq object by the primary id. The primary
 297            id in these cases has to come from $db->get_all_primary_ids.
 298            There is no other way to get (or guess) the primary_ids
 299            in a database.
 300
 301            The other possibility is to get Bio::PrimarySeqI objects
 302            via the get_PrimarySeq_stream and the primary_id field
 303            on these objects are specified as the ids to use here.
 304  Returns : A Bio::Seq object
 305  Args    : primary id (as a string)
 306  Throws  : "acc does not exist" exception
 307
 308
 309 =cut
 310
 311 sub get_Seq_by_primary_id {
 312    my ($self,$id) = @_;
 313    return $self->fetch($id);
 314 }
 315
 316 1;