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

Add FETCHSIZE function to Perl tied arrays
---

diff --git a/src/modules/rlm_perl/rlm_perl.c b/src/modules/rlm_perl/rlm_perl.c
index 3bfcca617fa..ec5f6a8de34 100644
--- a/src/modules/rlm_perl/rlm_perl.c
+++ b/src/modules/rlm_perl/rlm_perl.c
@@ -853,6 +853,19 @@ static XS(XS_pairs_DELETE)
 	XSRETURN(0);
 }
 
+/** Called when Perl wants the size of a tied array
+ *
+ * The stack contains just the tied SV
+ */
+static XS(XS_pairs_FETCHSIZE)
+{
+	dXSARGS;
+	GET_PAIR_MAGIC(1)
+
+	if (!pair_data->parent->vp) XSRETURN_UV(0);
+	XSRETURN_UV(fr_pair_count_by_da(&pair_data->parent->vp->vp_group, pair_data->da));
+}
+
 static void xs_init(pTHX)
 {
 	char const *file = __FILE__;
@@ -882,6 +895,7 @@ static void xs_init(pTHX)
 	newXS("freeradiuspairs::STORE", XS_pairs_STORE, "rlm_perl");
 	newXS("freeradiuspairs::EXISTS", XS_pairs_EXISTS, "rlm_perl");
 	newXS("freeradiuspairs::DELETE", XS_pairs_DELETE, "rlm_perl");
+	newXS("freeradiuspairs::FETCHSIZE", XS_pairs_FETCHSIZE, "rlm_perl");
 }
 
 /** Convert a list of value boxes to a Perl array for passing to subroutines