view release on metacpan or  search on metacpan

YY.xs  view on Meta::CPAN

        /* scalar ref: boolean */
        if (SvTYPE(deref) < SVt_PVAV) {
            if (SvTRUE(deref))
                buf_cat_mem(aTHX_ buf, "true", 4);
            else
                buf_cat_mem(aTHX_ buf, "false", 5);
            return;
        }

        if (SvTYPE(deref) == SVt_PVAV) {
            AV *av = (AV *)deref;
            SSize_t len = av_len(av) + 1;
            buf_cat_c(aTHX_ buf, '[');
            for (SSize_t i = 0; i < len; i++) {
                if (i) buf_cat_c(aTHX_ buf, ',');
                SV **elem = av_fetch(av, i, 0);
                direct_encode_sv(aTHX_ buf, elem ? *elem : &PL_sv_undef,
                                 depth + 1, self);
            }
            buf_cat_c(aTHX_ buf, ']');
            return;
        }

        if (SvTYPE(deref) == SVt_PVHV) {
            HV *hv = (HV *)deref;
            buf_cat_c(aTHX_ buf, '{');
            hv_iterinit(hv);
            HE *he;
            int first = 1;
            while ((he = hv_iternext(hv))) {
                if (!first) buf_cat_c(aTHX_ buf, ',');
                first = 0;
                STRLEN klen;
                const char *kstr = HePV(he, klen);
                buf_cat_escaped_str(aTHX_ buf, kstr, klen);
                buf_cat_c(aTHX_ buf, ':');
                direct_encode_sv(aTHX_ buf, HeVAL(he), depth + 1, self);
            }
            buf_cat_c(aTHX_ buf, '}');
            return;
        }

        if (self->flags & F_ALLOW_UNKNOWN) {
            buf_cat_mem(aTHX_ buf, "null", 4);
            return;
        }
        croak("cannot encode reference to %s", sv_reftype(deref, 0));
    }

    if (SvIOK(sv)) {
        if (SvIsUV(sv))
            buf_cat_uv(aTHX_ buf, SvUVX(sv));
        else
            buf_cat_iv(aTHX_ buf, SvIVX(sv));
        return;
    }

    if (SvNOK(sv)) {
        NV nv = SvNVX(sv);
        if (Perl_isnan(nv) || Perl_isinf(nv))
            croak("cannot encode NaN or Infinity as JSON");
        buf_cat_nv(aTHX_ buf, nv);
        return;
    }

    if (SvPOK(sv)) {
        STRLEN len;
        const char *str = SvPV(sv, len);
        buf_cat_escaped_str(aTHX_ buf, str, len);
        return;
    }

    buf_cat_mem(aTHX_ buf, "null", 4);
}

/* ---- ENCODE: Perl SV -> yyjson mutable value (used for OO API) ---- */

