remove index offsetting ($[)

[perl5.git] / lib / Tie / SubstrHash.pm

diff --git a/lib/Tie/SubstrHash.pm b/lib/Tie/SubstrHash.pm
index 44c2140..476dd68 100644 (file)
--- a/lib/Tie/SubstrHash.pm
+++ b/lib/Tie/SubstrHash.pm
@@ -1,5 +1,7 @@
 package Tie::SubstrHash;
 
+our $VERSION = '1.00';
+
 =head1 NAME
 
 Tie::SubstrHash - Fixed-table-size, fixed-key-length hashing
@@ -33,6 +35,8 @@ Because the current implementation uses the table and key sizes for the
 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;
@@ -41,12 +45,20 @@ sub TIEHASH {
     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];
@@ -69,8 +81,8 @@ sub FETCH {
 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;
 
@@ -129,7 +141,7 @@ sub FIRSTKEY {
 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);
@@ -138,42 +150,65 @@ sub NEXTKEY {
     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;
     }
-    &_hashwrap if $hash >= $tsize;
+    &_hashwrap if $hash >= $tsize->[1];
     $hash = 1 unless $hash;
     $hashbase = $hash;
 }
 
 sub _hashwrap {
-    $hash -= int($hash / $tsize) * $tsize;
+    $hash -= int($hash / $tsize->[1]) * $tsize->[1];
 }
 
 sub rehash {
     $hash += $hashbase;
-    $hash -= $tsize if $hash >= $tsize;
+    $hash -= $tsize->[1] if $hash >= $tsize->[1];
 }
 
-sub findprime {
+# 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;
+}
+
+# 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;
     }
 }