JWS-67 insert Jpred 3.0.1 sources into JABAWS
[jabaws.git] / 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;