package Tie::SubstrHash;
+our $VERSION = '1.00';
+
=head1 NAME
Tie::SubstrHash - Fixed-table-size, fixed-key-length hashing
hashing algorithm, there is no means by which to dynamically change the
value of any of the initialization parameters.
+The hash does not support exists().
+
=cut
use Carp;
my $pack = shift;
my ($klen, $vlen, $tsize) = @_;
my $rlen = 1 + $klen + $vlen;
- $tsize = findprime($tsize * 1.1); # Allow 10% empty.
- $self = bless ["\0", $klen, $vlen, $tsize, $rlen, 0, -1];
- $$self[0] x= $rlen * $tsize;
+ $tsize = [$tsize,
+ findgteprime($tsize * 1.1)]; # Allow 10% empty.
+ local $self = bless ["\0", $klen, $vlen, $tsize, $rlen, 0, -1];
+ $$self[0] x= $rlen * $tsize->[1];
$self;
}
+sub CLEAR {
+ local($self) = @_;
+ $$self[0] = "\0" x ($$self[4] * $$self[3]->[1]);
+ $$self[5] = 0;
+ $$self[6] = -1;
+}
+
sub FETCH {
local($self,$key) = @_;
local($klen, $vlen, $tsize, $rlen) = @$self[1..4];
sub STORE {
local($self,$key,$val) = @_;
local($klen, $vlen, $tsize, $rlen) = @$self[1..4];
- croak("Table is full") if $self[5] == $tsize;
- croak(qq/Value "$val" is not $vlen characters long./)
+ croak("Table is full ($tsize->[0] elements)") if $$self[5] > $tsize->[0];
+ croak(qq/Value "$val" is not $vlen characters long/)
if length($val) != $vlen;
my $writeoffset;
sub NEXTKEY {
local($self) = @_;
local($klen, $vlen, $tsize, $rlen, $entries, $iterix) = @$self[1..6];
- for (++$iterix; $iterix < $tsize; ++$iterix) {
+ for (++$iterix; $iterix < $tsize->[1]; ++$iterix) {
next unless substr($$self[0], $iterix * $rlen, 1) eq "\2";
$$self[6] = $iterix;
return substr($$self[0], $iterix * $rlen + 1, $klen);
undef;
}
+sub EXISTS {
+ croak "Tie::SubstrHash does not support exists()";
+}
+
sub hashkey {
- croak(qq/Key "$key" is not $klen characters long.\n/)
+ croak(qq/Key "$key" is not $klen characters long/)
if length($key) != $klen;
$hash = 2;
for (unpack('C*', $key)) {
$hash = $hash * 33 + $_;
+ &_hashwrap if $hash >= 1e13;
}
- $hash = $hash - int($hash / $tsize) * $tsize
- if $hash >= $tsize;
+ &_hashwrap if $hash >= $tsize->[1];
$hash = 1 unless $hash;
$hashbase = $hash;
}
+sub _hashwrap {
+ $hash -= int($hash / $tsize->[1]) * $tsize->[1];
+}
+
sub rehash {
$hash += $hashbase;
- $hash -= $tsize if $hash >= $tsize;
+ $hash -= $tsize->[1] if $hash >= $tsize->[1];
+}
+
+# using POSIX::ceil() would be too heavy, and not all platforms have it.
+sub ceil {
+ my $num = shift;
+ $num = int($num + 1) unless $num == int $num;
+ return $num;
}
-sub findprime {
+# See:
+#
+# http://www-groups.dcs.st-andrews.ac.uk/~history/HistTopics/Prime_numbers.html
+#
+
+sub findgteprime { # find the smallest prime integer greater than or equal to
use integer;
- my $num = shift;
- $num++ unless $num % 2;
+ my $num = ceil(shift);
+ return 2 if $num <= 2;
- $max = int sqrt $num;
+ $num++ unless $num % 2;
+ my $i;
+ my $sqrtnum = int sqrt $num;
+ my $sqrtnumsquared = $sqrtnum * $sqrtnum;
NUM:
for (;; $num += 2) {
- for ($i = 3; $i <= $max; $i += 2) {
- next NUM unless $num % $i;
+ if ($sqrtnumsquared < $num) {
+ $sqrtnum++;
+ $sqrtnumsquared = $sqrtnum * $sqrtnum;
}
- return $num;
+ for ($i = 3; $i <= $sqrtnum; $i += 2) {
+ next NUM unless $num % $i;
+ }
+ return $num;
}
}