The Perl and Raku Conference 2025: Greenville, South Carolina - June 27-29 Learn more

#ifndef PERL_JSONSL_H_
#define PERL_JSONSL_H_
#define PERL_NO_GET_CONTEXT
#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"
#include "ppport.h"
#include <limits.h>
/**
* Default depth limit to use, if none supplied
*/
#define PLJSONSL_MAX_DEFAULT 512
/**
* Key names for the information returned by
* JSONpointer results
*/
#define PLJSONSL_INFO_KEY_PATH "Path"
#define PLJSONSL_INFO_KEY_VALUE "Value"
#define PLJSONSL_INFO_KEY_QUERY "JSONPointer"
/**
* Names of various perl globs
*/
#define PLJSONSL_CLASS_NAME "JSON::SL"
#define PLJSONSL_BOOLEAN_NAME "JSON::SL::Boolean"
#define PLJSONSL_PLACEHOLDER_NAME "JSON::SL::Placeholder"
#define PLTUBA_CLASS_NAME "JSON::SL::Tuba"
#define PLTUBA_HKEY_NAME "_TUBA"
#if PERL_VERSION >= 10
#define PLJSONSL_HAVE_HV_COMMON
#else
#warning "You are using a Perl from the stone age. This code might work.."
#endif /* 5.10.0 */
/**
* Extended fields for a stack state
* sv: the raw SV (never a reference)
* u_loc.idx / u_loc.key: the numerical index or the HE key, depending
* on parent type.
* matchres: the result of the last match
* matchjpr: the jsonsl_jpr_t object (assuming a successful match [COMPLETE] )
*/
#define JSONSL_STATE_USER_FIELDS \
SV *sv; \
union { \
int idx; \
HE *key; \
} u_loc; \
int matchres; \
int uescapes; \
jsonsl_jpr_t matchjpr;
/**
* We take advantage of the JSONSL_API and make all symbols
* non-exportable
*/
#define JSONSL_API static
#include "jsonsl/jsonsl.h"
#include "jsonsl/jsonsl.c"
/**
* For threaded perls, this stores the THX/my_perl context
* inside the object's pl_thx field. For non threaded perls,
* this is a nop.
*/
#ifndef tTHX
#define tTHX PerlInterpreter*
#endif
#ifdef PERL_IMPLICIT_CONTEXT
#define PLJSONSL_dTHX(pjsn) \
pTHX = (tTHX)pjsn->pl_thx
#define PLJSONSL_mkTHX(pjsn) \
pjsn->pl_thx = my_perl;
#else
#define PLJSONSL_dTHX(pjsn)
#define PLJSONSL_mkTHX(pjsn)
#endif /* PERL_IMPLICIT_CONTEXT */
/*
* This is the 'abstract base class' for both JSON::SL and JSON::SL::Tuba
*/
#define PLJSONSL_COMMON_FIELDS \
/* The lexer */ \
jsonsl_t jsn; \
/* Input buffer */ \
SV *buf; \
/* Start position of the buffer (relative to input stream) */ \
size_t pos_min_valid; \
/* Position of the beginning of the earlist of (SPECIAL,STRINGY) */ \
size_t keep_pos; \
/* Context for threaded Perls */ \
void *pl_thx; \
/* Stash for booleans */ \
HV *stash_boolean; \
/* Escape table */ \
int escape_table[0x80];
/* These are the escapes we care about: */
#define PLJSONSL_ESCTBL_INIT(tbl) \
memset(ESCTBL, 0, sizeof(ESCTBL)); \
tbl['"'] = 1; \
tbl['\\'] = 1; \
tbl['/'] = 1; \
tbl['b'] = 1; \
tbl['n'] = 1; \
tbl['r'] = 1; \
tbl['f'] = 1; \
tbl['u'] = 1; \
tbl['t'] = 1;
typedef struct {
PLJSONSL_COMMON_FIELDS
/* Root perl data structure. This is either an HV* or AV* */
SV *root;
/**
* "current" hash key. This is always a pointer to an HE* of an existing
* hash entry, and thus should never be freed/destroyed directly.
* This variable should only be non-null during until the next PUSH
* callback
*/
HE *curhk;
#ifndef PLJSONSL_HAVE_HV_COMMON
/**
* For older perls not exposing hv_common, we need a key sv.
* make this as efficient as possible. Instead of instantiating a new
* SV each time for hv_fetch_ent, we keep one cached, and change its
* PV slot as needed. I am able to do this because I have looked at 5.8's
* implementation for the hv_* methods in hv.c and unless the hash is magical,
* the behavior is to simply extract the PV from the SV in the beginning
* anyway.
*/
SV *ksv;
char *ksv_origpv;
#endif
struct {
int utf8; /** Set the SvUTF8 flag */
int nopath; /** Don't include path context in results */
int noqstr; /** Don't include original query string in results */
int max_size; /** maximum input size (from JSON::XS) */
/* ignore the jsonpointer settings and allow an 'iv-drip' of
* objects to be returned via feed */
int object_drip;
/** Callback to invoke when root object is about to be destroyed */
SV *root_callback;
} options;
/**
* Private options
*/
struct {
/* whether this is the 'global' JSON::SL object used
* for decode_json()
*/
int is_global;
} priv_global;
/**
* If we allocate a bunch of JPR objects, keep a reference to
* them here in order to destroy them along with ourselves.
*/
jsonsl_jpr_t *jprs;
size_t njprs;
/**
* This is the 'result stack'
*/
AV *results;
/**
* Escape preferences
*/
} PLJSONSL;
#define PLTUBA_XCALLBACK \
JSONSL_XTYPE \
X(DATA, 'c') \
X(ERROR, '!') \
X(JSON, 'D') \
X(NUMBER, '=') \
X(BOOLEAN, '?') \
X(NULL, '~') \
X(ANY, '.') \
typedef enum {
#define X(o,c) \
PLTUBA_CALLBACK_##o = c,
PLTUBA_XCALLBACK
#undef X
PLTUBA_CALLBACK_blah
} pltuba_callback_type;
#define PLTUBA_ACTION_ON '>'
#define PLTUBA_DEFINE_XMETHGV
#include "srcout/tuba_dispatch_getmeth.h"
#undef PLTUBA_DEFINE_XMETHGV
/* These are stringified as the 'Info' keys */
#define PLTUBA_XPARAMS \
X(Escaped) \
X(Key) \
X(Type) \
X(Mode) \
X(Value) \
X(Index)
/**
* This can be considered to be a 'subset' of the
* PLJSONSL structure, but with some slight subtleties and
* differences.
*/
struct pltuba_param_entry_st {
HE *he;
SV *sv;
};
typedef struct {
PLJSONSL_COMMON_FIELDS
/* When we invoke a callback, instead of re-creating the
* mortalized rv each time, we just keep a static reference
* to ourselves
*/
SV *selfrv;
/* This is last known stash for our methods.
* In the rare event that someone decides to rebless
* us into a different class, we compare and swap out
* in favor of the new one (SvSTASH(SvRV(tuba->selfrv)));
*/
HV *last_stash;
/* set by hkey and string callbacks */
int shift_quote;
/* Options */
struct {
int utf8;
int no_cache_mro;
int accum_kv;
int cb_unified;
int allow_unhandled;
} options;
#define PLTUBA_METHGV_STRUCT
#include "srcout/tuba_dispatch_getmeth.h"
#undef PLTUBA_METHGV_STRUCT
/* The accumulators */
SV *accum;
SV *kaccum;
/**
* The following structures contain registers for the
* HEs which are hash entries for the info hash, and the
* corresponding SVs which they contain.
*/
struct {
#define X(vname) \
struct pltuba_param_entry_st pe_##vname;
PLTUBA_XPARAMS
#undef X
} p_ents;
/* Our info hash, and its reference */
HV *paramhv;
SV *paramhvrv;
/* Table of various callbacks to invoke */
int accum_options[0x100];
} PLTUBA;
/**
* These macros manipulate the static entries within the hash
* which is passed into callbacks.
* There are two primary variables to work with:
* 1) The actual static SV which contains the value
* 2) The HE which points to the SV
*
* And three operations
* 1) Assigning the value to the SV
* 2) Tying the HE with the SV, so a lookup on the hash
* entry yields the SV
* 3) Decoupling the HE and the SV, so the SV remains allocated
* but the HE will now point to &PL_sv_placeholder and not yield
* a result.
*/
#define PLTUBA_PARAM_FIELD(tuba, b) \
(tuba->p_ents.pe_##b)
/**
* Assign an SV to the named field. The HE is made to point to the SV
*/
#define PLTUBA_SET_PARAMFIELDS_sv(tuba, field, sv) \
HeVAL(PLTUBA_PARAM_FIELD(tuba,field).he) = sv;
/**
* Convenience macro which assigns the SV to the HE, and then sets
* the IVX slot.
*/
#define PLTUBA_SET_PARAMFIELDS_iv(tuba, field, iv) \
/* assign the IV */ \
assert(PLTUBA_PARAM_FIELD(tuba,field).sv); \
assert(SvIOK(PLTUBA_PARAM_FIELD(tuba,field).sv)); \
SvIVX(PLTUBA_PARAM_FIELD(tuba, field).sv) = iv; \
/* set the he's value to the just-assigned sv */ \
PLTUBA_SET_PARAMFIELDS_sv(tuba, field, PLTUBA_PARAM_FIELD(tuba,field).sv)
#define PLTUBA_SET_PARAMFIELDS_dv(tuba, field, c) \
PLTUBA_SET_PARAMFIELDS_iv(tuba, field, c); \
*SvPVX(PLTUBA_PARAM_FIELD(tuba,field).sv) = (char)c; \
/**
* Sets the HE to point to &PL_sv_placeholder.
*/
#define PLTUBA_RESET_PARAMFIELD(tuba, field) \
HeVAL(PLTUBA_PARAM_FIELD(tuba, field).he) = &PL_sv_placeholder;
#endif /* PERL_JSONSL_H_ */