20251125

2025-11-25 00:28:51 +08:00
commit eb3f16c30e
406 changed files with 91653 additions and 0 deletions
@@ -0,0 +1,199 @@
+#!/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