annotate variant_effect_predictor/Bio/DB/FileCache.pm @ 3:d30fa12e4cc5 default tip

Merge heads 2:a5976b2dce6f and 1:09613ce8151e which were created as a result of a recently fixed bug.
author devteam <devteam@galaxyproject.org>
date Mon, 13 Jan 2014 10:38:30 -0500
parents 1f6dce3d34e0
children
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
0
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
1 # POD documentation - main docs before the code
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
2 #
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
3 #
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
4
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
5 =head1 NAME
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
6
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
7 Bio::DB::FileCache - In file cache for BioSeq objects
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
8
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
9 =head1 SYNOPSIS
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
10
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
11
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
12
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
13 $cachedb = Bio::DB::FileCache->new($real_db);
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
14
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
15 #
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
16 # $real_db is a Bio::DB::RandomAccessI database
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
17 #
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
18
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
19 $seq = $cachedb->get_Seq_by_id('ROA1_HUMAN');
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
20
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
21 #
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
22 # $seq is a Bio::Seq object
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
23 #
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
24
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
25 # more control provided with named-parameter form
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
26
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
27 $cachedb = Bio::DB::FileCache->new( -seqdb => $real_db,
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
28 -file => $path,
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
29 -keep => $flag,
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
30 );
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
31 =head1 DESCRIPTION
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
32
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
33 This is a disk cache system which saves the objects returned by
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
34 Bio::DB::RandomAccessI on disk. The disk cache grows without limit,
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
35 while the process is running, but is automatically unlinked at process
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
36 termination unless the -keep flag is set.
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
37
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
38 This module requires DB_File and Storable.
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
39
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
40 =head1 CONTACT
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
41
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
42 Lincoln Stein
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
43
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
44 =head2 Reporting Bugs
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
45
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
46 Report bugs to the Bioperl bug tracking system to help us keep track
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
47 the bugs and their resolution. Bug reports can be submitted via email
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
48 or the web:
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
49
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
50 bioperl-bugs@bio.perl.org
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
51 http://bugzilla.bioperl.org/
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
52
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
53 =head1 APPENDIX
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
54
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
55 The rest of the documentation details each of the object
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
56 methods. Internal methods are usually preceded with a _
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
57
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
58 =cut
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
59
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
60 # Let the code begin...
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
61
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
62 package Bio::DB::FileCache;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
63
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
64 use DB_File;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
65 use Storable qw(freeze thaw);
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
66 use Fcntl qw(O_CREAT O_RDWR O_RDONLY);
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
67 use File::Temp 'tmpnam';
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
68
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
69 use vars qw(@ISA);
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
70 use strict;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
71
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
72 use Bio::Root::Root;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
73
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
74 @ISA = qw(Bio::Root::Root Bio::DB::SeqI);
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
75
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
76 use Bio::DB::SeqI;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
77 use Bio::Seq::RichSeq;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
78 use Bio::Location::Split;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
79 use Bio::Location::Fuzzy;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
80 use Bio::Seq;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
81 use Bio::SeqFeature::Generic;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
82 use Bio::Species;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
83 use Bio::Annotation::Collection;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
84
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
85 =head2 new
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
86
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
87 Title : new
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
88 Usage : $db = Bio::DB::FileCache->new(
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
89 -seqdb => $db, # Bio::DB::RandomAccessI database
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
90 -file => $path, # path to index file
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
91 -keep => $flag, # don't unlink index file
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
92 )
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
93 Function: creates a new on-disk cache
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
94 Returns : a Bio::DB::RandomAccessI database
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
95 Args : as above
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
96 Throws : "Must be a randomaccess database" exception
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
97 "Could not open primary index file" exception
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
98
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
99 If no index file is specified, will create a temporary file in your
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
100 system's temporary file directory. The name of this temporary file
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
101 can be retrieved using file_name().
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
102
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
103 =cut
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
104
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
105 sub new {
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
106 my ($class,@args) = @_;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
107
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
108 my $self = Bio::Root::Root->new();
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
109 bless $self,$class;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
110
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
111 my ($seqdb,$file_name,$keep) = $self->_rearrange([qw(SEQDB FILE KEEP)],@args);
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
112
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
113 if( !defined $seqdb || !ref $seqdb || !$seqdb->isa('Bio::DB::RandomAccessI') ) {
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
114 $self->throw("Must be a randomaccess database not a [$seqdb]");
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
115 }
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
116
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
117 $self->seqdb($seqdb);
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
118 $file_name ||= tmpnam();
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
119 $self->file_name($file_name);
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
120 $self->keep($keep);
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
121
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
122 $self->_open_database($file_name);
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
123 return $self;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
124 }
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
125
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
126 =head2 get_Seq_by_id
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
127
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
128 Title : get_Seq_by_id
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
129 Usage : $seq = $db->get_Seq_by_id('ROA1_HUMAN')
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
130 Function: Gets a Bio::Seq object by its name
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
131 Returns : a Bio::Seq object
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
132 Args : the id (as a string) of a sequence
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
133 Throws : "id does not exist" exception
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
134
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
135
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
136 =cut
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
137
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
138 sub get_Seq_by_id{
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
139 my ($self,$id) = @_;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
140
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
141 # look in the cache first
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
142 my $obj = $self->_get('id' => $id);
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
143 return $obj if defined $obj;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
144
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
145 # get object from seqdb
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
146 $obj = $self->seqdb->get_Seq_by_id($id);
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
147 $self->_store('id' => $id, $obj);
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
148
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
149 return $obj;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
150 }
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
151
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
152 =head2 get_Seq_by_acc
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
153
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
154 Title : get_Seq_by_acc
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
155 Usage : $seq = $db->get_Seq_by_acc('X77802');
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
156 Function: Gets a Bio::Seq object by accession number
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
157 Returns : A Bio::Seq object
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
158 Args : accession number (as a string)
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
159 Throws : "acc does not exist" exception
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
160
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
161
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
162 =cut
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
163
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
164 sub get_Seq_by_acc{
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
165 my ($self,$acc) = @_;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
166
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
167 # look in the cache first
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
168 my $obj = $self->_get('acc' => $acc);
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
169 return $obj if defined $obj;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
170
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
171 # get object from seqdb
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
172 $obj = $self->seqdb->get_Seq_by_acc($acc);
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
173 $self->_store('acc' => $acc, $obj);
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
174
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
175 return $obj;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
176 }
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
177
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
178 =head2 seqdb
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
179
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
180 Title : seqdb
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
181 Usage : $seqdb = $db->seqdb([$seqdb])
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
182 Function: gets/sets the Bio::DB::RandomAccessI database
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
183 Returns : a Bio::DB::RandomAccessI database
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
184 Args : new sequence database (optional)
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
185 Throws : nothing
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
186
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
187 =cut
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
188
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
189 sub seqdb {
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
190 my ($self, $seqdb) = @_;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
191 if ($seqdb) {
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
192 $self->{'seqdb'} = $seqdb;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
193 } else {
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
194 return $self->{'seqdb'};
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
195 }
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
196 }
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
197
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
198 =head2 file_name
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
199
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
200 Title : file_name
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
201 Usage : $path = $db->file_name([$file_name])
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
202 Function: gets/sets the name of the cache file
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
203 Returns : a path
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
204 Args : new cache file name (optional)
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
205 Throws : nothing
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
206
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
207 It probably isn't useful to set the cache file name after you've
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
208 opened it.
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
209
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
210 =cut
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
211
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
212 #'
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
213
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
214 sub file_name {
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
215 my $self = shift;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
216 my $d = $self->{file_name};
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
217 $self->{file_name} = shift if @_;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
218 $d;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
219 }
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
220
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
221 =head2 keep
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
222
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
223 Title : keep
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
224 Usage : $keep = $db->keep([$flag])
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
225 Function: gets/sets the value of the "keep" flag
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
226 Returns : current value
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
227 Args : new value (optional)
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
228 Throws : nothing
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
229
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
230 The keep flag will cause the index file to be unlinked when the
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
231 process exits. Since on some operating systems (Unix, OS/2) the
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
232 unlinking occurs during the new() call immediately after opening the
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
233 file, it probably isn't safe to change this value.
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
234
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
235 =cut
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
236
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
237 sub keep {
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
238 my $self = shift;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
239 my $d = $self->{keep};
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
240 $self->{keep} = shift if @_;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
241 $d;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
242 }
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
243
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
244 =head2 db
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
245
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
246 Title : db
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
247 Usage : $db->db
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
248 Function: returns tied hash to index database
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
249 Returns : a Berkeley DB tied hashref
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
250 Args : none
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
251 Throws : nothing
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
252
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
253 =cut
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
254
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
255 sub db { shift->{db} }
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
256
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
257 =head2 flush
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
258
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
259 Title : flush
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
260 Usage : $db->flush
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
261 Function: flushes the cache
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
262 Returns : nothing
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
263 Args : none
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
264 Throws : nothing
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
265
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
266 =cut
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
267
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
268 sub flush {
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
269 my $db = shift->db or return;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
270 %{$db} = ();
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
271 }
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
272
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
273 sub _get {
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
274 my $self = shift;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
275 my ($type,$id) = @_;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
276 my $serialized = $self->db->{"${type}_${id}"};
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
277 my $obj = thaw($serialized);
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
278 $obj;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
279 }
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
280
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
281 sub _store {
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
282 my $self = shift;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
283 my ($type,$id,$obj) = @_;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
284 my $serialized = freeze($obj);
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
285 $self->db->{"${type}_${id}"} = $serialized;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
286 }
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
287
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
288 =head2 get_Seq_by_version
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
289
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
290 Title : get_Seq_by_version
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
291 Usage : $seq = $db->get_Seq_by_version('X77802.1');
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
292 Function: Gets a Bio::Seq object by sequence version
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
293 Returns : A Bio::Seq object
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
294 Args : accession.version (as a string)
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
295 Throws : "acc.version does not exist" exception
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
296
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
297 =cut
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
298
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
299 sub get_Seq_by_version{
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
300 my ($self,@args) = @_;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
301 $self->throw("Not implemented it");
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
302 }
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
303
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
304 sub DESTROY {
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
305 my $self = shift;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
306 unlink $self->file_name unless $self->keep;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
307 }
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
308
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
309
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
310 sub _open_database {
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
311 my $self = shift;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
312 my $file = shift;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
313 my $flags = O_CREAT|O_RDWR;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
314 my %db;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
315 tie(%db,'DB_File',$file,$flags,0666,$DB_BTREE)
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
316 or $self->throw("Could not open primary index file");
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
317 $self->{db} = \%db;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
318 unlink $file unless $self->keep;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
319 }
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
320
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
321 ## End of Package
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
322
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
323 1;