20251125

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