From: Nick Porter <nick@portercomputing.co.uk>
Date: Thu, 15 May 2025 14:57:06 +0000 (+0100)
Subject: Add function DELETE for Perl tied hash
X-Git-Url: http://git.ipfire.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=8a0bbed0c1e4a319aebf5b2f38cb382f6a754600;p=thirdparty%2Ffreeradius-server.git

Add function DELETE for Perl tied hash
---

diff --git a/src/modules/rlm_perl/rlm_perl.c b/src/modules/rlm_perl/rlm_perl.c
index 2b72f7d64a1..e5e37d778ff 100644
--- a/src/modules/rlm_perl/rlm_perl.c
+++ b/src/modules/rlm_perl/rlm_perl.c
@@ -530,6 +530,33 @@ static XS(XS_pairlist_NEXTKEY)
 	XSRETURN(1);
 }
 
+/** Called to delete a key from a tied hash
+ *
+ * The stack contains
+ *  - the tied SV
+ *  - the key being deleted
+ */
+static XS(XS_pairlist_DELETE)
+{
+	dXSARGS;
+	char			*attr;
+	fr_dict_attr_t const	*da;
+	fr_pair_t		*vp;
+
+	GET_PAIR_MAGIC(2)
+	attr = SvPV(ST(1), PL_na);
+
+	da = perl_attr_lookup(pair_data, attr);
+	if (!da) XSRETURN(0);
+	if (!pair_data->vp) XSRETURN(0);
+
+	vp = fr_pair_find_by_da(&pair_data->vp->vp_group, NULL, da);
+
+	if (vp) fr_pair_delete(&pair_data->vp->vp_group, vp);
+
+	XSRETURN(0);
+}
+
 /** Functions to implement subroutines required for a tied array
  *
  * Leaf attributes are represented by tied arrays to allow multiple instances.
@@ -657,6 +684,8 @@ static void xs_init(pTHX)
 	newXS("freeradiuspairlist::EXISTS", XS_pairlist_EXISTS, "rlm_perl");
 	newXS("freeradiuspairlist::FIRSTKEY", XS_pairlist_FIRSTKEY, "rlm_perl");
 	newXS("freeradiuspairlist::NEXTKEY", XS_pairlist_NEXTKEY, "rlm_perl");
+	newXS("freeradiuspairlist::DELETE", XS_pairlist_DELETE, "rlm_perl");
+
 	/*
 	 *	The freeradiuspairs package implements functions required
 	 *	for a tied array handling leaf attributes.