view release on metacpan or  search on metacpan

JSON.xs  view on Meta::CPAN

        SV *die_msg = s->die_msg;
        STRLEN dlen;
        SV *m = die_msg ? newSVsv(die_msg) : NULL;
        jsonl_stream_state_free(aTHX_ s);
        ctx->call_state = NULL;
        ctx->cancel = 1;
        if (m) {
            const char *dpv = SvPV(m, dlen);
            sv_2mortal(m);
            croak("%.*s", (int)dlen, dpv);
        }
        croak("File::Raw::JSON: stream cancelled");
    }

    if (eof) {
        jsonl_stream_state_free(aTHX_ s);
        ctx->call_state = NULL;
    }
    return 0;
}

/* ============================================================
 * Plugin descriptors. Statics so the registry's non-owning pointer
 * stays valid for the life of the process.
 * ============================================================ */

static FilePlugin json_plugin;
static FilePlugin jsonl_plugin;

/* ============================================================ */

MODULE = File::Raw::JSON    PACKAGE = File::Raw::JSON

PROTOTYPES: DISABLE

# ---- direct in-memory codec entry points ------------------------
#
# file_json_decode($bytes, ?key => value, ...)  -> parsed value
# file_json_encode($value, ?key => value, ...)  -> JSON bytes
#
# These bypass File::Raw's plugin pipeline entirely - no path, no
# syscalls, just bytes <-> Perl structure.  Same options grammar as
# the plugin tail (mode, pretty, indent, sort_keys, canonical,
# ordered, relaxed, allow_nonref, allow_nan_inf, max_depth, eol,
# boolean_class, utf8); odd-count tails croak.  See build_opts_hv
# above the first MODULE block for the option-collection helper.

# File::Raw::JSON->import(...) - selective installer.  Mirrors
# File::Raw's pattern (file.c XS_file_import).  `use File::Raw::JSON`
# with no arg list = no-op; with a list of names, each requested
# function CV is aliased into the caller's package via newXS, sharing
# the underlying XSUB pointer with the source CV.
#
# Recognised: file_json_decode, file_json_encode, :codec (= both),
# :all (= same).  Unknown names warn but don't die, matching File::Raw.
void
import(...)
PREINIT:
    const char *pkg;
    I32 i;
PPCODE:
    pkg = CopSTASHPV(PL_curcop);
    if (items <= 1) XSRETURN_EMPTY;

    for (i = 1; i < items; i++) {
        STRLEN len;
        const char *arg = SvPV(ST(i), len);

        if ((len == 6 && strEQ(arg, ":codec")) ||
            (len == 4 && strEQ(arg, ":all")))
        {
            fjson_install_alias(aTHX_ pkg, "file_json_decode");
            fjson_install_alias(aTHX_ pkg, "file_json_encode");
            continue;
        }
        if ((len == 16 && strEQ(arg, "file_json_decode")) ||
            (len == 16 && strEQ(arg, "file_json_encode")))
        {
            fjson_install_alias(aTHX_ pkg, arg);
            continue;
        }
        warn("File::Raw::JSON: '%.*s' is not exported", (int)len, arg);
    }
    XSRETURN_EMPTY;

SV *
file_json_decode(bytes, ...)
    SV *bytes
PREINIT:
    json_options_t o;
    HV *opts_hv;
    const char *boolean_class;
    HV *bool_stash;
    STRLEN len;
    const char *pv;
CODE:
    json_options_defaults(&o);
    o.mode = JSON_MODE_DOCUMENT;
    opts_hv = build_opts_hv(aTHX_ ax, items, 1, "file_json_decode");
    boolean_class = decode_opts(aTHX_ opts_hv, &o);
    bool_stash = resolve_boolean_stash(aTHX_ boolean_class);

    if (!bytes || !SvOK(bytes)) XSRETURN_UNDEF;
    pv = SvPV(bytes, len);

    if (o.mode == JSON_MODE_LINES) {
        AV *av = json_decode_lines(aTHX_ pv, len, &o, bool_stash);
        RETVAL = newRV_noinc((SV *)av);
    } else {
        SV *out = json_decode_document(aTHX_ pv, len, &o, bool_stash);
        RETVAL = out ? out : &PL_sv_undef;
        if (RETVAL == &PL_sv_undef) SvREFCNT_inc(RETVAL);
    }
OUTPUT:
    RETVAL

SV *
file_json_encode(value, ...)
    SV *value
PREINIT:
    json_options_t o;

