Commit | Line | Data |
748a9306 |
1 | package SubstrHash; |
2 | use Carp; |
3 | |
4 | sub TIEHASH { |
5 | my $pack = shift; |
6 | my ($klen, $vlen, $tsize) = @_; |
7 | my $rlen = 1 + $klen + $vlen; |
8 | $tsize = findprime($tsize * 1.1); # Allow 10% empty. |
9 | $self = bless ["\0", $klen, $vlen, $tsize, $rlen, 0, -1]; |
10 | $$self[0] x= $rlen * $tsize; |
11 | $self; |
12 | } |
13 | |
14 | sub FETCH { |
15 | local($self,$key) = @_; |
16 | local($klen, $vlen, $tsize, $rlen) = @$self[1..4]; |
17 | &hashkey; |
18 | for (;;) { |
19 | $offset = $hash * $rlen; |
20 | $record = substr($$self[0], $offset, $rlen); |
21 | if (ord($record) == 0) { |
22 | return undef; |
23 | } |
24 | elsif (ord($record) == 1) { |
25 | } |
26 | elsif (substr($record, 1, $klen) eq $key) { |
27 | return substr($record, 1+$klen, $vlen); |
28 | } |
29 | &rehash; |
30 | } |
31 | } |
32 | |
33 | sub STORE { |
34 | local($self,$key,$val) = @_; |
35 | local($klen, $vlen, $tsize, $rlen) = @$self[1..4]; |
36 | croak("Table is full") if $self[5] == $tsize; |
37 | croak(qq/Value "$val" is not $vlen characters long./) |
38 | if length($val) != $vlen; |
39 | my $writeoffset; |
40 | |
41 | &hashkey; |
42 | for (;;) { |
43 | $offset = $hash * $rlen; |
44 | $record = substr($$self[0], $offset, $rlen); |
45 | if (ord($record) == 0) { |
46 | $record = "\2". $key . $val; |
47 | die "panic" unless length($record) == $rlen; |
48 | $writeoffset = $offset unless defined $writeoffset; |
49 | substr($$self[0], $writeoffset, $rlen) = $record; |
50 | ++$$self[5]; |
51 | return; |
52 | } |
53 | elsif (ord($record) == 1) { |
54 | $writeoffset = $offset unless defined $writeoffset; |
55 | } |
56 | elsif (substr($record, 1, $klen) eq $key) { |
57 | $record = "\2". $key . $val; |
58 | die "panic" unless length($record) == $rlen; |
59 | substr($$self[0], $offset, $rlen) = $record; |
60 | return; |
61 | } |
62 | &rehash; |
63 | } |
64 | } |
65 | |
66 | sub DELETE { |
67 | local($self,$key) = @_; |
68 | local($klen, $vlen, $tsize, $rlen) = @$self[1..4]; |
69 | &hashkey; |
70 | for (;;) { |
71 | $offset = $hash * $rlen; |
72 | $record = substr($$self[0], $offset, $rlen); |
73 | if (ord($record) == 0) { |
74 | return undef; |
75 | } |
76 | elsif (ord($record) == 1) { |
77 | } |
78 | elsif (substr($record, 1, $klen) eq $key) { |
79 | substr($$self[0], $offset, 1) = "\1"; |
80 | return substr($record, 1+$klen, $vlen); |
81 | --$$self[5]; |
82 | } |
83 | &rehash; |
84 | } |
85 | } |
86 | |
87 | sub FIRSTKEY { |
88 | local($self) = @_; |
89 | $$self[6] = -1; |
90 | &NEXTKEY; |
91 | } |
92 | |
93 | sub NEXTKEY { |
94 | local($self) = @_; |
95 | local($klen, $vlen, $tsize, $rlen, $entries, $iterix) = @$self[1..6]; |
96 | for (++$iterix; $iterix < $tsize; ++$iterix) { |
97 | next unless substr($$self[0], $iterix * $rlen, 1) eq "\2"; |
98 | $$self[6] = $iterix; |
99 | return substr($$self[0], $iterix * $rlen + 1, $klen); |
100 | } |
101 | $$self[6] = -1; |
102 | undef; |
103 | } |
104 | |
105 | sub hashkey { |
106 | croak(qq/Key "$key" is not $klen characters long.\n/) |
107 | if length($key) != $klen; |
108 | $hash = 2; |
109 | for (unpack('C*', $key)) { |
110 | $hash = $hash * 33 + $_; |
111 | } |
112 | $hash = $hash - int($hash / $tsize) * $tsize |
113 | if $hash >= $tsize; |
114 | $hash = 1 unless $hash; |
115 | $hashbase = $hash; |
116 | } |
117 | |
118 | sub rehash { |
119 | $hash += $hashbase; |
120 | $hash -= $tsize if $hash >= $tsize; |
121 | } |
122 | |
123 | sub findprime { |
124 | use integer; |
125 | |
126 | my $num = shift; |
127 | $num++ unless $num % 2; |
128 | |
129 | $max = int sqrt $num; |
130 | |
131 | NUM: |
132 | for (;; $num += 2) { |
133 | for ($i = 3; $i <= $max; $i += 2) { |
134 | next NUM unless $num % $i; |
135 | } |
136 | return $num; |
137 | } |
138 | } |
139 | |
140 | 1; |