1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
|
#!/usr/local/bin/perl
package Gene_obj_indexer;
use strict;
use warnings;
use base qw(TiedHash);
use Gene_obj;
use Storable qw (thaw nfreeze);
use Carp;
####
sub new {
my $packagename = shift;
my $self = $packagename->SUPER::new(@_);
return ($self);
}
####
sub store_gene {
my ($self, $identifier, $gene_obj) = @_;
unless (ref $gene_obj) {
confess "Error, no gene_obj as param";
}
my $blob = nfreeze ($gene_obj);
my $success = 0;
while (! $success) {
$self->store_key_value($identifier, $blob);
eval {
my $gene_obj = $self->get_gene($identifier);
};
if ($@) {
warn "error trying to store gene $identifier using berkeley db. Trying again...\n";
}
else {
# worked.
$success = 1;
}
}
}
####
sub get_gene {
my $self = shift;
my $identifier = shift;
my $blob = $self->get_value($identifier);
unless ($blob) {
confess "Error, no gene obj retrieved based on identifier $identifier";
}
my $gene_obj = thaw($blob);
unless (ref $gene_obj) {
confess "Error retrieving gene_obj based on identifier $identifier. Data retrieved but not thawed properly.\n";
}
return ($gene_obj);
}
1; #EOM
|
