Filename | /Users/ap13/perl5/lib/perl5/Bio/DB/InMemoryCache.pm |
Statements | Executed 7 statements in 967µs |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
1 | 1 | 1 | 1.61ms | 3.29ms | BEGIN@75 | Bio::DB::InMemoryCache::
1 | 1 | 1 | 13µs | 25µs | BEGIN@73 | Bio::DB::InMemoryCache::
1 | 1 | 1 | 10µs | 763µs | BEGIN@77 | Bio::DB::InMemoryCache::
0 | 0 | 0 | 0s | 0s | _load_Seq | Bio::DB::InMemoryCache::
0 | 0 | 0 | 0s | 0s | _number_free | Bio::DB::InMemoryCache::
0 | 0 | 0 | 0s | 0s | agr | Bio::DB::InMemoryCache::
0 | 0 | 0 | 0s | 0s | get_Seq_by_acc | Bio::DB::InMemoryCache::
0 | 0 | 0 | 0s | 0s | get_Seq_by_id | Bio::DB::InMemoryCache::
0 | 0 | 0 | 0s | 0s | get_Seq_by_version | Bio::DB::InMemoryCache::
0 | 0 | 0 | 0s | 0s | new | Bio::DB::InMemoryCache::
0 | 0 | 0 | 0s | 0s | number | Bio::DB::InMemoryCache::
0 | 0 | 0 | 0s | 0s | seqdb | Bio::DB::InMemoryCache::
Line | State ments |
Time on line |
Calls | Time in subs |
Code |
---|---|---|---|---|---|
1 | # | ||||
2 | # BioPerl module for Bio::DB::InMemoryCache | ||||
3 | # | ||||
4 | # Please direct questions and support issues to <bioperl-l@bioperl.org> | ||||
5 | # | ||||
6 | # Cared for by Ewan Birney <birney@sanger.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::DB::InMemoryCache - Abstract interface for a sequence database | ||||
17 | |||||
18 | =head1 SYNOPSIS | ||||
19 | |||||
20 | $cachedb = Bio::DB::InMemoryCache->new( -seqdb => $real_db, | ||||
21 | -number => 1000); | ||||
22 | # | ||||
23 | # get a database object somehow using a concrete class | ||||
24 | # | ||||
25 | |||||
26 | $seq = $cachedb->get_Seq_by_id('ROA1_HUMAN'); | ||||
27 | |||||
28 | # | ||||
29 | # $seq is a Bio::Seq object | ||||
30 | # | ||||
31 | |||||
32 | =head1 DESCRIPTION | ||||
33 | |||||
34 | This is a memory cache system which saves the objects returned by | ||||
35 | Bio::DB::RandomAccessI in memory to a hard limit of sequences. | ||||
36 | |||||
37 | =head1 CONTACT | ||||
38 | |||||
39 | Ewan Birney E<lt>birney@ebi.ac.ukE<gt> | ||||
40 | |||||
41 | =head2 Support | ||||
42 | |||||
43 | Please direct usage questions or support issues to the mailing list: | ||||
44 | |||||
45 | I<bioperl-l@bioperl.org> | ||||
46 | |||||
47 | rather than to the module maintainer directly. Many experienced and | ||||
48 | reponsive experts will be able look at the problem and quickly | ||||
49 | address it. Please include a thorough description of the problem | ||||
50 | with code and data examples if at all possible. | ||||
51 | |||||
52 | =head2 Reporting Bugs | ||||
53 | |||||
54 | Report bugs to the Bioperl bug tracking system to help us keep track | ||||
55 | the bugs and their resolution. Bug reports can be submitted via the | ||||
56 | web: | ||||
57 | |||||
58 | https://github.com/bioperl/bioperl-live/issues | ||||
59 | |||||
60 | =head1 APPENDIX | ||||
61 | |||||
62 | The rest of the documentation details each of the object | ||||
63 | methods. Internal methods are usually preceded with a _ | ||||
64 | |||||
65 | =cut | ||||
66 | |||||
67 | |||||
68 | # Let the code begin... | ||||
69 | |||||
70 | package Bio::DB::InMemoryCache; | ||||
71 | |||||
72 | |||||
73 | 2 | 23µs | 2 | 37µs | # spent 25µs (13+12) within Bio::DB::InMemoryCache::BEGIN@73 which was called:
# once (13µs+12µs) by Bio::SeqFeatureI::BEGIN@99 at line 73 # spent 25µs making 1 call to Bio::DB::InMemoryCache::BEGIN@73
# spent 12µs making 1 call to strict::import |
74 | |||||
75 | 2 | 257µs | 1 | 3.29ms | # spent 3.29ms (1.61+1.69) within Bio::DB::InMemoryCache::BEGIN@75 which was called:
# once (1.61ms+1.69ms) by Bio::SeqFeatureI::BEGIN@99 at line 75 # spent 3.29ms making 1 call to Bio::DB::InMemoryCache::BEGIN@75 |
76 | |||||
77 | 2 | 684µs | 2 | 763µs | # spent 763µs (10+752) within Bio::DB::InMemoryCache::BEGIN@77 which was called:
# once (10µs+752µs) by Bio::SeqFeatureI::BEGIN@99 at line 77 # spent 763µs making 1 call to Bio::DB::InMemoryCache::BEGIN@77
# spent 752µs making 1 call to base::import, recursion: max depth 1, sum of overlapping time 752µs |
78 | |||||
79 | sub new { | ||||
80 | my ($class,@args) = @_; | ||||
81 | |||||
82 | my $self = Bio::Root::Root->new(); | ||||
83 | bless $self,$class; | ||||
84 | |||||
85 | my ($seqdb,$number,$agr) = | ||||
86 | $self->_rearrange([qw(SEQDB NUMBER AGRESSION)],@args); | ||||
87 | |||||
88 | if( !defined $seqdb || !ref $seqdb || | ||||
89 | !$seqdb->isa('Bio::DB::RandomAccessI') ) { | ||||
90 | $self->throw("Must be a RandomAccess database not a [$seqdb]"); | ||||
91 | } | ||||
92 | |||||
93 | if( !defined $number ) { | ||||
94 | $number = 1000; | ||||
95 | } | ||||
96 | |||||
97 | $self->seqdb($seqdb); | ||||
98 | $self->number($number); | ||||
99 | $self->agr($agr); | ||||
100 | |||||
101 | # we consider acc as the primary id here | ||||
102 | $self->{'_cache_number_hash'} = {}; | ||||
103 | $self->{'_cache_id_hash'} = {}; | ||||
104 | $self->{'_cache_acc_hash'} = {}; | ||||
105 | $self->{'_cache_number'} = 1; | ||||
106 | |||||
107 | return $self; | ||||
108 | } | ||||
109 | |||||
110 | =head2 get_Seq_by_id | ||||
111 | |||||
112 | Title : get_Seq_by_id | ||||
113 | Usage : $seq = $db->get_Seq_by_id('ROA1_HUMAN') | ||||
114 | Function: Gets a Bio::Seq object by its name | ||||
115 | Returns : a Bio::Seq object | ||||
116 | Args : the id (as a string) of a sequence | ||||
117 | Throws : "id does not exist" exception | ||||
118 | |||||
119 | =cut | ||||
120 | |||||
121 | sub get_Seq_by_id{ | ||||
122 | my ($self,$id) = @_; | ||||
123 | |||||
124 | if( defined $self->{'_cache_id_hash'}->{$id} ) { | ||||
125 | my $acc = $self->{'_cache_id_hash'}->{$id}; | ||||
126 | my $seq = $self->{'_cache_acc_hash'}->{$acc}; | ||||
127 | $self->{'_cache_number_hash'}->{$seq->accession} = | ||||
128 | $self->{'_cache_number'}++; | ||||
129 | return $seq; | ||||
130 | } else { | ||||
131 | return $self->_load_Seq('id',$id); | ||||
132 | } | ||||
133 | } | ||||
134 | |||||
135 | =head2 get_Seq_by_acc | ||||
136 | |||||
137 | Title : get_Seq_by_acc | ||||
138 | Usage : $seq = $db->get_Seq_by_acc('X77802'); | ||||
139 | Function: Gets a Bio::Seq object by accession number | ||||
140 | Returns : A Bio::Seq object | ||||
141 | Args : accession number (as a string) | ||||
142 | Throws : "acc does not exist" exception | ||||
143 | |||||
144 | =cut | ||||
145 | |||||
146 | sub get_Seq_by_acc{ | ||||
147 | my ($self,$acc) = @_; | ||||
148 | |||||
149 | #print STDERR "In cache get for $acc\n"; | ||||
150 | if( defined $self->{'_cache_acc_hash'}->{$acc} ) { | ||||
151 | #print STDERR "Returning cached $acc\n"; | ||||
152 | my $seq = $self->{'_cache_acc_hash'}->{$acc}; | ||||
153 | $self->{'_cache_number_hash'}->{$seq->accession} = | ||||
154 | $self->{'_cache_number'}++; | ||||
155 | return $seq; | ||||
156 | } else { | ||||
157 | return $self->_load_Seq('acc',$acc); | ||||
158 | } | ||||
159 | } | ||||
160 | |||||
- - | |||||
163 | sub number { | ||||
164 | my ($self, $number) = @_; | ||||
165 | if ($number) { | ||||
166 | $self->{'number'} = $number; | ||||
167 | } else { | ||||
168 | return $self->{'number'}; | ||||
169 | } | ||||
170 | } | ||||
171 | |||||
172 | sub seqdb { | ||||
173 | my ($self, $seqdb) = @_; | ||||
174 | if ($seqdb) { | ||||
175 | $self->{'seqdb'} = $seqdb; | ||||
176 | } else { | ||||
177 | return $self->{'seqdb'}; | ||||
178 | } | ||||
179 | } | ||||
180 | |||||
181 | sub agr { | ||||
182 | my ($self, $agr) = @_; | ||||
183 | if ($agr) { | ||||
184 | $self->{'agr'} = $agr; | ||||
185 | } else { | ||||
186 | return $self->{'agr'}; | ||||
187 | } | ||||
188 | } | ||||
189 | |||||
190 | |||||
191 | sub _load_Seq { | ||||
192 | my ($self,$type,$id) = @_; | ||||
193 | |||||
194 | my $seq; | ||||
195 | |||||
196 | if( $type eq 'id') { | ||||
197 | $seq = $self->seqdb->get_Seq_by_id($id); | ||||
198 | }elsif ( $type eq 'acc' ) { | ||||
199 | $seq = $self->seqdb->get_Seq_by_acc($id); | ||||
200 | } else { | ||||
201 | $self->throw("Bad internal error. Don't understand $type"); | ||||
202 | } | ||||
203 | if( ! $seq ) { | ||||
204 | # warding off bug #1628 | ||||
205 | $self->debug("could not find seq $id in seqdb\n"); | ||||
206 | return; | ||||
207 | } | ||||
208 | |||||
209 | if( $self->agr() ) { | ||||
210 | #print STDERR "Pulling out into memory\n"; | ||||
211 | my $newseq = Bio::Seq->new( -display_id => $seq->display_id, | ||||
212 | -accession_number => $seq->accession, | ||||
213 | -seq => $seq->seq, | ||||
214 | -desc => $seq->desc, | ||||
215 | ); | ||||
216 | if( $self->agr() == 1 ) { | ||||
217 | foreach my $sf ( $seq->top_SeqFeatures() ) { | ||||
218 | $newseq->add_SeqFeature($sf); | ||||
219 | } | ||||
220 | |||||
221 | $newseq->annotation($seq->annotation); | ||||
222 | } | ||||
223 | $seq = $newseq; | ||||
224 | } | ||||
225 | |||||
226 | if( $self->_number_free < 1 ) { | ||||
227 | # remove the latest thing from the hash | ||||
228 | my @accs = sort { $self->{'_cache_number_hash'}->{$a} <=> | ||||
229 | $self->{'_cache_number_hash'}->{$b} } | ||||
230 | keys %{$self->{'_cache_number_hash'}}; | ||||
231 | |||||
232 | my $acc = shift @accs; | ||||
233 | # remove this guy | ||||
234 | my $seq = $self->{'_cache_acc_hash'}->{$acc}; | ||||
235 | |||||
236 | delete $self->{'_cache_number_hash'}->{$acc}; | ||||
237 | delete $self->{'_cache_id_hash'}->{$seq->id}; | ||||
238 | delete $self->{'_cache_acc_hash'}->{$acc}; | ||||
239 | } | ||||
240 | |||||
241 | # up the number, register this sequence into the hash. | ||||
242 | $self->{'_cache_id_hash'}->{$seq->id} = $seq->accession; | ||||
243 | $self->{'_cache_acc_hash'}->{$seq->accession} = $seq; | ||||
244 | $self->{'_cache_number_hash'}->{$seq->accession} = $self->{'_cache_number'}++; | ||||
245 | |||||
246 | return $seq; | ||||
247 | } | ||||
248 | |||||
249 | |||||
250 | sub _number_free { | ||||
251 | my $self = shift; | ||||
252 | |||||
253 | return $self->number - scalar(keys %{$self->{'_cache_number_hash'}}); | ||||
254 | } | ||||
255 | |||||
256 | =head2 get_Seq_by_version | ||||
257 | |||||
258 | Title : get_Seq_by_version | ||||
259 | Usage : $seq = $db->get_Seq_by_version('X77802.1'); | ||||
260 | Function: Gets a Bio::Seq object by sequence version | ||||
261 | Returns : A Bio::Seq object | ||||
262 | Args : accession.version (as a string) | ||||
263 | Throws : "acc.version does not exist" exception | ||||
264 | |||||
265 | =cut | ||||
266 | |||||
267 | sub get_Seq_by_version{ | ||||
268 | my ($self,@args) = @_; | ||||
269 | $self->throw("Not implemented it"); | ||||
270 | } | ||||
271 | |||||
272 | ## End of Package | ||||
273 | |||||
274 | 1 | 2µs | 1; |