Fixed limitation of transactions to only 32

diff --git a/lib/DBM/Deep/Engine.pm b/lib/DBM/Deep/Engine.pm
index d631851..6792fa0 100644 (file)
--- a/lib/DBM/Deep/Engine.pm
+++ b/lib/DBM/Deep/Engine.pm
@@ -360,12 +360,18 @@ sub begin_work {
     }
 
     my @slots = $self->read_txn_slots;
-    for my $i ( 0 .. @slots ) {
+    my $found;
+    for my $i ( 0 .. $#slots ) {
         next if $slots[$i];
+
         $slots[$i] = 1;
         $self->set_trans_id( $i + 1 );
+        $found = 1;
         last;
     }
+    unless ( $found ) {
+        DBM::Deep->_throw_error( "Cannot allocate transaction ID" );
+    }
     $self->write_txn_slots( @slots );
 
     if ( !$self->trans_id ) {
@@ -459,17 +465,27 @@ sub commit {
 
 sub read_txn_slots {
     my $self = shift;
-    return split '', unpack( 'b32',
+    my $bitfield_len = ($self->num_txns) / 8;
+    if ( $bitfield_len > int( $bitfield_len ) ) {
+        $bitfield_len = int( $bitfield_len ) + 1;
+    }
+    my $num_bits = $bitfield_len * 8;
+    return split '', unpack( 'b'.$num_bits,
         $self->storage->read_at(
-            $self->trans_loc, 4,
+            $self->trans_loc, $bitfield_len,
         )
     );
 }
 
 sub write_txn_slots {
     my $self = shift;
+    my $bitfield_len = ($self->num_txns) / 8;
+    if ( $bitfield_len > int( $bitfield_len ) ) {
+        $bitfield_len = int( $bitfield_len ) + 1;
+    }
+    my $num_bits = $bitfield_len * 8;
     $self->storage->print_at( $self->trans_loc,
-        pack( 'b32', join('', @_) ),
+        pack( 'b'.$num_bits, join('', @_) ),
     );
 }
 
@@ -553,8 +569,12 @@ sub clear_entries {
         my $self = shift;
 
         my $nt = $self->num_txns;
+        my $bitfield_len = ($nt) / 8;
+        if ( $bitfield_len > int( $bitfield_len ) ) {
+            $bitfield_len = int( $bitfield_len ) + 1;
+        }
 
-        my $header_var = 1 + 1 + 1 + 1 + 4 + $STALE_SIZE * ($nt - 1) + 3 * $self->byte_size;
+        my $header_var = 1 + 1 + 1 + 1 + $bitfield_len + $STALE_SIZE * ($nt - 1) + 3 * $self->byte_size;
 
         my $loc = $self->storage->request_space( $header_fixed + $header_var );
 
@@ -571,8 +591,7 @@ sub clear_entries {
             pack('C', $self->data_sector_size - 1),
 
             pack('C', $nt),
-#XXX This is a problem - it limits everything to 32 transactions
-            pack('N', 0 ),                   # Transaction activeness bitfield
+            pack('C' . $bitfield_len, 0 ),                 # Transaction activeness bitfield
             pack($StP{$STALE_SIZE}.($nt-1), 0 x ($nt-1) ), # Transaction staleness counters
             pack($StP{$self->byte_size}, 0), # Start of free chain (blist size)
             pack($StP{$self->byte_size}, 0), # Start of free chain (data size)
@@ -581,7 +600,7 @@ sub clear_entries {
 
         #XXX Set these less fragilely
         $self->set_trans_loc( $header_fixed + 4 );
-        $self->set_chains_loc( $header_fixed + 4 + 4 + $STALE_SIZE * ($nt-1) );
+        $self->set_chains_loc( $header_fixed + 4 + $bitfield_len + $STALE_SIZE * ($nt-1) );
 
         return;
     }
@@ -629,14 +648,19 @@ sub clear_entries {
         $self->{max_buckets} += 1;
         $self->{data_sector_size} += 1;
 
-        my $header_var = scalar(@values) + 4 + $STALE_SIZE * ($self->num_txns - 1) + 3 * $self->byte_size;
+        my $bitfield_len = ($self->num_txns) / 8;
+        if ( $bitfield_len > int( $bitfield_len ) ) {
+            $bitfield_len = int( $bitfield_len ) + 1;
+        }
+
+        my $header_var = scalar(@values) + $bitfield_len + $STALE_SIZE * ($self->num_txns - 1) + 3 * $self->byte_size;
         unless ( $size == $header_var ) {
             $self->storage->close;
             DBM::Deep->_throw_error( "Unexpected size found ($size <-> $header_var)." );
         }
 
         $self->set_trans_loc( $header_fixed + scalar(@values) );
-        $self->set_chains_loc( $header_fixed + scalar(@values) + 4 + $STALE_SIZE * ($self->num_txns - 1) );
+        $self->set_chains_loc( $header_fixed + scalar(@values) + $bitfield_len + $STALE_SIZE * ($self->num_txns - 1) );
 
         return length($buffer) + length($buffer2);
     }
@@ -999,8 +1023,8 @@ sub clone {
     my $self = shift;
     return ref($self)->new({
         engine => $self->engine,
-        data   => $self->data,
         type   => $self->type,
+        data   => $self->data,
     });
 }
 
@@ -1859,6 +1883,7 @@ sub _init {
     return $self;
 }
 
+#XXX Change here
 sub size {
     my $self = shift;
     unless ( $self->{size} ) {

diff --git a/t/43_transaction_maximum.t b/t/43_transaction_maximum.t
index 95aba68..397e6be 100644 (file)
--- a/t/43_transaction_maximum.t
+++ b/t/43_transaction_maximum.t
@@ -33,6 +33,6 @@ for my $n (0 .. $num) {
     } "DB $n can begin_work";
 
     my $trans_id = $dbs[$n]->_engine->trans_id, $/;
-    ok( !exists $trans_ids{ $trans_id }, "DB $n has a unique transaction ID" );
+    ok( !exists $trans_ids{ $trans_id }, "DB $n has a unique transaction ID ($trans_id)" );
     $trans_ids{ $trans_id } = $n;
 }