This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
regcomp.c: Fix wrong comment
[perl5.git] / ext / Hash-Util / Util.xs
index f40d1e2..095a78c 100644 (file)
@@ -7,6 +7,16 @@
 MODULE = Hash::Util            PACKAGE = Hash::Util
 
 void
+_clear_placeholders(hashref)
+        HV *hashref
+    PROTOTYPE: \%
+    PREINIT:
+        HV *hv;
+    CODE:
+        hv = MUTABLE_HV(hashref);
+        hv_clear_placeholders(hv);
+
+void
 all_keys(hash,keys,placeholder)
        HV *hash
        AV *keys
@@ -70,17 +80,29 @@ hash_seed()
 
 
 void
-hash_value(string)
+hash_value(string,...)
         SV* string
-    PROTOTYPE: $
+    PROTOTYPE: $;$
     PPCODE:
-    STRLEN len;
-    char *pv;
+{
     UV uv;
+    STRLEN len;
+    char *pv= SvPV(string,len);
+    if (items<2) {
+        PERL_HASH(uv, pv, len);
+    } else {
+        STRLEN seedlen;
+        U8 *seedbuf= (U8 *)SvPV(ST(1),seedlen);
+        if ( seedlen < PERL_HASH_SEED_BYTES ) {
+            sv_dump(ST(1));
+            Perl_croak(aTHX_ "seed len must be at least %d long only got %"
+                             UVuf " bytes", PERL_HASH_SEED_BYTES, (UV)seedlen);
+        }
 
-    pv= SvPV(string,len);
-    PERL_HASH(uv,pv,len);
+        PERL_HASH_WITH_SEED(seedbuf, uv, pv, len);
+    }
     XSRETURN_UV(uv);
+}
 
 void
 hash_traversal_mask(rhv, ...)
@@ -89,7 +111,7 @@ hash_traversal_mask(rhv, ...)
 {
 #ifdef PERL_HASH_RANDOMIZE_KEYS
     if (SvROK(rhv) && SvTYPE(SvRV(rhv))==SVt_PVHV && !SvMAGICAL(SvRV(rhv))) {
-        HV *hv = SvRV(rhv);
+        HV *hv = (HV *)SvRV(rhv);
         if (items>1) {
             hv_rand_set(hv, SvUV(ST(1)));
         }
@@ -128,8 +150,13 @@ bucket_info(rhv)
     nothing (the empty list).
 
     */
+    const HV * hv = NULL;
     if (SvROK(rhv) && SvTYPE(SvRV(rhv))==SVt_PVHV && !SvMAGICAL(SvRV(rhv))) {
-        const HV * const hv = (const HV *) SvRV(rhv);
+        hv = (const HV *) SvRV(rhv);
+    } else if (!SvOK(rhv)) {
+        hv = PL_strtab;
+    }
+    if (hv) {
         U32 max_bucket_index= HvMAX(hv);
         U32 total_keys= HvUSEDKEYS(hv);
         HE **bucket_array= HvARRAY(hv);
@@ -183,8 +210,13 @@ bucket_array(rhv)
      * of the hash store, combined with regular remappings means that relative
      * order of keys changes each remap.
      */
+    const HV * hv = NULL;
     if (SvROK(rhv) && SvTYPE(SvRV(rhv))==SVt_PVHV && !SvMAGICAL(SvRV(rhv))) {
-        const HV * const hv = (const HV *) SvRV(rhv);
+        hv = (const HV *) SvRV(rhv);
+    } else if (!SvOK(rhv)) {
+        hv = PL_strtab;
+    }
+    if (hv) {
         HE **he_ptr= HvARRAY(hv);
         if (!he_ptr) {
             XSRETURN(0);
@@ -242,3 +274,55 @@ bucket_array(rhv)
     }
     XSRETURN(0);
 }
+
+void
+bucket_ratio(rhv)
+        SV* rhv
+    PROTOTYPE: \%
+    PPCODE:
+{
+    if (SvROK(rhv)) {
+        rhv= SvRV(rhv);
+        if ( SvTYPE(rhv)==SVt_PVHV ) {
+#if PERL_VERSION < 25
+            SV *ret= Perl_hv_scalar(aTHX_ (HV*)rhv);
+#else
+            SV *ret= Perl_hv_bucket_ratio(aTHX_ (HV*)rhv);
+#endif
+            ST(0)= ret;
+            XSRETURN(1);
+        }
+    }
+    XSRETURN_UNDEF;
+}
+
+void
+num_buckets(rhv)
+        SV* rhv
+    PROTOTYPE: \%
+    PPCODE:
+{
+    if (SvROK(rhv)) {
+        rhv= SvRV(rhv);
+        if ( SvTYPE(rhv)==SVt_PVHV ) {
+            XSRETURN_UV(HvMAX((HV*)rhv)+1);
+        }
+    }
+    XSRETURN_UNDEF;
+}
+
+void
+used_buckets(rhv)
+        SV* rhv
+    PROTOTYPE: \%
+    PPCODE:
+{
+    if (SvROK(rhv)) {
+        rhv= SvRV(rhv);
+        if ( SvTYPE(rhv)==SVt_PVHV ) {
+            XSRETURN_UV(HvFILL((HV*)rhv));
+        }
+    }
+    XSRETURN_UNDEF;
+}
+