Skip to content

Commit b3883e2

Browse files
JRaspasskhwilliamson
authored andcommitted
Tie::SubstrHash - Add strict & warnings
1 parent 362ab35 commit b3883e2

File tree

1 file changed

+44
-41
lines changed

1 file changed

+44
-41
lines changed

lib/Tie/SubstrHash.pm

Lines changed: 44 additions & 41 deletions
Original file line numberDiff line numberDiff line change
@@ -1,6 +1,4 @@
1-
package Tie::SubstrHash;
2-
3-
our $VERSION = '1.00';
1+
package Tie::SubstrHash 1.01;
42

53
=head1 NAME
64
@@ -39,33 +37,35 @@ The hash does not support exists().
3937
4038
=cut
4139

40+
use strict;
41+
use warnings;
42+
no warnings 'experimental::builtin';
43+
4244
use Carp;
4345

4446
sub TIEHASH {
45-
my $pack = shift;
46-
my ($klen, $vlen, $tsize) = @_;
47+
my ($pack, $klen, $vlen, $tsize) = @_;
4748
my $rlen = 1 + $klen + $vlen;
48-
$tsize = [$tsize,
49-
findgteprime($tsize * 1.1)]; # Allow 10% empty.
50-
local $self = bless ["\0", $klen, $vlen, $tsize, $rlen, 0, -1];
49+
$tsize = [$tsize, findgteprime($tsize * 1.1)]; # Allow 10% empty.
50+
my $self = bless ["\0", $klen, $vlen, $tsize, $rlen, 0, -1];
5151
$self->[0] x= $rlen * $tsize->[1];
5252
$self;
5353
}
5454

5555
sub CLEAR {
56-
local($self) = @_;
56+
my ($self) = @_;
5757
$self->[0] = "\0" x ($self->[4] * $self->[3][1]);
5858
$self->[5] = 0;
5959
$self->[6] = -1;
6060
}
6161

