view release on metacpan or  search on metacpan

utils/lib/DBM/Deep/10002.pm  view on Meta::CPAN

    }

    # Read the new head after the signature and the staleness counter
    my $new_head = $self->storage->read_at( $loc + SIG_SIZE + $STALE_SIZE, $self->byte_size );
    $self->storage->print_at( $self->chains_loc + $chains_offset, $new_head );
    $self->storage->print_at(
        $loc + SIG_SIZE + $STALE_SIZE,
        pack( $StP{$self->byte_size}, 0 ),
    );

    return $loc;
}

################################################################################

sub storage     { $_[0]{storage} }
sub byte_size   { $_[0]{byte_size} }
sub hash_size   { $_[0]{hash_size} }
sub hash_chars  { $_[0]{hash_chars} }
sub num_txns    { $_[0]{num_txns} }
sub max_buckets { $_[0]{max_buckets} }
sub blank_md5   { chr(0) x $_[0]->hash_size }
sub data_sector_size { $_[0]{data_sector_size} }

# This is a calculated value
sub txn_bitfield_len {
    my $self = shift;
    unless ( exists $self->{txn_bitfield_len} ) {
        my $temp = ($self->num_txns) / 8;
        if ( $temp > int( $temp ) ) {
            $temp = int( $temp ) + 1;
        }
        $self->{txn_bitfield_len} = $temp;
    }
    return $self->{txn_bitfield_len};
}

sub trans_id     { $_[0]{trans_id} }
sub set_trans_id { $_[0]{trans_id} = $_[1] }

sub trans_loc     { $_[0]{trans_loc} }
sub set_trans_loc { $_[0]{trans_loc} = $_[1] }

sub chains_loc     { $_[0]{chains_loc} }
sub set_chains_loc { $_[0]{chains_loc} = $_[1] }

################################################################################

package DBM::Deep::10002::Iterator;

sub new {
    my $class = shift;
    my ($args) = @_;

    my $self = bless {
        breadcrumbs => [],
        engine      => $args->{engine},
        base_offset => $args->{base_offset},
    }, $class;

    Scalar::Util::weaken( $self->{engine} );

    return $self;
}

sub reset { $_[0]{breadcrumbs} = [] }

sub get_sector_iterator {
    my $self = shift;
    my ($loc) = @_;

    my $sector = $self->{engine}->_load_sector( $loc )
        or return;

    if ( $sector->isa( 'DBM::Deep::10002::Engine::Sector::Index' ) ) {
        return DBM::Deep::10002::Iterator::Index->new({
            iterator => $self,
            sector   => $sector,
        });
    }
    elsif ( $sector->isa( 'DBM::Deep::10002::Engine::Sector::BucketList' ) ) {
        return DBM::Deep::10002::Iterator::BucketList->new({
            iterator => $self,
            sector   => $sector,
        });
    }

    DBM::Deep::10002->_throw_error( "get_sector_iterator(): Why did $loc make a $sector?" );
}

sub get_next_key {
    my $self = shift;
    my ($obj) = @_;

    my $crumbs = $self->{breadcrumbs};
    my $e = $self->{engine};

    unless ( @$crumbs ) {
        # This will be a Reference sector
        my $sector = $e->_load_sector( $self->{base_offset} )
            # If no sector is found, thist must have been deleted from under us.
            or return;

        if ( $sector->staleness != $obj->_staleness ) {
            return;
        }

        my $loc = $sector->get_blist_loc
            or return;

        push @$crumbs, $self->get_sector_iterator( $loc );
    }

    FIND_NEXT_KEY: {
        # We're at the end.
        unless ( @$crumbs ) {
            $self->reset;
            return;
        }

        my $iterator = $crumbs->[-1];

utils/lib/DBM/Deep/10002.pm  view on Meta::CPAN

}

package DBM::Deep::10002::Iterator::Index;

sub new {
    my $self = bless $_[1] => $_[0];
    $self->{curr_index} = 0;
    return $self;
}

sub at_end {
    my $self = shift;
    return $self->{curr_index} >= $self->{iterator}{engine}->hash_chars;
}

sub get_next_iterator {
    my $self = shift;

    my $loc;
    while ( !$loc ) {
        return if $self->at_end;
        $loc = $self->{sector}->get_entry( $self->{curr_index}++ );
    }

    return $self->{iterator}->get_sector_iterator( $loc );
}

package DBM::Deep::10002::Iterator::BucketList;

sub new {
    my $self = bless $_[1] => $_[0];
    $self->{curr_index} = 0;
    return $self;
}

sub at_end {
    my $self = shift;
    return $self->{curr_index} >= $self->{iterator}{engine}->max_buckets;
}

sub get_next_key {
    my $self = shift;

    return if $self->at_end;

    my $idx = $self->{curr_index}++;

    my $data_loc = $self->{sector}->get_data_location_for({
        allow_head => 1,
        idx        => $idx,
    }) or return;

    #XXX Do we want to add corruption checks here?
    return $self->{sector}->get_key_for( $idx )->data;
}

package DBM::Deep::10002::Engine::Sector;

sub new {
    my $self = bless $_[1], $_[0];
    Scalar::Util::weaken( $self->{engine} );
    $self->_init;
    return $self;
}

#sub _init {}
#sub clone { DBM::Deep::10002->_throw_error( "Must be implemented in the child class" ); }

sub engine { $_[0]{engine} }
sub offset { $_[0]{offset} }
sub type   { $_[0]{type} }

sub base_size {
   my $self = shift;
   return $self->engine->SIG_SIZE + $STALE_SIZE;
}

sub free {
    my $self = shift;

    my $e = $self->engine;

    $e->storage->print_at( $self->offset, $e->SIG_FREE );
    # Skip staleness counter
    $e->storage->print_at( $self->offset + $self->base_size,
        chr(0) x ($self->size - $self->base_size),
    );

    my $free_meth = $self->free_meth;
    $e->$free_meth( $self->offset, $self->size );

    return;
}

package DBM::Deep::10002::Engine::Sector::Data;

our @ISA = qw( DBM::Deep::10002::Engine::Sector );

# This is in bytes
sub size { $_[0]{engine}->data_sector_size }
sub free_meth { return '_add_free_data_sector' }

sub clone {
    my $self = shift;
    return ref($self)->new({
        engine => $self->engine,
        type   => $self->type,
        data   => $self->data,
    });
}

package DBM::Deep::10002::Engine::Sector::Scalar;

our @ISA = qw( DBM::Deep::10002::Engine::Sector::Data );

sub free {
    my $self = shift;

    my $chain_loc = $self->chain_loc;

    $self->SUPER::free();