Use better method for un-marshalling Perl values to pairs

diff --git a/src/modules/rlm_perl/rlm_perl.c b/src/modules/rlm_perl/rlm_perl.c
index 6d7df015474fca040f0e84f1d84be5092c9db30c..2190b02cf5e1489a1a1d8883eab6addcc2099fd6 100644 (file)
--- a/src/modules/rlm_perl/rlm_perl.c
+++ b/src/modules/rlm_perl/rlm_perl.c
@@ -699,58 +699,39 @@ static int fr_perl_pair_parent_build(fr_perl_pair_t *pair_data)
  */
 static int perl_value_unmarshal(fr_pair_t *vp, SV *value)
 {
-       char    *val;
-       STRLEN  len;
+       fr_value_box_t  vb;
 
-       switch (vp->vp_type) {
-       case FR_TYPE_STRING:
-               val = SvPV(value, len);
-               fr_pair_value_clear(vp);
-               fr_pair_value_bstrndup(vp, val, len, true);
+       switch (SvTYPE(value)) {
+       case SVt_IV:
+               fr_value_box_init(&vb, FR_TYPE_INT64, NULL, true);
+               vb.vb_int64 = SvIV(value);
                break;
 
-       case FR_TYPE_OCTETS:
-               val = SvPV(value, len);
-               fr_pair_value_clear(vp);
-               fr_pair_value_memdup(vp, (uint8_t const *)val, len, true);
+       case SVt_NV:
+               fr_value_box_init(&vb, FR_TYPE_FLOAT64, NULL, true);
+               vb.vb_float64 = SvNV(value);
                break;
 
-#define PERLSETUINT(_size)     case FR_TYPE_UINT ## _size: \
-       vp->vp_uint ## _size = SvUV(value); \
-       break;
-       PERLSETUINT(8)
-       PERLSETUINT(16)
-       PERLSETUINT(32)
-       PERLSETUINT(64)
-
-#define PERLSETINT(_size)      case FR_TYPE_INT ## _size: \
-       vp->vp_int ## _size = SvIV(value); \
-       break;
-       PERLSETINT(8)
-       PERLSETINT(16)
-       PERLSETINT(32)
-       PERLSETINT(64)
-
-       case FR_TYPE_ETHERNET:
-       case FR_TYPE_IPV4_ADDR:
-       case FR_TYPE_IPV6_ADDR:
-       case FR_TYPE_IPV4_PREFIX:
-       case FR_TYPE_IPV6_PREFIX:
-       case FR_TYPE_COMBO_IP_ADDR:
-       case FR_TYPE_COMBO_IP_PREFIX:
-       case FR_TYPE_IFID:
-       case FR_TYPE_TIME_DELTA:
-       case FR_TYPE_DATE:
+       case SVt_PV:
+       case SVt_PVLV:
+       {
+               char    *val;
+               STRLEN  len;
+               fr_value_box_init(&vb, FR_TYPE_STRING, NULL, true);
                val = SvPV(value, len);
-               if (fr_pair_value_from_str(vp, val, len, NULL, false) < 0) {
-                       croak("Failed populating pair");
-                       return -1;
-               }
+               fr_value_box_bstrndup_shallow(&vb, NULL, val, len, true);
+       }
                break;
 
        default:
-               fr_assert(0);
-               break;
+               croak("Unsupported Perl data type");
+               return -1;
+       }
+
+       fr_pair_value_clear(vp);
+       if (fr_value_box_cast(vp, &vp->data, vp->vp_type, vp->da, &vb) < 0) {
+               croak("Failed casting Perl value to %s", fr_type_to_str(vp->vp_type));
+               return -1;
        }
 
        return 0;