static yyjson_mut_val *
sv_to_yyjson_val(pTHX_ yyjson_mut_doc *doc, SV *sv, json_yy_t *self, U32 depth) {
    if (depth > self->max_depth)
        croak("maximum nesting depth exceeded");

    if (!SvOK(sv))
        return yyjson_mut_null(doc);

    if (SvROK(sv)) {
        SV *deref = SvRV(sv);

        /* check for blessed objects */
        if (SvOBJECT(deref)) {
            /* convert_blessed: call TO_JSON */
            if (self->flags & F_CONVERT_BLESSED) {
                dSP;
                ENTER; SAVETMPS;
                PUSHMARK(SP);
                XPUSHs(sv);
                PUTBACK;
                int count = call_method("TO_JSON", G_SCALAR | G_EVAL);
                SPAGAIN;
                if (SvTRUE(ERRSV)) {
                    SV *err = ERRSV;
                    PUTBACK; FREETMPS; LEAVE;
                    croak("TO_JSON method failed: %" SVf, SVfARG(err));
                }
                SV *result = count > 0 ? POPs : &PL_sv_undef;
                SvREFCNT_inc(result);
                PUTBACK; FREETMPS; LEAVE;
                yyjson_mut_val *ret = sv_to_yyjson_val(aTHX_ doc, result, self, depth);
                SvREFCNT_dec(result);
                return ret;
            }
            /* allow_blessed: encode as null */
            if (self->flags & F_ALLOW_BLESSED)
                return yyjson_mut_null(doc);
            croak("encountered object '%s', but allow_blessed/convert_blessed is not enabled",
                  sv_reftype(deref, 1));
        }

        /* scalar ref: \1 = true, \0 = false */
        if (SvTYPE(deref) < SVt_PVAV) {
            return SvTRUE(deref)
                ? yyjson_mut_bool(doc, 1)
                : yyjson_mut_bool(doc, 0);
        }

        switch (SvTYPE(deref)) {
            case SVt_PVAV: {
                AV *av = (AV *)deref;
                yyjson_mut_val *arr = yyjson_mut_arr(doc);
                SSize_t len = av_len(av) + 1;
                for (SSize_t i = 0; i < len; i++) {
                    SV **elem = av_fetch(av, i, 0);
                    yyjson_mut_val *v = sv_to_yyjson_val(aTHX_ doc, elem ? *elem : &PL_sv_undef, self, depth + 1);
                    yyjson_mut_arr_append(arr, v);
                }
                return arr;
            }

            case SVt_PVHV: {
                HV *hv = (HV *)deref;
                yyjson_mut_val *obj = yyjson_mut_obj(doc);
                hv_iterinit(hv);
                HE *he;
                while ((he = hv_iternext(hv))) {
                    STRLEN klen;
                    const char *kstr = HePV(he, klen);
                    SV *val = HeVAL(he);
                    yyjson_mut_val *k = yyjson_mut_strncpy(doc, kstr, klen);
                    yyjson_mut_val *v = sv_to_yyjson_val(aTHX_ doc, val, self, depth + 1);
                    yyjson_mut_obj_add(obj, k, v);
                }
                return obj;
            }

            default:
                if (self->flags & F_ALLOW_UNKNOWN)
                    return yyjson_mut_null(doc);
                croak("cannot encode reference to %s", sv_reftype(deref, 0));
        }
    }

    /* check for boolean (JSON::PP::Boolean, Types::Serialiser::Boolean, etc.) */
    /* SvIOK first for speed */
    if (SvIOK(sv)) {
        if (SvIsUV(sv))
            return yyjson_mut_uint(doc, (uint64_t)SvUVX(sv));
        return yyjson_mut_sint(doc, (int64_t)SvIVX(sv));
    }

    if (SvNOK(sv)) {
        NV nv = SvNVX(sv);
        if (Perl_isnan(nv) || Perl_isinf(nv))
            croak("cannot encode NaN or Infinity as JSON");
        return yyjson_mut_real(doc, nv);
    }

    if (SvPOK(sv)) {
        STRLEN len;
        const char *str = SvPV(sv, len);
        return yyjson_mut_strncpy(doc, str, len);
    }

    return yyjson_mut_null(doc);
}

/* ---- custom ops for keyword API ---- */

/* pp function for decode_json keyword */
static OP *
pp_decode_json_impl(pTHX) {
    dSP;
    SV *json_sv = POPs;
    STRLEN len;
    const char *json = SvPV(json_sv, len);

    yyjson_read_err err;
    yyjson_doc *doc = yyjson_read_opts((char *)json, len, YYJSON_READ_NOFLAG, NULL, &err);
    if (!doc)
        croak("JSON decode error: %s at byte offset %zu", err.msg, err.pos);

    yyjson_val *root = yyjson_doc_get_root(doc);
    if (!root) {
        yyjson_doc_free(doc);
        croak("JSON decode error: empty document");
    }

    SV *result = yyjson_val_to_sv(aTHX_ root);
    yyjson_doc_free(doc);

    XPUSHs(sv_2mortal(result));
    RETURN;
}

/* pp function for encode_json keyword */
static OP *
pp_encode_json_impl(pTHX) {
    dSP;
    SV *data = POPs;

    SV *result = newSV(64);
    SvPOK_on(result);
    SvCUR_set(result, 0);
    direct_encode_sv(aTHX_ result, data, 0, &default_self);
    *(SvPVX(result) + SvCUR(result)) = '\0';

    XPUSHs(sv_2mortal(result));
    RETURN;
}

/* pp function for decode_json_ro keyword */
static OP *
pp_decode_json_ro_impl(pTHX) {
    dSP;