1 package DBM::Deep::Engine::Sector::BucketList;
6 use warnings FATAL => 'all';
8 use base qw( DBM::Deep::Engine::Sector );
13 my $engine = $self->engine;
15 unless ( $self->offset ) {
16 my $leftover = $self->size - $self->base_size;
18 $self->{offset} = $engine->_request_blist_sector( $self->size );
19 $engine->storage->print_at( $self->offset, $engine->SIG_BLIST ); # Sector type
20 # Skip staleness counter
21 $engine->storage->print_at( $self->offset + $self->base_size,
22 chr(0) x $leftover, # Zero-fill the data
26 if ( $self->{key_md5} ) {
35 $self->engine->storage->print_at( $self->offset + $self->base_size,
36 chr(0) x ($self->size - $self->base_size), # Zero-fill the data
42 unless ( $self->{size} ) {
43 my $e = $self->engine;
44 # Base + numbuckets * bucketsize
45 $self->{size} = $self->base_size + $e->max_buckets * $self->bucket_size;
50 sub free_meth { return '_add_free_blist_sector' }
55 my $e = $self->engine;
56 foreach my $bucket ( $self->chopped_up ) {
57 my $rest = $bucket->[-1];
59 # Delete the keysector
60 my $l = unpack( $StP{$e->byte_size}, substr( $rest, $e->hash_size, $e->byte_size ) );
61 my $s = $e->_load_sector( $l ); $s->free if $s;
63 # Delete the HEAD sector
64 $l = unpack( $StP{$e->byte_size},
66 $e->hash_size + $e->byte_size,
70 $s = $e->_load_sector( $l ); $s->free if $s;
72 foreach my $txn ( 0 .. $e->num_txns - 2 ) {
73 my $l = unpack( $StP{$e->byte_size},
75 $e->hash_size + 2 * $e->byte_size + $txn * ($e->byte_size + $STALE_SIZE),
79 my $s = $e->_load_sector( $l ); $s->free if $s;
88 unless ( $self->{bucket_size} ) {
89 my $e = $self->engine;
90 # Key + head (location) + transactions (location + staleness-counter)
91 my $location_size = $e->byte_size + $e->byte_size + ($e->num_txns - 1) * ($e->byte_size + $STALE_SIZE);
92 $self->{bucket_size} = $e->hash_size + $location_size;
94 return $self->{bucket_size};
97 # XXX This is such a poor hack. I need to rethink this code.
101 my $e = $self->engine;
104 foreach my $idx ( 0 .. $e->max_buckets - 1 ) {
105 my $spot = $self->offset + $self->base_size + $idx * $self->bucket_size;
106 my $md5 = $e->storage->read_at( $spot, $e->hash_size );
108 #XXX If we're chopping, why would we ever have the blank_md5?
109 last if $md5 eq $e->blank_md5;
111 my $rest = $e->storage->read_at( undef, $self->bucket_size - $e->hash_size );
112 push @buckets, [ $spot, $md5 . $rest ];
118 sub write_at_next_open {
122 #XXX This is such a hack!
123 $self->{_next_open} = 0 unless exists $self->{_next_open};
125 my $spot = $self->offset + $self->base_size + $self->{_next_open}++ * $self->bucket_size;
126 $self->engine->storage->print_at( $spot, $entry );
133 unless ( exists $self->{found} ) {
136 return $self->{found};
142 $self->{found} = undef;
146 $self->{key_md5} = shift;
149 # If we don't have an MD5, then what are we supposed to do?
150 unless ( exists $self->{key_md5} ) {
151 DBM::Deep->_throw_error( "Cannot find_md5 without a key_md5 set" );
154 my $e = $self->engine;
155 foreach my $idx ( 0 .. $e->max_buckets - 1 ) {
156 my $potential = $e->storage->read_at(
157 $self->offset + $self->base_size + $idx * $self->bucket_size, $e->hash_size,
160 if ( $potential eq $e->blank_md5 ) {
165 if ( $potential eq $self->{key_md5} ) {
179 DBM::Deep->_throw_error( "write_md5: no key" ) unless exists $args->{key};
180 DBM::Deep->_throw_error( "write_md5: no key_md5" ) unless exists $args->{key_md5};
181 DBM::Deep->_throw_error( "write_md5: no value" ) unless exists $args->{value};
183 my $engine = $self->engine;
185 $args->{trans_id} = $engine->trans_id unless exists $args->{trans_id};
187 my $spot = $self->offset + $self->base_size + $self->{idx} * $self->bucket_size;
188 $engine->add_entry( $args->{trans_id}, $spot );
190 unless ($self->{found}) {
191 my $key_sector = DBM::Deep::Engine::Sector::Scalar->new({
193 data => $args->{key},
196 $engine->storage->print_at( $spot,
198 pack( $StP{$engine->byte_size}, $key_sector->offset ),
204 + $engine->byte_size;
206 if ( $args->{trans_id} ) {
207 $loc += $engine->byte_size + ($args->{trans_id} - 1) * ( $engine->byte_size + $STALE_SIZE );
209 $engine->storage->print_at( $loc,
210 pack( $StP{$engine->byte_size}, $args->{value}->offset ),
211 pack( $StP{$STALE_SIZE}, $engine->get_txn_staleness_counter( $args->{trans_id} ) ),
215 $engine->storage->print_at( $loc,
216 pack( $StP{$engine->byte_size}, $args->{value}->offset ),
226 my $engine = $self->engine;
228 $args->{trans_id} = $engine->trans_id unless exists $args->{trans_id};
230 my $spot = $self->offset + $self->base_size + $self->{idx} * $self->bucket_size;
231 $engine->add_entry( $args->{trans_id}, $spot );
235 + $engine->byte_size;
237 if ( $args->{trans_id} ) {
238 $loc += $engine->byte_size + ($args->{trans_id} - 1) * ( $engine->byte_size + $STALE_SIZE );
240 $engine->storage->print_at( $loc,
241 pack( $StP{$engine->byte_size}, 1 ), # 1 is the marker for deleted
242 pack( $StP{$STALE_SIZE}, $engine->get_txn_staleness_counter( $args->{trans_id} ) ),
246 $engine->storage->print_at( $loc,
247 pack( $StP{$engine->byte_size}, 1 ), # 1 is the marker for deleted
256 my $engine = $self->engine;
257 return undef unless $self->{found};
259 # Save the location so that we can free the data
260 my $location = $self->get_data_location_for({
263 my $key_sector = $self->get_key_for;
265 my $spot = $self->offset + $self->base_size + $self->{idx} * $self->bucket_size;
266 $engine->storage->print_at( $spot,
267 $engine->storage->read_at(
268 $spot + $self->bucket_size,
269 $self->bucket_size * ( $engine->max_buckets - $self->{idx} - 1 ),
271 chr(0) x $self->bucket_size,
276 my $data_sector = $self->engine->_load_sector( $location );
277 my $data = $data_sector->data({ export => 1 });
283 sub get_data_location_for {
288 $args->{allow_head} = 0 unless exists $args->{allow_head};
289 $args->{trans_id} = $self->engine->trans_id unless exists $args->{trans_id};
290 $args->{idx} = $self->{idx} unless exists $args->{idx};
292 my $e = $self->engine;
294 my $spot = $self->offset + $self->base_size
295 + $args->{idx} * $self->bucket_size
299 if ( $args->{trans_id} ) {
300 $spot += $e->byte_size + ($args->{trans_id} - 1) * ( $e->byte_size + $STALE_SIZE );
303 my $buffer = $e->storage->read_at(
305 $e->byte_size + $STALE_SIZE,
307 my ($loc, $staleness) = unpack( $StP{$e->byte_size} . ' ' . $StP{$STALE_SIZE}, $buffer );
309 # XXX Merge the two if-clauses below
310 if ( $args->{trans_id} ) {
311 # We have found an entry that is old, so get rid of it
312 if ( $staleness != (my $s = $e->get_txn_staleness_counter( $args->{trans_id} ) ) ) {
313 $e->storage->print_at(
315 pack( $StP{$e->byte_size} . ' ' . $StP{$STALE_SIZE}, (0) x 2 ),
321 # If we're in a transaction and we never wrote to this location, try the
323 if ( $args->{trans_id} && !$loc && $args->{allow_head} ) {
324 return $self->get_data_location_for({
331 return $loc <= 1 ? 0 : $loc;
339 return unless $self->{found};
340 my $location = $self->get_data_location_for({
341 allow_head => $args->{allow_head},
343 return $self->engine->_load_sector( $location );
349 $idx = $self->{idx} unless defined $idx;
351 if ( $idx >= $self->engine->max_buckets ) {
352 DBM::Deep->_throw_error( "get_key_for(): Attempting to retrieve $idx" );
355 my $location = $self->engine->storage->read_at(
356 $self->offset + $self->base_size + $idx * $self->bucket_size + $self->engine->hash_size,
357 $self->engine->byte_size,
359 $location = unpack( $StP{$self->engine->byte_size}, $location );
360 DBM::Deep->_throw_error( "get_key_for: No location?" ) unless $location;
362 return $self->engine->_load_sector( $location );