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
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
|
#define PERL_NO_GET_CONTEXT
#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"
MODULE = Hash::Util PACKAGE = Hash::Util
void
all_keys(hash,keys,placeholder)
HV *hash
AV *keys
AV *placeholder
PROTOTYPE: \%\@\@
PREINIT:
SV *key;
HE *he;
PPCODE:
av_clear(keys);
av_clear(placeholder);
(void)hv_iterinit(hash);
while((he = hv_iternext_flags(hash, HV_ITERNEXT_WANTPLACEHOLDERS))!= NULL) {
key=hv_iterkeysv(he);
av_push(HeVAL(he) == &PL_sv_placeholder ? placeholder : keys,
SvREFCNT_inc(key));
}
XSRETURN(1);
void
hidden_ref_keys(hash)
HV *hash
ALIAS:
Hash::Util::legal_ref_keys = 1
PREINIT:
SV *key;
HE *he;
PPCODE:
(void)hv_iterinit(hash);
while((he = hv_iternext_flags(hash, HV_ITERNEXT_WANTPLACEHOLDERS))!= NULL) {
key=hv_iterkeysv(he);
if (ix || HeVAL(he) == &PL_sv_placeholder) {
XPUSHs( key );
}
}
void
hv_store(hash, key, val)
HV *hash
SV* key
SV* val
PROTOTYPE: \%$$
CODE:
{
SvREFCNT_inc(val);
if (!hv_store_ent(hash, key, val, 0)) {
SvREFCNT_dec(val);
XSRETURN_NO;
} else {
XSRETURN_YES;
}
}
void
hash_seed()
PROTOTYPE:
PPCODE:
mXPUSHs(newSVpvn((char *)PERL_HASH_SEED,PERL_HASH_SEED_BYTES));
XSRETURN(1);
void
hash_value(string)
SV* string
PROTOTYPE: $
PPCODE:
STRLEN len;
char *pv;
UV uv;
pv= SvPV(string,len);
PERL_HASH(uv,pv,len);
XSRETURN_UV(uv);
void
hash_traversal_mask(rhv, ...)
SV* rhv
PPCODE:
{
#ifdef PERL_HASH_RANDOMIZE_KEYS
if (SvROK(rhv) && SvTYPE(SvRV(rhv))==SVt_PVHV && !SvMAGICAL(SvRV(rhv))) {
HV *hv = (HV *)SvRV(rhv);
if (items>1) {
hv_rand_set(hv, SvUV(ST(1)));
}
if (SvOOK(hv)) {
XSRETURN_UV(HvRAND_get(hv));
} else {
XSRETURN_UNDEF;
}
}
#else
Perl_croak(aTHX_ "Perl has not been compiled with support for randomized hash key traversal");
#endif
}
void
bucket_info(rhv)
SV* rhv
PPCODE:
{
/*
Takes a non-magical hash ref as an argument and returns a list of
statistics about the hash. The number and keys and the size of the
array will always be reported as the first two values. If the array is
actually allocated (they are lazily allocated), then additionally
will return a list of counts of bucket lengths. In other words in
($keys, $buckets, $used, @length_count)= hash::bucket_info(\%hash);
$length_count[0] is the number of empty buckets, and $length_count[1]
is the number of buckets with only one key in it, $buckets - $length_count[0]
gives the number of used buckets, and @length_count-1 is the maximum
bucket depth.
If the argument is not a hash ref, or if it is magical, then returns
nothing (the empty list).
*/
if (SvROK(rhv) && SvTYPE(SvRV(rhv))==SVt_PVHV && !SvMAGICAL(SvRV(rhv))) {
const HV * const hv = (const HV *) SvRV(rhv);
U32 max_bucket_index= HvMAX(hv);
U32 total_keys= HvUSEDKEYS(hv);
HE **bucket_array= HvARRAY(hv);
mXPUSHi(total_keys);
mXPUSHi(max_bucket_index+1);
mXPUSHi(0); /* for the number of used buckets */
#define BUCKET_INFO_ITEMS_ON_STACK 3
if (!bucket_array) {
XSRETURN(BUCKET_INFO_ITEMS_ON_STACK);
} else {
/* we use chain_length to index the stack - we eliminate an add
* by initializing things with the number of items already on the stack.
* If we have 2 items then ST(2+0) (the third stack item) will be the counter
* for empty chains, ST(2+1) will be for chains with one element, etc.
*/
I32 max_chain_length= BUCKET_INFO_ITEMS_ON_STACK - 1; /* so we do not have to do an extra push for the 0 index */
HE *he;
U32 bucket_index;
for ( bucket_index= 0; bucket_index <= max_bucket_index; bucket_index++ ) {
I32 chain_length= BUCKET_INFO_ITEMS_ON_STACK;
for (he= bucket_array[bucket_index]; he; he= HeNEXT(he) ) {
chain_length++;
}
while ( max_chain_length < chain_length ) {
mXPUSHi(0);
max_chain_length++;
}
SvIVX( ST( chain_length ) )++;
}
/* now set the number of used buckets */
SvIVX( ST( BUCKET_INFO_ITEMS_ON_STACK - 1 ) ) = max_bucket_index - SvIVX( ST( BUCKET_INFO_ITEMS_ON_STACK ) ) + 1;
XSRETURN( max_chain_length + 1 ); /* max_chain_length is the index of the last item on the stack, so we add 1 */
}
#undef BUCKET_INFO_ITEMS_ON_STACK
}
XSRETURN(0);
}
void
bucket_array(rhv)
SV* rhv
PPCODE:
{
/* Returns an array of arrays representing key/bucket mappings.
* Each element of the array contains either an integer or a reference
* to an array of keys. A plain integer represents K empty buckets. An
* array ref represents a single bucket, with each element being a key in
* the hash. (Note this treats a placeholder as a normal key.)
*
* This allows one to "see" the keyorder. Note the "insert first" nature
* of the hash store, combined with regular remappings means that relative
* order of keys changes each remap.
*/
if (SvROK(rhv) && SvTYPE(SvRV(rhv))==SVt_PVHV && !SvMAGICAL(SvRV(rhv))) {
const HV * const hv = (const HV *) SvRV(rhv);
HE **he_ptr= HvARRAY(hv);
if (!he_ptr) {
XSRETURN(0);
} else {
U32 i, max;
AV *info_av;
HE *he;
I32 empty_count=0;
if (SvMAGICAL(hv)) {
Perl_croak(aTHX_ "hash::bucket_array only works on 'normal' hashes");
}
info_av= newAV();
max= HvMAX(hv);
mXPUSHs(newRV_noinc((SV*)info_av));
for ( i= 0; i <= max; i++ ) {
AV *key_av= NULL;
for (he= he_ptr[i]; he; he= HeNEXT(he) ) {
SV *key_sv;
char *str;
STRLEN len;
char mode;
if (!key_av) {
key_av= newAV();
if (empty_count) {
av_push(info_av, newSViv(empty_count));
empty_count= 0;
}
av_push(info_av, (SV *)newRV_noinc((SV *)key_av));
}
if (HeKLEN(he) == HEf_SVKEY) {
SV *sv= HeSVKEY(he);
SvGETMAGIC(sv);
str= SvPV(sv, len);
mode= SvUTF8(sv) ? 1 : 0;
} else {
str= HeKEY(he);
len= HeKLEN(he);
mode= HeKUTF8(he) ? 1 : 0;
}
key_sv= newSVpvn(str,len);
av_push(key_av,key_sv);
if (mode) {
SvUTF8_on(key_sv);
}
}
if (!key_av)
empty_count++;
}
if (empty_count) {
av_push(info_av, newSViv(empty_count));
empty_count++;
}
}
XSRETURN(1);
}
XSRETURN(0);
}
|
