[Bioperl-guts-l] bioperl-live/Bio/DB/SeqFeature Store.pm, 1.17, 1.18

[Lincoln Stein]

Update of /home/repository/bioperl/bioperl-live/Bio/DB/SeqFeature
In directory dev.open-bio.org:/tmp/cvs-serv4142/Bio/DB/SeqFeature

Modified Files:
	Store.pm 
Log Message:
berkeleydb adaptor is functional; added compress option to reduce database size

Index: Store.pm
===================================================================
RCS file: /home/repository/bioperl/bioperl-live/Bio/DB/SeqFeature/Store.pm,v
retrieving revision 1.17
retrieving revision 1.18
diff -C2 -d -r1.17 -r1.18
*** Store.pm	19 Jun 2006 04:21:37 -0000	1.17
--- Store.pm	21 Jun 2006 03:17:09 -0000	1.18
***************
*** 245,248 ****
--- 245,251 ----
   -cache             Activate LRU caching feature -- size of cache
  
+  -compress          Compresses features before storing them in database
+                     using Compress::Zlib
+ 
  The B<-index_subfeatures> argument, if true, tells the module to
  create indexes for a feature and all its subfeatures (and its
***************
*** 265,268 ****
--- 268,275 ----
  will silently be disabled.
  
+ The B<-compress> argument, if true, will cause the feature data to be
+ compressed before storing it. This will make the database somewhat
+ smaller at the cost of decreasing performance.
+ 
  The new() method of individual adaptors recognize additional
  arguments. The default DBI::mysql adaptor recognizes the following
***************
*** 296,309 ****
  sub new {
    my $self      = shift;
!   my ($adaptor,$serializer,$index_subfeatures,$cache,$args);
    if (@_ == 1) {
      $args = {DSN => shift}
    }
    else {
!     ($adaptor,$serializer,$index_subfeatures,$cache,$args) =
        rearrange(['ADAPTOR',
  		 'SERIALIZER',
  		 'INDEX_SUBFEATURES',
! 		 'CACHE'
  		], at _);
    }
--- 303,317 ----
  sub new {
    my $self      = shift;
!   my ($adaptor,$serializer,$index_subfeatures,$cache,$compress,$args);
    if (@_ == 1) {
      $args = {DSN => shift}
    }
    else {
!     ($adaptor,$serializer,$index_subfeatures,$cache,$compress,$args) =
        rearrange(['ADAPTOR',
  		 'SERIALIZER',
  		 'INDEX_SUBFEATURES',
! 		 'CACHE',
! 		 'COMPRESS',
  		], at _);
    }
***************
*** 316,319 ****
--- 324,328 ----
    $obj->init($args);
    $obj->init_cache($cache) if $cache;
+   $obj->do_compress($compress);
    $obj->serializer($serializer)               if defined $serializer;
    $obj->index_subfeatures($index_subfeatures) if defined $index_subfeatures;
***************
*** 1367,1370 ****
--- 1376,1392 ----
  }
  
+ sub do_compress {
+   my $self = shift;
+   if (@_) {
+     my $do_compress = shift;
+     $self->setting(compress => $do_compress);
+   }
+   my $d    = $self->setting('compress');
+   if ($d) {
+     eval "use Compress::Zlib; 1" or croak $@ unless Compress::Zlib->can('compress');
+   }
+   $d;
+ }
+ 
  =head2 index_subfeatures
  
***************
*** 2067,2070 ****
--- 2089,2093 ----
    my $self = shift;
    my $obj  = shift;
+   return unless defined $obj;
    return if $self->{class_loaded}{ref $obj}++;
    unless ($obj && $obj->can('primary_id')) {
***************
*** 2125,2128 ****
--- 2148,2152 ----
    };
  
+   $data = compress($data) if $self->do_compress;
    return $data;
  }
***************
*** 2179,2182 ****
--- 2203,2209 ----
    my $serializer = $self->serializer;
    my $object;
+ 
+   $obj = uncompress($obj) if $self->do_compress;
+ 
    if ($serializer eq 'Data::Dumper') {
      $object = eval $obj;