key/value hash slice operation

kvhslice operator that implements %h{1,2,3,4} syntax which
returns list of key value pairs rather than just values
(regular slices).

1 files changed, 48 insertions, 0 deletions

diff --git a/pp.c b/pp.c
index 5e0b02ca16..470ebd1681 100644
--- a/pp.c
+++ b/pp.c
@@ -4753,6 +4753,54 @@ PP(pp_hslice)
     RETURN;
 }
 
+PP(pp_kvhslice)
+{
+    dVAR; dSP; dMARK; dORIGMARK;
+    HV * const hv = MUTABLE_HV(POPs);
+    I32 lval = (PL_op->op_flags & OPf_MOD);
+    I32 items = SP - MARK;
+
+    if (PL_op->op_private & OPpMAYBE_LVSUB) {
+       const I32 flags = is_lvalue_sub();
+       if (flags) {
+           if (!(flags & OPpENTERSUB_INARGS))
+	       Perl_croak(aTHX_ "Can't modify key/value hash slice in list assignment");
+	   lval = flags;
+       }
+    }
+
+    MEXTEND(SP,items);
+    while (items > 1) {
+	*(MARK+items*2-1) = *(MARK+items);
+	items--;
+    }
+    items = SP-MARK;
+    SP += items;
+
+    while (++MARK <= SP) {
+        SV * const keysv = *MARK;
+        SV **svp;
+        HE *he;
+
+        he = hv_fetch_ent(hv, keysv, lval, 0);
+        svp = he ? &HeVAL(he) : NULL;
+
+        if (lval) {
+            if (!svp || !*svp || *svp == &PL_sv_undef) {
+                DIE(aTHX_ PL_no_helem_sv, SVfARG(keysv));
+            }
+	    *MARK = sv_mortalcopy(*MARK);
+        }
+        *++MARK = svp && *svp ? *svp : &PL_sv_undef;
+    }
+    if (GIMME != G_ARRAY) {
+	MARK = SP - items*2;
+	*++MARK = items > 0 ? *SP : &PL_sv_undef;
+	SP = MARK;
+    }
+    RETURN;
+}
+
 /* List operators. */
 
 PP(pp_list)