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     croak "Adding non Sequence object" unless isa $_, "Sequence";
  54     $self->_ids( $_->id );
  55     push @{ $self->{ __PACKAGE__ . "entries" } }, $_;
  56   }
  57
  58   #     my $max = $self->get_max_entries;
  59   #     if (defined $max) {
  60   #             my $exist_size = @{ $self->{__PACKAGE__."entries"} };
  61   #             if ($exist_size > $max) { return 0 }
  62   #             elsif ($exist_size + @entries > $max) {
  63   #                     return push @{ $self->{__PACKAGE__."entries"} }, @entries[0..$max - $exist_size];
  64   #             }
  65   #             else {
  66   #                     return push @{ $self->{__PACKAGE__."entries"} }, @entries;
  67   #             }
  68   #     }
  69   #     else {
  70   #             return push @{ $self->{__PACKAGE__."entries"} }, @entries;
  71   #     }
  72 }
  73
  74 =head2 $file->get_entry_by_id(/regex/);
  75
  76 Returns all of those entries which have id's that match the regex.
  77
  78 =cut
  79
  80 # Cache of sequence IDs for fast grepping
  81 sub _ids {
  82   my ( $self, $id ) = @_;
  83   if ($id) { push @{ $self->{ __PACKAGE__ . "ids" } }, $id }
  84   else     { return @{ $self->{ __PACKAGE__ . "ids" } } }
  85 }
  86
  87 sub get_entry_by_id {
  88   my ( $self, $id ) = @_;
  89   croak "No id passed" unless defined $id;
  90
  91   #return grep { $_->id =~ /$id/ } $self->get_entries;
  92
  93   {
  94     my @ids = $self->_ids;
  95     my @indices = grep { $ids[$_] =~ /$id/ } 0 .. $#ids;
  96     return $self->get_entry(@indices);
  97   }
  98 }
  99
 100 =head2 $file->set_max_entries($size);
 101
 102 Limits the storing of $size records. Will prevent the addition of more records,
 103 but won't delete existing records in the object if there are already more than
 104 $size entries.
 105
 106 =cut
 107
 108 sub set_max_entries {
 109   my ( $self, $size ) = @_;
 110
 111   $self->{ __PACKAGE__ . "max_size" } = $size;
 112   return $size;
 113 }
 114
 115 =head2 $file->get_max_entries
 116
 117 Accessor for set_max_entries().
 118
 119 =cut
 120
 121 sub get_max_entries {
 122   my ($self) = @_;
 123   return $self->{ __PACKAGE__ . "max_size" };
 124 }
 125
 126 =head2
 127
 128 =cut
 129
 130 sub sub_seq {
 131   my ( $self, $start, $end ) = @_;
 132
 133   croak "Not passed start and end arguments" unless 2 == grep { defined } $start, $end;
 134
 135   # Produce a new version of myself, in the right namespace
 136   my ($new_self) = ( ref $self )->new;
 137
 138   for ( $self->get_entries ) {
 139     my ($seq) = $_->sub_seq( $start, $end );
 140     $new_self->add_entries($seq);
 141   }
 142
 143   return $new_self;
 144 }
 145
 146 1;