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