JSON.xs  view on Meta::CPAN

    opts_hv = build_opts_hv(aTHX_ ax, items, 1, "file_json_encode");
    (void)decode_opts(aTHX_ opts_hv, &o);

    if (o.mode == JSON_MODE_LINES) {
        RETVAL = json_encode_lines(aTHX_ value, &o);
    } else {
        RETVAL = json_encode_document(aTHX_ value, &o);
    }
    if (!RETVAL) {
        RETVAL = &PL_sv_undef;
        SvREFCNT_inc(RETVAL);
    }
OUTPUT:
    RETVAL

BOOT:
{
    init_boolean_singletons(aTHX);

    json_plugin.name      = "json";
    json_plugin.read_fn   = json_read;
    json_plugin.write_fn  = json_write;
    json_plugin.record_fn = NULL;
    json_plugin.stream_fn = json_stream_reject;
    json_plugin.state     = &MODE_DOCUMENT_TAG;
    if (file_register_plugin(aTHX_ &json_plugin) <= 0)
        warn("File::Raw::JSON: failed to register 'json' plugin");

    jsonl_plugin.name      = "jsonl";
    jsonl_plugin.read_fn   = json_read;     /* mode tag selects MODE_LINES */
    jsonl_plugin.write_fn  = json_write;
    jsonl_plugin.record_fn = NULL;
    jsonl_plugin.stream_fn = jsonl_stream;
    jsonl_plugin.state     = &MODE_LINES_TAG;
    if (file_register_plugin(aTHX_ &jsonl_plugin) <= 0)
        warn("File::Raw::JSON: failed to register 'jsonl' plugin");
}


# ============================================================
# File::Raw::JSON::Boolean - XSUB constructors + overload bodies
# ============================================================
#
# All four overload entry points (bool / numify / stringify / not)
# run as XSUBs rather than Perl subs, ~3x faster than the pure-Perl
# overload that was here before. The overload table itself is still
# wired up by `use overload ...` in Boolean.pm - that's the cheapest
# way to register, and the dispatch cost is identical regardless of
# whether the body is a Perl sub or an XSUB.
#
# Calling convention: overload invokes our handlers with three args
# (self, other, swap). We only need self; ignore the rest. Returning
# the static PL_sv_yes / PL_sv_no avoids per-call SV allocation.

MODULE = File::Raw::JSON    PACKAGE = File::Raw::JSON::Boolean

PROTOTYPES: DISABLE

void
TRUE(...)
    PPCODE:
        PERL_UNUSED_VAR(items);
        if (!g_frj_true_sv) init_boolean_singletons(aTHX);
        SvREFCNT_inc_simple_void(g_frj_true_sv);
        XPUSHs(sv_2mortal(g_frj_true_sv));
        XSRETURN(1);

void
FALSE(...)
    PPCODE:
        PERL_UNUSED_VAR(items);
        if (!g_frj_false_sv) init_boolean_singletons(aTHX);
        SvREFCNT_inc_simple_void(g_frj_false_sv);
        XPUSHs(sv_2mortal(g_frj_false_sv));
        XSRETURN(1);

SV *
overload_bool(self, other, swap)
    SV *self
    SV *other
    SV *swap
    OVERLOAD: bool
    CODE:
        PERL_UNUSED_VAR(other);
        PERL_UNUSED_VAR(swap);
        RETVAL = (SvROK(self) && SvTRUE(SvRV(self)))
                   ? &PL_sv_yes : &PL_sv_no;
        SvREFCNT_inc_simple_void(RETVAL);  /* OUTPUT typemap will mortalise */
    OUTPUT:
        RETVAL

SV *
overload_numify(self, other, swap)
    SV *self
    SV *other
    SV *swap
    OVERLOAD: 0+
    CODE:
        PERL_UNUSED_VAR(other);
        PERL_UNUSED_VAR(swap);
        RETVAL = newSViv(
            (SvROK(self) && SvTRUE(SvRV(self))) ? 1 : 0
        );
    OUTPUT:
        RETVAL

SV *
overload_stringify(self, other, swap)
    SV *self
    SV *other
    SV *swap
    OVERLOAD: \"\"
    CODE:
        PERL_UNUSED_VAR(other);
        PERL_UNUSED_VAR(swap);
        RETVAL = newSVpvn(
            (SvROK(self) && SvTRUE(SvRV(self))) ? "1" : "0", 1
        );
    OUTPUT:
        RETVAL

SV *
overload_not(self, other, swap)
    SV *self
    SV *other
    SV *swap
    OVERLOAD: !
    CODE:
        PERL_UNUSED_VAR(other);
        PERL_UNUSED_VAR(swap);