200 lines
3.6 KiB
Perl
200 lines
3.6 KiB
Perl
#!/usr/local/bin/perl
|
|
|
|
package TiedHash;
|
|
use strict;
|
|
use warnings;
|
|
use DB_File;
|
|
use Carp;
|
|
|
|
=example
|
|
|
|
my $tied_hash = new TiedHash( { create => "$pfam_db.inx" } );
|
|
|
|
|
|
my $acc = "";
|
|
|
|
while (<$fh>) {
|
|
chomp;
|
|
my ($token, $rest) = split (/\s+/, $_, 2);
|
|
if ($token eq 'NAME') {
|
|
$acc = $rest;
|
|
}
|
|
elsif ($token =~ /^(NC|TC|DESC|ACC)$/) {
|
|
my $key = "$acc$;$token";
|
|
$tied_hash->store_key_value($key, $rest);
|
|
print STDERR "storing: $key, $rest\n";
|
|
}
|
|
|
|
|
|
=cut
|
|
|
|
|
|
sub new {
|
|
my $packagename = shift;
|
|
|
|
my $prefs_href = shift;
|
|
|
|
if ($prefs_href && ! ref $prefs_href) {
|
|
confess "Error, need hash reference with opts in constructor.\n";
|
|
}
|
|
|
|
|
|
my $self = {
|
|
index_filename => undef,
|
|
tied_index => {},
|
|
tie_invoked => 0,
|
|
};
|
|
|
|
bless ($self, $packagename);
|
|
|
|
|
|
if (ref $prefs_href eq "HASH") {
|
|
if (my $index_file = $prefs_href->{"create"}) {
|
|
$self->create_index_file($index_file);
|
|
}
|
|
elsif ($index_file = $prefs_href->{"use"}) {
|
|
$self->use_index_file($index_file);
|
|
}
|
|
}
|
|
|
|
|
|
return ($self);
|
|
}
|
|
|
|
####
|
|
sub tie_invoked {
|
|
my $self = shift;
|
|
return ($self->{tie_invoked});
|
|
}
|
|
|
|
|
|
####
|
|
sub DESTROY {
|
|
my $self = shift;
|
|
if ($self->{index_filename}) {
|
|
# hash must have been tied
|
|
# so, untie it
|
|
untie (%{$self->{tied_index}});
|
|
}
|
|
}
|
|
|
|
|
|
####
|
|
sub create_index_file {
|
|
my $self = shift;
|
|
return ($self->make_index_file(@_));
|
|
}
|
|
|
|
|
|
|
|
####
|
|
sub make_index_file {
|
|
my $self = shift;
|
|
my $filename = shift;
|
|
|
|
unless ($filename) {
|
|
confess "need filename as parameter";
|
|
}
|
|
|
|
if (-e $filename) {
|
|
unlink $filename or confess "cannot remove existing index filename $filename";
|
|
}
|
|
|
|
$self->{index_filename} = $filename;
|
|
|
|
tie (%{$self->{tied_index}}, 'DB_File', $filename, O_CREAT|O_RDWR, 0666, $DB_BTREE);
|
|
|
|
$self->{tie_invoked} = 1;
|
|
|
|
return;
|
|
}
|
|
|
|
|
|
####
|
|
sub use_index_file {
|
|
my $self = shift;
|
|
my $filename = shift;
|
|
|
|
unless ($filename) {
|
|
confess "need filename as parameter";
|
|
}
|
|
|
|
unless (-s $filename) {
|
|
confess "Error, cannot locate file: $filename\n";
|
|
}
|
|
|
|
$self->{index_filename} = $filename;
|
|
|
|
tie (%{$self->{tied_index}}, 'DB_File', $filename, O_RDONLY, 0, $DB_BTREE);
|
|
|
|
$self->{tie_invoked} = 1;
|
|
|
|
#my @keys = $self->get_keys();
|
|
#unless (@keys) {
|
|
# confess "Error, tried using $filename db, but couldn't perform retrievals.\n";
|
|
#}
|
|
|
|
return;
|
|
|
|
}
|
|
|
|
|
|
####
|
|
sub store_key_value {
|
|
my ($self, $identifier, $value) = @_;
|
|
|
|
#my $num_keys = scalar ($self->get_keys());
|
|
|
|
unless ($self->tie_invoked()) {
|
|
confess "Error, cannot store key/value pair since tied hash not created.\n";
|
|
}
|
|
|
|
|
|
my $found = 0;
|
|
while (! $found) {
|
|
$self->{tied_index}->{$identifier} = $value;
|
|
|
|
my $val = $self->get_value($identifier);
|
|
if (defined $val) {
|
|
$found = 1;
|
|
}
|
|
else {
|
|
warn "Berkeley DB had trouble storing ($identifier); trying again.\n";
|
|
}
|
|
}
|
|
|
|
return;
|
|
|
|
}
|
|
|
|
|
|
####
|
|
sub get_value {
|
|
my $self = shift;
|
|
my $identifier = shift;
|
|
|
|
|
|
unless ($self->tie_invoked()) {
|
|
confess "Error, cannot retrieve value from untied hash\n";
|
|
}
|
|
|
|
my $value = $self->{tied_index}->{$identifier};
|
|
|
|
return ($value);
|
|
}
|
|
|
|
|
|
##
|
|
sub get_keys {
|
|
my $self = shift;
|
|
|
|
unless ($self->tie_invoked()) {
|
|
confess "Error, cannot retrieve values from untied hash\n";
|
|
}
|
|
|
|
return (keys %{$self->{tied_index}});
|
|
}
|
|
|
|
|
|
1; #EOM
|