X-Git-Url: http://git.vpit.fr/?p=perl%2Fmodules%2FSub-Nary.git;a=blobdiff_plain;f=Nary.xs;h=cea5f955b8448707c89e97e1162d8785eb0cec34;hp=75892ce3338d7bcd61ca2996b5d4a865e1c7dc94;hb=462a647c8b471a029c5dc2527bd4b78e64d93cee;hpb=91deeda20173f3d35c5b936c9e6db1cbe08f0e00

diff --git a/Nary.xs b/Nary.xs
index 75892ce..cea5f95 100644
--- a/Nary.xs
+++ b/Nary.xs
@@ -112,20 +112,14 @@ CODE:
  res = newHV();
  if (!SvROK(sv)) {
   val = newSVuv(1);
-  if (!hv_store_ent(res, sv, val, 0)) {
+  if (!hv_store_ent(res, sv, val, 0))
    SvREFCNT_dec(val);
-   SvREFCNT_dec(res);
-   XSRETURN_UNDEF;
-  }
  } else {
   hv = (HV *) SvRV(sv);
   if (!hv_iterinit(hv)) {
    val = newSVuv(1);
-   if (!hv_store(res, "0", 1, val, 0)) {
+   if (!hv_store(res, "0", 1, val, 0))
     SvREFCNT_dec(val);
-    SvREFCNT_dec(res);
-    XSRETURN_UNDEF;
-   }
   } else {
    while (key = hv_iternext(hv)) {
     c += SvNV(HeVAL(key));
@@ -141,6 +135,42 @@ CODE:
  ST(0) = sv_2mortal(newRV_noinc((SV *) res));
  XSRETURN(1);
 
+void
+scale(SV *csv, SV *sv)
+PROTOTYPE: $;$
+PREINIT:
+ HV *hv, *res;
+ HE *key;
+ SV *val;
+ NV c = 1;
+CODE:
+ if (!SvOK(sv))
+  XSRETURN_UNDEF;
+ if (SvOK(csv))
+  c = SvNV(csv);
+ res = newHV();
+ if (!SvROK(sv)) {
+  val = newSVnv(c);
+  if (!hv_store_ent(res, sv, val, 0))
+   SvREFCNT_dec(val);
+ } else {
+  hv = (HV *) SvRV(sv);
+  if (!hv_iterinit(hv)) {
+   val = newSVnv(c);
+   if (!hv_store(res, "0", 1, val, 0))
+    SvREFCNT_dec(val);
+  } else {
+   hv_iterinit(hv);
+   while (key = hv_iternext(hv)) {
+    val = newSVnv(SvNV(HeVAL(key)) * c);
+    if (!hv_store_ent(res, HeSVKEY_force(key), val, HeHASH(key)))
+     SvREFCNT_dec(val);
+   }
+  }
+ }
+ ST(0) = sv_2mortal(newRV_noinc((SV *) res));
+ XSRETURN(1);
+
 void
 combine(...)
 PROTOTYPE: @