6262
sub FETCH {
63-
local($self,$key) = @_;
64-
local($klen, $vlen, $tsize, $rlen) = @$self[1..4];
65-
&hashkey;
66-
for (;;) {
67-
$offset = $hash * $rlen;
68-
$record = substr($self->[0], $offset, $rlen);
63+
my ($self, $key) = @_;
64+
my (undef, $klen, $vlen, $tsize, $rlen) = @$self;
65+
my $hashbase = my $hash = hashkey($key, $klen, $tsize);
66+
while (1) {
67+
my $offset = $hash * $rlen;
68+
my $record = substr($self->[0], $offset, $rlen);
6969
if (ord($record) == 0) {
7070
return undef;
7171
}
@@ -74,22 +74,22 @@ sub FETCH {
7474
elsif (substr($record, 1, $klen) eq $key) {
7575
return substr($record, 1+$klen, $vlen);
7676
}
77-
&rehash;
77+
$hash = rehash($hash, $hashbase, $tsize);
7878
}
7979
}
8080

8181
sub STORE {
82-
local($self,$key,$val) = @_;
83-
local($klen, $vlen, $tsize, $rlen) = @$self[1..4];
82+
my ($self, $key, $val) = @_;
83+
my (undef, $klen, $vlen, $tsize, $rlen) = @$self;
8484
croak("Table is full ($tsize->[0] elements)") if $self->[5] > $tsize->[0];
8585
croak(qq/Value "$val" is not $vlen characters long/)
8686
if length($val) != $vlen;
8787
my $writeoffset;
8888

89-
&hashkey;
90-
for (;;) {
91-
$offset = $hash * $rlen;
92-
$record = substr($self->[0], $offset, $rlen);
89+
my $hashbase = my $hash = hashkey($key, $klen, $tsize);
90+
while (1) {
91+
my $offset = $hash * $rlen;
92+
my $record = substr($self->[0], $offset, $rlen);
9393
if (ord($record) == 0) {
9494
$record = "\2". $key . $val;
9595
die "panic" unless length($record) == $rlen;
@@ -107,17 +107,17 @@ sub STORE {
107107
substr($self->[0], $offset, $rlen) = $record;
108108
return;
109109
}
110-
&rehash;
110+
$hash = rehash($hash, $hashbase, $tsize);
111111
}
112112
}
113113

114114
sub DELETE {
115-
local($self,$key) = @_;
116-
local($klen, $vlen, $tsize, $rlen) = @$self[1..4];
117-
&hashkey;
118-
for (;;) {
119-
$offset = $hash * $rlen;
120-
$record = substr($self->[0], $offset, $rlen);
115+
my ($self, $key) = @_;
116+
my (undef, $klen, $vlen, $tsize, $rlen) = @$self;
117+
my $hashbase = my $hash = hashkey($key, $klen, $tsize);
118+
while (1) {
119+
my $offset = $hash * $rlen;
120+
my $record = substr($self->[0], $offset, $rlen);
121121
if (ord($record) == 0) {
122122
return undef;
123123
}
@@ -128,19 +128,19 @@ sub DELETE {
128128
return substr($record, 1+$klen, $vlen);
129129
--$self->[5];
130130
}
131-
&rehash;
131+
$hash = rehash($hash, $hashbase, $tsize);
132132
}
133133
}
134134

135135
sub FIRSTKEY {
136-
local($self) = @_;
136+
my ($self) = @_;
137137
$self->[6] = -1;
138-
&NEXTKEY;
138+
goto &NEXTKEY;
139139
}
140140

141141
sub NEXTKEY {
142-
local($self) = @_;
143-
local($klen, $vlen, $tsize, $rlen, $entries, $iterix) = @$self[1..6];
142+
my ($self) = @_;
143+
my (undef, $klen, $vlen, $tsize, $rlen, $entries, $iterix) = @$self;
144144
for (++$iterix; $iterix < $tsize->[1]; ++$iterix) {
145145
next unless substr($self->[0], $iterix * $rlen, 1) eq "\2";
146146
$self->[6] = $iterix;
@@ -155,25 +155,29 @@ sub EXISTS {
155155
}
156156

157157
sub hashkey {
158+
my ($key, $klen, $tsize) = @_;
158159
croak(qq/Key "$key" is not $klen characters long/)
159160
if length($key) != $klen;
160-
$hash = 2;
161+
my $hash = 2;
161162
for (unpack('C*', $key)) {
162163
$hash = $hash * 33 + $_;
163-
&_hashwrap if $hash >= 1e13;
164+
$hash = _hashwrap($hash, $tsize) if $hash >= 1e13;
164165
}
165-
&_hashwrap if $hash >= $tsize->[1];
166+
$hash = _hashwrap($hash, $tsize) if $hash >= $tsize->[1];
166167
$hash ||= 1;
167-
$hashbase = $hash;
168+
return $hash;
168169
}
169170

170171
sub _hashwrap {
171-
$hash -= int($hash / $tsize->[1]) * $tsize->[1];
172+
my ($hash, $tsize) = @_;
173+
return $hash - int($hash / $tsize->[1]) * $tsize->[1];
172174
}
173175

174176
sub rehash {
177+
my ($hash, $hashbase, $tsize) = @_;
175178
$hash += $hashbase;
176179
$hash -= $tsize->[1] if $hash >= $tsize->[1];
180+
return $hash;
177181
}
178182

179183
# See:
@@ -188,7 +192,6 @@ sub findgteprime { # find the smallest prime integer greater than or equal to
188192
return 2 if $num <= 2;
189193

190194
$num++ unless $num % 2;
191-
my $i;
192195
my $sqrtnum = int sqrt $num;
193196
my $sqrtnumsquared = $sqrtnum * $sqrtnum;
194197

@@ -198,7 +201,7 @@ sub findgteprime { # find the smallest prime integer greater than or equal to
198201
$sqrtnum++;
199202
$sqrtnumsquared = $sqrtnum * $sqrtnum;
200203
}
201-
for ($i = 3; $i <= $sqrtnum; $i += 2) {
204+
for (my $i = 3; $i <= $sqrtnum; $i += 2) {
202205
next NUM unless $num % $i;
203206
}
204207
return $num;

0 commit comments

Comments
 (0)