X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/4bf035ef9384dfbe85a500502cc3866c87c59b26..36dc22073c0c9dbad0f19f957f6a520e21a4a4fa:/ext/Hash-Util/Util.xs

diff --git a/ext/Hash-Util/Util.xs b/ext/Hash-Util/Util.xs
index 483db73..2758d69 100644
--- a/ext/Hash-Util/Util.xs
+++ b/ext/Hash-Util/Util.xs
@@ -1,3 +1,5 @@
+#define PERL_NO_GET_CONTEXT
+
 #include "EXTERN.h"
 #include "perl.h"
 #include "XSUB.h"
@@ -58,3 +60,185 @@ hv_store(hash, key, val)
 	    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);
+}