1 #define PERL_NO_GET_CONTEXT
7 MODULE = Hash::Util PACKAGE = Hash::Util
10 all_keys(hash,keys,placeholder)
20 av_clear(placeholder);
22 (void)hv_iterinit(hash);
23 while((he = hv_iternext_flags(hash, HV_ITERNEXT_WANTPLACEHOLDERS))!= NULL) {
25 av_push(HeVAL(he) == &PL_sv_placeholder ? placeholder : keys,
34 Hash::Util::legal_ref_keys = 1
39 (void)hv_iterinit(hash);
40 while((he = hv_iternext_flags(hash, HV_ITERNEXT_WANTPLACEHOLDERS))!= NULL) {
42 if (ix || HeVAL(he) == &PL_sv_placeholder) {
48 hv_store(hash, key, val)
56 if (!hv_store_ent(hash, key, val, 0)) {
68 mXPUSHs(newSVpvn((char *)PERL_HASH_SEED,PERL_HASH_SEED_BYTES));
73 hash_value(string,...)
80 char *pv= SvPV(string,len);
82 PERL_HASH(uv, pv, len);
85 U8 *seedbuf= (U8 *)SvPV(ST(1),seedlen);
86 if ( seedlen < PERL_HASH_SEED_BYTES ) {
88 Perl_croak(aTHX_ "seed len must be at least %d long only got %"UVuf" bytes", PERL_HASH_SEED_BYTES, (UV)seedlen);
91 PERL_HASH_WITH_SEED(seedbuf, uv, pv, len);
97 hash_traversal_mask(rhv, ...)
101 #ifdef PERL_HASH_RANDOMIZE_KEYS
102 if (SvROK(rhv) && SvTYPE(SvRV(rhv))==SVt_PVHV && !SvMAGICAL(SvRV(rhv))) {
103 HV *hv = (HV *)SvRV(rhv);
105 hv_rand_set(hv, SvUV(ST(1)));
108 XSRETURN_UV(HvRAND_get(hv));
114 Perl_croak(aTHX_ "Perl has not been compiled with support for randomized hash key traversal");
125 Takes a non-magical hash ref as an argument and returns a list of
126 statistics about the hash. The number and keys and the size of the
127 array will always be reported as the first two values. If the array is
128 actually allocated (they are lazily allocated), then additionally
129 will return a list of counts of bucket lengths. In other words in
131 ($keys, $buckets, $used, @length_count)= hash::bucket_info(\%hash);
133 $length_count[0] is the number of empty buckets, and $length_count[1]
134 is the number of buckets with only one key in it, $buckets - $length_count[0]
135 gives the number of used buckets, and @length_count-1 is the maximum
138 If the argument is not a hash ref, or if it is magical, then returns
139 nothing (the empty list).
142 const HV * hv = NULL;
143 if (SvROK(rhv) && SvTYPE(SvRV(rhv))==SVt_PVHV && !SvMAGICAL(SvRV(rhv))) {
144 hv = (const HV *) SvRV(rhv);
145 } else if (!SvOK(rhv)) {
149 U32 max_bucket_index= HvMAX(hv);
150 U32 total_keys= HvUSEDKEYS(hv);
151 HE **bucket_array= HvARRAY(hv);
153 mXPUSHi(max_bucket_index+1);
154 mXPUSHi(0); /* for the number of used buckets */
155 #define BUCKET_INFO_ITEMS_ON_STACK 3
157 XSRETURN(BUCKET_INFO_ITEMS_ON_STACK);
159 /* we use chain_length to index the stack - we eliminate an add
160 * by initializing things with the number of items already on the stack.
161 * If we have 2 items then ST(2+0) (the third stack item) will be the counter
162 * for empty chains, ST(2+1) will be for chains with one element, etc.
164 I32 max_chain_length= BUCKET_INFO_ITEMS_ON_STACK - 1; /* so we do not have to do an extra push for the 0 index */
167 for ( bucket_index= 0; bucket_index <= max_bucket_index; bucket_index++ ) {
168 I32 chain_length= BUCKET_INFO_ITEMS_ON_STACK;
169 for (he= bucket_array[bucket_index]; he; he= HeNEXT(he) ) {
172 while ( max_chain_length < chain_length ) {
176 SvIVX( ST( chain_length ) )++;
178 /* now set the number of used buckets */
179 SvIVX( ST( BUCKET_INFO_ITEMS_ON_STACK - 1 ) ) = max_bucket_index - SvIVX( ST( BUCKET_INFO_ITEMS_ON_STACK ) ) + 1;
180 XSRETURN( max_chain_length + 1 ); /* max_chain_length is the index of the last item on the stack, so we add 1 */
182 #undef BUCKET_INFO_ITEMS_ON_STACK
192 /* Returns an array of arrays representing key/bucket mappings.
193 * Each element of the array contains either an integer or a reference
194 * to an array of keys. A plain integer represents K empty buckets. An
195 * array ref represents a single bucket, with each element being a key in
196 * the hash. (Note this treats a placeholder as a normal key.)
198 * This allows one to "see" the keyorder. Note the "insert first" nature
199 * of the hash store, combined with regular remappings means that relative
200 * order of keys changes each remap.
202 const HV * hv = NULL;
203 if (SvROK(rhv) && SvTYPE(SvRV(rhv))==SVt_PVHV && !SvMAGICAL(SvRV(rhv))) {
204 hv = (const HV *) SvRV(rhv);
205 } else if (!SvOK(rhv)) {
209 HE **he_ptr= HvARRAY(hv);
218 Perl_croak(aTHX_ "hash::bucket_array only works on 'normal' hashes");
222 mXPUSHs(newRV_noinc((SV*)info_av));
223 for ( i= 0; i <= max; i++ ) {
225 for (he= he_ptr[i]; he; he= HeNEXT(he) ) {
233 av_push(info_av, newSViv(empty_count));
236 av_push(info_av, (SV *)newRV_noinc((SV *)key_av));
238 if (HeKLEN(he) == HEf_SVKEY) {
242 mode= SvUTF8(sv) ? 1 : 0;
246 mode= HeKUTF8(he) ? 1 : 0;
248 key_sv= newSVpvn(str,len);
249 av_push(key_av,key_sv);
258 av_push(info_av, newSViv(empty_count));