1 package DBM::Deep::Engine::Sector::BucketList;
6 use warnings FATAL => 'all';
8 use DBM::Deep::Engine::Sector;
9 our @ISA = qw( DBM::Deep::Engine::Sector );
14 my $engine = $self->engine;
16 unless ( $self->offset ) {
17 $self->{offset} = $engine->_request_blist_sector( $self->size );
19 $self->write( 0, $engine->SIG_BLIST );
22 if ( $self->{key_md5} ) {
33 $self->write( $self->base_size, chr(0) x ($self->size - $self->base_size) );
39 unless ( $self->{size} ) {
40 # Base + numbuckets * bucketsize
41 $self->{size} = $self->base_size + $self->engine->max_buckets * $self->bucket_size;
47 return $self->base_size($e) + $e->max_buckets * $self->bucket_size($e);
51 sub free_meth { return '_add_free_blist_sector' }
56 my $e = $self->engine;
57 foreach my $bucket ( $self->chopped_up ) {
58 my $rest = $bucket->[-1];
60 # Delete the keysector
61 my $l = unpack( $e->StP($e->byte_size), substr( $rest, $e->hash_size, $e->byte_size ) );
62 my $s = $e->_load_sector( $l ); $s->free if $s;
64 # Delete the HEAD sector
65 $l = unpack( $e->StP($e->byte_size),
67 $e->hash_size + $e->byte_size,
71 $s = $e->_load_sector( $l ); $s->free if $s;
73 foreach my $txn ( 0 .. $e->num_txns - 2 ) {
74 my $l = unpack( $e->StP($e->byte_size),
76 $e->hash_size + 2 * $e->byte_size + $txn * ($e->byte_size + $DBM::Deep::Engine::STALE_SIZE),
80 my $s = $e->_load_sector( $l ); $s->free if $s;
90 unless ( $self->{bucket_size} ) {
91 my $e = $self->engine;
92 # Key + head (location) + transactions (location + staleness-counter)
93 my $location_size = $e->byte_size + $e->byte_size + ($e->num_txns - 1) * ($e->byte_size + $DBM::Deep::Engine::STALE_SIZE);
94 $self->{bucket_size} = $e->hash_size + $location_size;
96 return $self->{bucket_size};
100 my $location_size = $e->byte_size + $e->byte_size + ($e->num_txns - 1) * ($e->byte_size + $DBM::Deep::Engine::STALE_SIZE);
101 return $e->hash_size + $location_size;
105 # XXX This is such a poor hack. I need to rethink this code.
109 my $e = $self->engine;
112 foreach my $idx ( 0 .. $e->max_buckets - 1 ) {
113 my $spot = $self->base_size + $idx * $self->bucket_size;
114 my $data = $self->read( $spot, $self->bucket_size );
116 # _dump_file() will run into the blank_md5. Otherwise, we should never run into it.
118 last if substr( $data, 0, $e->hash_size ) eq $e->blank_md5;
120 push @buckets, [ $spot, $data ];
126 #XXX Call this append() instead? -RobK, 2008-06-30
127 sub write_at_next_open {
131 #XXX This is such a hack!
132 $self->{_next_open} = 0 unless exists $self->{_next_open};
134 my $spot = $self->base_size + $self->{_next_open}++ * $self->bucket_size;
135 $self->write( $spot, $entry );
137 return ($self->{_next_open} - 1);
142 unless ( exists $self->{found} ) {
145 return $self->{found};
151 $self->{found} = undef;
155 $self->{key_md5} = shift;
158 # If we don't have an MD5, then what are we supposed to do?
159 unless ( exists $self->{key_md5} ) {
160 DBM::Deep->_throw_error( "Cannot find_md5 without a key_md5 set" );
163 my $e = $self->engine;
164 foreach my $idx ( 0 .. $e->max_buckets - 1 ) {
165 my $potential = $self->read(
166 $self->base_size + $idx * $self->bucket_size, $e->hash_size,
169 if ( $potential eq $e->blank_md5 ) {
174 if ( $potential eq $self->{key_md5} ) {
188 DBM::Deep->_throw_error( "write_md5: no key" ) unless exists $args->{key};
189 DBM::Deep->_throw_error( "write_md5: no key_md5" ) unless exists $args->{key_md5};
190 DBM::Deep->_throw_error( "write_md5: no value" ) unless exists $args->{value};
192 my $e = $self->engine;
194 $args->{trans_id} = $e->trans_id unless exists $args->{trans_id};
196 my $spot = $self->base_size + $self->{idx} * $self->bucket_size;
197 $e->add_entry( $args->{trans_id}, $self->offset, $self->{idx} );
199 unless ($self->{found}) {
200 my $key_sector = DBM::Deep::Engine::Sector::Scalar->new({
202 data => $args->{key},
205 $self->write( $spot, $args->{key_md5} . pack( $e->StP($e->byte_size), $key_sector->offset ) );
208 my $loc = $spot + $e->hash_size + $e->byte_size;
210 if ( $args->{trans_id} ) {
211 $loc += $e->byte_size + ($args->{trans_id} - 1) * ( $e->byte_size + $DBM::Deep::Engine::STALE_SIZE );
214 pack( $e->StP($e->byte_size), $args->{value}->offset )
215 . pack( $e->StP($DBM::Deep::Engine::STALE_SIZE), $e->get_txn_staleness_counter( $args->{trans_id} ) ),
219 $self->write( $loc, pack( $e->StP($e->byte_size), $args->{value}->offset ) );
228 my $e = $self->engine;
230 $args->{trans_id} = $e->trans_id unless exists $args->{trans_id};
232 my $spot = $self->base_size + $self->{idx} * $self->bucket_size;
233 $e->add_entry( $args->{trans_id}, $self->offset, $self->{idx} );
239 if ( $args->{trans_id} ) {
240 $loc += $e->byte_size + ($args->{trans_id} - 1) * ( $e->byte_size + $DBM::Deep::Engine::STALE_SIZE );
243 pack( $e->StP($e->byte_size), 1 ) # 1 is the marker for deleted
244 . pack( $e->StP($DBM::Deep::Engine::STALE_SIZE), $e->get_txn_staleness_counter( $args->{trans_id} ) ),
248 # 1 is the marker for deleted
249 $self->write( $loc, pack( $e->StP($e->byte_size), 1 ) );
257 my $engine = $self->engine;
258 return undef unless $self->{found};
260 # Save the location so that we can free the data
261 my $location = $self->get_data_location_for({
264 my $key_sector = $self->get_key_for;
266 my $spot = $self->base_size + $self->{idx} * $self->bucket_size;
268 # Shuffle everything down to cover the deleted bucket's spot.
271 $spot + $self->bucket_size,
272 $self->bucket_size * ( $engine->max_buckets - $self->{idx} - 1 ),
274 . chr(0) x $self->bucket_size,
279 my $data_sector = $self->engine->_load_sector( $location );
280 my $data = $data_sector->data({ export => 1 });
286 sub get_data_location_for {
291 $args->{allow_head} = 0 unless exists $args->{allow_head};
292 $args->{trans_id} = $self->engine->trans_id unless exists $args->{trans_id};
293 $args->{idx} = $self->{idx} unless exists $args->{idx};
295 my $e = $self->engine;
297 my $spot = $self->base_size
298 + $args->{idx} * $self->bucket_size
302 if ( $args->{trans_id} ) {
303 $spot += $e->byte_size + ($args->{trans_id} - 1) * ( $e->byte_size + $DBM::Deep::Engine::STALE_SIZE );
306 my $buffer = $self->read( $spot, $e->byte_size + $DBM::Deep::Engine::STALE_SIZE );
307 my ($loc, $staleness) = unpack(
308 $e->StP($e->byte_size) . ' ' . $e->StP($DBM::Deep::Engine::STALE_SIZE),
312 # XXX Merge the two if-clauses below
313 if ( $args->{trans_id} ) {
314 # We have found an entry that is old, so get rid of it
315 if ( $staleness != (my $s = $e->get_txn_staleness_counter( $args->{trans_id} ) ) ) {
316 $e->storage->print_at(
318 pack( $e->StP($e->byte_size) . ' ' . $e->StP($DBM::Deep::Engine::STALE_SIZE), (0) x 2 ),
324 # If we're in a transaction and we never wrote to this location, try the
326 if ( $args->{trans_id} && !$loc && $args->{allow_head} ) {
327 return $self->get_data_location_for({
334 return $loc <= 1 ? 0 : $loc;
342 return unless $self->{found};
343 my $location = $self->get_data_location_for({
344 allow_head => $args->{allow_head},
346 return $self->engine->_load_sector( $location );
352 $idx = $self->{idx} unless defined $idx;
354 if ( $idx >= $self->engine->max_buckets ) {
355 DBM::Deep->_throw_error( "get_key_for(): Attempting to retrieve $idx beyond max_buckets" );
358 my $location = $self->read(
359 $self->base_size + $idx * $self->bucket_size + $self->engine->hash_size,
360 $self->engine->byte_size,
362 $location = unpack( $self->engine->StP($self->engine->byte_size), $location );
363 DBM::Deep->_throw_error( "get_key_for: No location?" ) unless $location;
365 return $self->engine->_load_sector( $location );
371 my $e = $self->engine;
372 my $trans_id = $e->trans_id;
374 # warn "Rolling back $idx ($trans_id)\n";
376 my $base = $self->base_size + ($idx * $self->bucket_size) + $e->hash_size + $e->byte_size;
377 my $spot = $base + $e->byte_size + ($trans_id - 1) * ( $e->byte_size + $DBM::Deep::Engine::STALE_SIZE );
379 my $trans_loc = $self->read( $spot, $e->byte_size );
380 $trans_loc = unpack( $e->StP($e->byte_size), $trans_loc );
381 # warn "$trans_loc\n";
383 $self->write( $spot, pack( $e->StP($e->byte_size), 0 ) );
385 if ( $trans_loc > 1 ) {
386 $e->_load_sector( $trans_loc )->free;
395 my $e = $self->engine;
396 my $trans_id = $e->trans_id;
398 my $base = $self->base_size + ($idx * $self->bucket_size) + $e->hash_size + $e->byte_size;
400 my $head_loc = $self->read( $base, $e->byte_size );
401 $head_loc = unpack( $e->StP($e->byte_size), $head_loc );
403 my $spot = $base + $e->byte_size + ($trans_id - 1) * ( $e->byte_size + $DBM::Deep::Engine::STALE_SIZE );
404 my $trans_loc = $self->read( $spot, $e->byte_size );
406 $self->write( $base, $trans_loc );
407 $self->write( $spot, pack( $e->StP($e->byte_size) . ' ' . $e->StP($DBM::Deep::Engine::STALE_SIZE), (0) x 2 ) );
409 if ( $head_loc > 1 ) {
410 $e->_load_sector( $head_loc )->free;