binaries/src/jpred/lib/Sequence/File.pm

   1 package Sequence::File;
   2
   3 use strict;
   4 use warnings;
   5 use Carp;
   6
   7 #use UNIVERSAL qw(isa);
   8 use base qw(Root Read Write);
   9
  10 =head2 $file->get_entries
  11
  12 Returns all records so far found in the file.
  13
  14 =cut
  15
  16 sub get_entries {
  17   my ($self) = @_;
  18
  19   if ( exists $self->{ __PACKAGE__ . "entries" } ) {
  20     return @{ $self->{ __PACKAGE__ . "entries" } };
  21   } else {
  22     return undef;
  23   }
  24 }
  25
  26 =head2 $file->get_entry(@positions);
  27
  28 Retrieves the @position's'th record found in the file or undef if there is no such sequence.
  29
  30 =cut
  31
  32 sub get_entry {
  33   my ( $self, @offsets ) = @_;
  34
  35   if ( exists $self->{ __PACKAGE__ . "entries" } and @offsets ) {
  36     return @{ $self->{ __PACKAGE__ . "entries" } }[@offsets];
  37   } else {
  38     return undef;
  39   }
  40 }
  41
  42 =head2 $self->add_entries(@entries)
  43
  44 Adds more entries to the object. Returns the number of entries added to the object. This may be less than those passed if set_max_entries() has been called.
  45
  46 =cut
  47
  48 sub add_entries {
  49   my ( $self, @entries ) = @_;
  50   return unless @entries;
  51
  52   for (@entries) {
  53
  54     #    croak "Adding non Sequence object" unless isa $_, "Sequence";
  55     $self->_ids( $_->id );
  56     push @{ $self->{ __PACKAGE__ . "entries" } }, $_;
  57   }
  58 }
  59
  60 =head2 $file->get_entry_by_id(/regex/);
  61
  62 Returns all of those entries which have id's that match the regex.
  63
  64 =cut
  65
  66 # Cache of sequence IDs for fast grepping
  67 sub _ids {
  68   my ( $self, $id ) = @_;
  69   if ($id) { push @{ $self->{ __PACKAGE__ . "ids" } }, $id }
  70   else     { return @{ $self->{ __PACKAGE__ . "ids" } } }
  71 }
  72
  73 sub get_entry_by_id {
  74   my ( $self, $id ) = @_;
  75   croak "No id passed" unless defined $id;
  76
  77   #return grep { $_->id =~ /$id/ } $self->get_entries;
  78
  79   {
  80     my @ids = $self->_ids;
  81     my @indices = grep { $ids[$_] =~ /$id/ } 0 .. $#ids;
  82     return $self->get_entry(@indices);
  83   }
  84 }
  85
  86 =head2 $file->set_max_entries($size);
  87
  88 Limits the storing of $size records. Will prevent the addition of more records,
  89 but won't delete existing records in the object if there are already more than
  90 $size entries.
  91
  92 =cut
  93
  94 sub set_max_entries {
  95   my ( $self, $size ) = @_;
  96
  97   $self->{ __PACKAGE__ . "max_size" } = $size;
  98   return $size;
  99 }
 100
 101 =head2 $file->get_max_entries
 102
 103 Accessor for set_max_entries().
 104
 105 =cut
 106
 107 sub get_max_entries {
 108   my ($self) = @_;
 109   return $self->{ __PACKAGE__ . "max_size" };
 110 }
 111
 112 =head2
 113
 114 =cut
 115
 116 sub sub_seq {
 117   my ( $self, $start, $end ) = @_;
 118
 119   croak "Not passed start and end arguments" unless 2 == grep { defined } $start, $end;
 120
 121   # Produce a new version of myself, in the right namespace
 122   my ($new_self) = ( ref $self )->new;
 123
 124   for ( $self->get_entries ) {
 125     my ($seq) = $_->sub_seq( $start, $end );
 126     $new_self->add_entries($seq);
 127   }
 128
 129   return $new_self;
 130 }
 131
 132 1;