view release on metacpan or  search on metacpan

Parser.xs  view on Meta::CPAN

            if (v->type == DMS_OFFSET_DT) { slot = &stash_OffsetDateTime; name = "DMS::OffsetDateTime"; }
            else if (v->type == DMS_LOCAL_DT) { slot = &stash_LocalDateTime; name = "DMS::LocalDateTime"; }
            else if (v->type == DMS_LOCAL_DATE) { slot = &stash_LocalDate; name = "DMS::LocalDate"; }
            else { slot = &stash_LocalTime; name = "DMS::LocalTime"; }
            SV *inner = newSVpv(v->u.s ? v->u.s : "", 0);
            sv_utf8_decode(inner);
            return bless_sentinel(aTHX_ get_stash_cached(aTHX_ slot, name), inner);
        }
        case DMS_TABLE: {
            HV *hv = newHV();
            AV *keys_av = newAV();
            if (v->u.t.len > 0) {
                av_extend(keys_av, (SSize_t)v->u.t.len - 1);
                hv_ksplit(hv, (U32)(v->u.t.len + 1));
            }
            for (size_t i = 0; i < v->u.t.len; i++) {
                const char *key = v->u.t.items[i].key;
                STRLEN klen = strlen(key);
                SV *val_sv = value_to_sv_lite(aTHX_ v->u.t.items[i].value);
                /* Store value into HV. hv_store consumes the value SV's
                 * refcount (one). */
                hv_store(hv, key, (I32)klen, val_sv, 0);
                /* Append a UTF-8-flagged key SV to the sidecar. */
                SV *key_sv = newSVpvn(key, klen);
                sv_utf8_decode(key_sv);
                av_push(keys_av, key_sv);
            }
            /* Sidecar at "\0__dms_keys" — NUL prefix avoids collision. */
            hv_store(hv, SIDECAR_KEY, (I32)SIDECAR_KEY_LEN,
                     newRV_noinc((SV *)keys_av), 0);
            return newRV_noinc((SV *)hv);
        }
        case DMS_LIST: {
            AV *av = newAV();
            av_extend(av, (SSize_t)v->u.l.len);
            for (size_t i = 0; i < v->u.l.len; i++) {
                av_push(av, value_to_sv_lite(aTHX_ v->u.l.items[i]));
            }
            return newRV_noinc((SV *)av);
        }
    }
    return &PL_sv_undef;
}

/* --- comment AST → SV -------------------------------------------------- */

/* Build the comment hashref { content, kind } mirroring the pure-Perl
 * parser. `content` is the raw source text (UTF-8) including delimiters.
 * `kind` is "line" or "block". */
static SV *comment_to_sv(pTHX_ const dms_attached_comment *ac) {
    HV *h = newHV();
    SV *content_sv = newSVpv(ac->content ? ac->content : "", 0);
    sv_utf8_decode(content_sv);
    hv_store(h, "content", 7, content_sv, 0);
    const char *kind = (ac->kind == DMS_COMMENT_BLOCK) ? "block" : "line";
    hv_store(h, "kind", 4, newSVpv(kind, 0), 0);
    return newRV_noinc((SV *)h);
}

/* Build a path arrayref from a dms_breadcrumb_seg array. String segments
 * are plain Perl scalars (UTF-8 decoded); index segments are blessed
 * DMS::Index scalar refs (matching the pure-Perl parser's wrapper).
 * Used by both attached-comment paths and original-form-entry paths. */
static SV *path_segs_to_sv(pTHX_ const dms_breadcrumb_seg *segs, size_t n) {
    AV *av = newAV();
    if (n > 0) av_extend(av, (SSize_t)n - 1);
    for (size_t i = 0; i < n; i++) {
        const dms_breadcrumb_seg *seg = &segs[i];
        if (seg->is_index) {
            HV *st = get_stash_cached(aTHX_ &stash_Index, "DMS::Index");
            av_push(av, bless_sentinel(aTHX_ st, newSViv((IV)seg->idx)));
        } else {
            SV *k = newSVpv(seg->key ? seg->key : "", 0);
            sv_utf8_decode(k);
            av_push(av, k);
        }
    }
    return newRV_noinc((SV *)av);
}

static SV *path_to_sv(pTHX_ const dms_attached_comment *ac) {
    return path_segs_to_sv(aTHX_ ac->path, ac->path_len);
}

/* Build the `string_form` hashref for an original-literal record whose
 * lit.is_string_form == 1. Mirrors the shape DMS::Emitter expects:
 *   { kind => 'basic'|'literal'|'heredoc',
 *     flavor => 'basic_triple'|'literal_triple' (heredoc only),
 *     label => "...",                            (heredoc only)
 *     modifiers => [ { name => "...", args => [...] }, ... ] (heredoc only) }
 * The `args` array is left empty for now — the C struct stores
 * `dms_value **args`, but heredoc modifier args round-trip through the
 * lexeme buffer in dms-c, and the Perl Emitter currently only inspects
 * `name` (it re-applies the modifier via dispatch on name). */
static SV *string_form_to_sv(pTHX_ const dms_string_form *sf) {
    HV *h = newHV();
    const char *kind =
        (sf->kind == DMS_STRING_BASIC)   ? "basic"   :
        (sf->kind == DMS_STRING_LITERAL) ? "literal" :
                                           "heredoc";
    hv_store(h, "kind", 4, newSVpv(kind, 0), 0);
    if (sf->kind == DMS_STRING_HEREDOC) {
        const char *flavor = (sf->heredoc_flavor == DMS_HEREDOC_BASIC_TRIPLE)
                             ? "basic_triple" : "literal_triple";
        hv_store(h, "flavor", 6, newSVpv(flavor, 0), 0);
        if (sf->label) {
            SV *lbl = newSVpv(sf->label, 0);
            sv_utf8_decode(lbl);
            hv_store(h, "label", 5, lbl, 0);
        } else {
            hv_store(h, "label", 5, newSV(0), 0);
        }
        AV *mods = newAV();
        if (sf->num_modifiers > 0) av_extend(mods, (SSize_t)sf->num_modifiers - 1);
        for (size_t i = 0; i < sf->num_modifiers; i++) {
            HV *m = newHV();
            const dms_heredoc_modifier_call *mc = &sf->modifiers[i];
            SV *name = newSVpv(mc->name ? mc->name : "", 0);
            sv_utf8_decode(name);
            hv_store(m, "name", 4, name, 0);
            /* args: marshal the dms_value array to a Perl arrayref via the