/usr/share/perl5/DBM/Deep/Sector/File/Index.pm is in libdbm-deep-perl 2.0011-1.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 | package DBM::Deep::Sector::File::Index;
use base qw( DBM::Deep::Sector::File );
my $STALE_SIZE = 2;
# Please refer to the pack() documentation for further information
my %StP = (
1 => 'C', # Unsigned char value (no order needed as it's just one byte)
2 => 'n', # Unsigned short in "network" (big-endian) order
4 => 'N', # Unsigned long in "network" (big-endian) order
8 => 'Q', # Usigned quad (no order specified, presumably machine-dependent)
);
sub _init {
my $self = shift;
my $engine = $self->engine;
unless ( $self->offset ) {
my $leftover = $self->size - $self->base_size;
$self->{offset} = $engine->_request_index_sector( $self->size );
$engine->storage->print_at( $self->offset, $engine->SIG_INDEX ); # Sector type
# Skip staleness counter
$engine->storage->print_at( $self->offset + $self->base_size,
chr(0) x $leftover, # Zero-fill the rest
);
}
return $self;
}
#XXX Change here
sub size {
my $self = shift;
unless ( $self->{size} ) {
my $e = $self->engine;
$self->{size} = $self->base_size + $e->byte_size * $e->hash_chars;
}
return $self->{size};
}
sub free_meth { return '_add_free_index_sector' }
sub free {
my $self = shift;
my $e = $self->engine;
for my $i ( 0 .. $e->hash_chars - 1 ) {
my $l = $self->get_entry( $i ) or next;
$e->load_sector( $l )->free;
}
$self->SUPER::free();
}
sub _loc_for {
my $self = shift;
my ($idx) = @_;
return $self->offset + $self->base_size + $idx * $self->engine->byte_size;
}
sub get_entry {
my $self = shift;
my ($idx) = @_;
my $e = $self->engine;
DBM::Deep->_throw_error( "get_entry: Out of range ($idx)" )
if $idx < 0 || $idx >= $e->hash_chars;
return unpack(
$StP{$e->byte_size},
$e->storage->read_at( $self->_loc_for( $idx ), $e->byte_size ),
);
}
sub set_entry {
my $self = shift;
my ($idx, $loc) = @_;
my $e = $self->engine;
DBM::Deep->_throw_error( "set_entry: Out of range ($idx)" )
if $idx < 0 || $idx >= $e->hash_chars;
$self->engine->storage->print_at(
$self->_loc_for( $idx ),
pack( $StP{$e->byte_size}, $loc ),
);
}
1;
__END__
|