Open-API
view release on metacpan or search on metacpan
{
IV p = 0;
dSP;
eval_pv("require JSON::Schema::Fast;", FALSE);
SPAGAIN; /* the require may have reallocated the value stack */
if (!SvTRUE(ERRSV)) {
PUSHMARK(SP);
PUTBACK;
if (call_pv("JSON::Schema::Fast::_abi_ptr", G_SCALAR | G_EVAL) > 0) {
SPAGAIN;
if (!SvTRUE(ERRSV)) p = POPi; else (void)POPs;
PUTBACK;
}
}
if (p) {
const jsf_abi *a = INT2PTR(const jsf_abi *, p);
if (a && a->abi_version == JSF_ABI_VERSION) JSF = a;
}
/* cache the frj trampoline CVs: the request path invokes them via
* call_sv + G_EVAL (no name lookup, croaks contained) */
OA_DEC_CV = SvREFCNT_inc((SV *)get_cv("Open::API::_frj_decode", GV_ADD));
OA_ENC_CV = SvREFCNT_inc((SV *)get_cv("Open::API::_frj_encode", GV_ADD));
}
# True when JSON::Schema::Fast's C ABI resolved and matched our vendored
# version. Open/API.pm croaks at load when it did not.
int
_abi_ok()
CODE:
RETVAL = JSF ? 1 : 0;
OUTPUT:
RETVAL
# Address of Open::API's own C ABI table (oa_abi.h). A consumer XS module
# (Punk's C dispatcher) fetches this once at boot, INT2PTRs it to a
# `const oa_abi *`, and checks ->abi_version before using it. Not part of the
# public Perl API.
IV
_abi_ptr()
CODE:
RETVAL = PTR2IV(&OA_ABI);
OUTPUT:
RETVAL
# Exercise the whole oa_abi table the way a C consumer (Punk) would: resolve
# it from the IV _abi_ptr hands back, gate on abi_version, then drive
# api_of -> route -> op_id -> validate through the function pointers. Returns a
# fixed 3-tuple the test compares against native match/validate_request:
# (undef, undef, undef) 404 - no such path
# (undef, \@allow, undef) 405 - path exists, wrong method
# ($op_id, undef, undef) matched; $raw undef, so no validation
# ($op_id, $ok, $ref) matched + validated: (1, \%params) or (0, \@errors)
# Private; the version guard returning empty stands in for a consumer's
# fall-back to the Perl-visible API.
void
_abi_selftest(self, method, path, raw)
SV *self
SV *method
SV *path
SV *raw
PPCODE:
{
const oa_abi *A = INT2PTR(const oa_abi *, PTR2IV(&OA_ABI));
STRLEN ml, pl;
const char *mp = SvPV_const(method, ml);
const char *pp = SvPV_const(path, pl);
void *api, *op;
HV *caps = (HV *)sv_2mortal((SV *)newHV());
AV *allow = (AV *)sv_2mortal((SV *)newAV());
SV *oid;
if (!A || A->abi_version != OA_ABI_VERSION) XSRETURN_EMPTY;
api = A->api_of(aTHX_ self);
if (!api) XSRETURN_EMPTY;
op = A->route(aTHX_ api, mp, ml, pp, pl, caps, allow);
if (!op) {
if (av_len(allow) >= 0) { /* 405 */
XPUSHs(&PL_sv_undef);
mXPUSHs(newRV_inc((SV *)allow));
XPUSHs(&PL_sv_undef);
} else { /* 404 */
XPUSHs(&PL_sv_undef);
XPUSHs(&PL_sv_undef);
XPUSHs(&PL_sv_undef);
}
} else {
oid = A->op_id(aTHX_ op);
mXPUSHs(oid ? newSVsv(oid) : &PL_sv_undef);
if (raw && SvROK(raw) && SvTYPE(SvRV(raw)) == SVt_PVHV) {
HV *typed = (HV *)sv_2mortal((SV *)newHV());
AV *errs = (AV *)sv_2mortal((SV *)newAV());
int ok = A->validate(aTHX_ api, op, (HV *)SvRV(raw),
typed, errs);
mXPUSHs(newSViv(ok));
mXPUSHs(ok ? newRV_inc((SV *)typed) : newRV_inc((SV *)errs));
} else {
XPUSHs(&PL_sv_undef);
XPUSHs(&PL_sv_undef);
}
}
}
# Direct frj-ABI trampolines. They croak on bad input (the ABI's semantics);
# the request path calls them on cached CVs with G_EVAL so a malformed body
# is a 400 and an unencodable handler return degrades cleanly. Private.
SV *
_frj_decode(text)
SV *text
CODE:
{
const frj_abi *J = oa_frj(aTHX);
STRLEN len;
const char *pv = SvPV_const(text, len);
RETVAL = J->decode(aTHX_ pv, len, NULL);
}
OUTPUT:
RETVAL
SV *
_frj_encode(val)
SV *val
CODE:
}
OUTPUT:
RETVAL
# One operation described: params by location, body content types, response
# statuses. Returns undef for an unknown operationId.
SV *
operation(self, id)
SV *self
SV *id
CODE:
{
oa_api *a = oa_api_of(aTHX_ self);
oa_op *o = oa_op_by_id(aTHX_ a, id);
if (!o) { RETVAL = &PL_sv_undef; }
else {
static const char *locs[OA_IN_N] =
{ "path", "query", "header", "cookie" };
HV *h = newHV(), *ph = newHV(), *bh = newHV();
AV *ra = newAV(), *ca = newAV();
int loc, i;
(void)hv_stores(h, "operationId", newSVsv(o->op_id));
(void)hv_stores(h, "method", newSVsv(o->method));
(void)hv_stores(h, "path", newSVsv(o->path));
for (loc = 0; loc < OA_IN_N; loc++) {
AV *pa = newAV();
for (i = 0; i < o->nparams[loc]; i++) {
HV *pe = newHV();
(void)hv_stores(pe, "name", newSVsv(o->params[loc][i].name));
(void)hv_stores(pe, "required",
newSViv(o->params[loc][i].required));
av_push(pa, newRV_noinc((SV *)pe));
}
(void)hv_store(ph, locs[loc], (I32)strlen(locs[loc]),
newRV_noinc((SV *)pa), 0);
}
(void)hv_stores(h, "params", newRV_noinc((SV *)ph));
for (i = 0; i < o->nbodies; i++)
av_push(ca, newSVsv(o->bodies[i].ctype));
(void)hv_stores(bh, "required", newSViv(o->body_required));
(void)hv_stores(bh, "content", newRV_noinc((SV *)ca));
(void)hv_stores(h, "body", newRV_noinc((SV *)bh));
for (i = 0; i < o->nresps; i++)
av_push(ra, newSVsv(o->resps[i].status));
(void)hv_stores(h, "responses", newRV_noinc((SV *)ra));
RETVAL = newRV_noinc((SV *)h);
}
}
OUTPUT:
RETVAL
# Route a (method, path) pair. List returns:
# matched: ($operationId, \%raw_path_captures)
# path, wrong method: (undef, \@allow) - a 405 with its Allow list
# no such path: () - a 404
void
match(self, method, path)
SV *self
SV *method
SV *path
PPCODE:
{
oa_api *a = oa_api_of(aTHX_ self);
STRLEN ml, pl;
const char *mp = SvPV_const(method, ml);
const char *pp = SvPV_const(path, pl);
HV *caps = (HV *)sv_2mortal((SV *)newHV());
AV *allow = (AV *)sv_2mortal((SV *)newAV());
oa_op *o = oa_route(aTHX_ a, mp, ml, pp, pl, caps, allow);
if (o) {
mXPUSHs(newSVsv(o->op_id));
mXPUSHs(newRV_inc((SV *)caps));
} else if (av_len(allow) >= 0) {
XPUSHs(&PL_sv_undef);
mXPUSHs(newRV_inc((SV *)allow));
}
/* else: empty list = 404 */
}
# Validate raw inputs for an operation. $raw is
# { path => \%captures, query => $string_or_hashref,
# header => \%lowercased, body => $raw_text_or_decoded_ref }
# List returns (1, \%params) or (0, \@errors).
void
validate_request(self, op_id, raw)
SV *self
SV *op_id
SV *raw
PPCODE:
{
oa_api *a = oa_api_of(aTHX_ self);
oa_op *o = oa_op_by_id(aTHX_ a, op_id);
HV *rh, *rawpath = NULL, *headers = NULL;
SV *query = NULL, *body = NULL, *e;
AV *errs;
HV *params = NULL;
int ok;
if (!o) croak("Open::API: unknown operationId '%s'", SvPV_nolen(op_id));
rh = oa_hv_of(raw);
if (!rh) croak("Open::API: validate_request needs a hashref of raw inputs");
rawpath = oa_hv_of(oa_get(aTHX_ rh, "path"));
headers = oa_hv_of(oa_get(aTHX_ rh, "header"));
query = oa_get(aTHX_ rh, "query");
body = oa_get(aTHX_ rh, "body");
errs = (AV *)sv_2mortal((SV *)newAV());
ok = oa_validate_op(aTHX_ a, o, rawpath, query, headers, body,
¶ms, errs);
PERL_UNUSED_VAR(e);
if (ok) {
mXPUSHs(newSViv(1));
mXPUSHs(newRV_noinc((SV *)params));
} else {
mXPUSHs(newSViv(0));
mXPUSHs(newRV_inc((SV *)errs));
}
}
MODULE = Open::API PACKAGE = Open::API::Plack
# Open::API::Plack->new(api => $api | spec => ..., handlers => {...},
# before => ..., after => ..., security => {...}, csrf => {...},
# headers => {...}, cors => {...}, max_body_size => N, negotiate => 0|1,
# error_format => 'json'|'problem', validate_responses => 0|1).
# Configuration only: options accumulate here and via the accessors, and
# everything is resolved, validated and compiled by to_app.
SV *
new(class, ...)
SV *class
CODE:
{
const char *cls = (SvROK(class) && SvOBJECT(SvRV(class)))
? HvNAME(SvSTASH(SvRV(class))) : SvPV_nolen(class);
HV *cfg = (HV *)sv_2mortal((SV *)newHV()); /* mortal until blessed */
int i;
for (i = 1; i + 1 < items; i += 2) {
STRLEN kl; const char *k = SvPV_const(ST(i), kl);
oa_plack_set(aTHX_ cfg, k, kl, ST(i + 1));
}
RETVAL = sv_bless(newRV_inc((SV *)cfg), gv_stashpv(cls, GV_ADD));
}
OUTPUT:
RETVAL
# $plack->handlers the live map hashref (created on first use)
# $plack->handlers(%pairs) merge, return $plack (chainable)
# $plack->handlers(\%map) merge, return $plack
# `security` is the same accessor for the scheme => checker map.
SV *
handlers(self, ...)
STRLEN bl; const char *bp = SvPV_const(bu, bl);
STRLEN i2, sep;
for (i2 = 0; i2 + 2 < bl; i2++)
if (bp[i2] == ':' && bp[i2+1] == '/' && bp[i2+2] == '/')
{ i2 += 3; break; }
if (i2 + 2 >= bl) i2 = 0;
for (sep = i2; sep < bl && bp[sep] != '/'; sep++) ;
(void)hv_stores(cd, "origin", newSVpvn(bp, sep));
}
(void)hv_stores(self, "_csrf", newRV_noinc((SV *)cd));
}
(void)hv_deletes(self, "_csrf_opt", G_DISCARD);
}
(void)hv_stores(self, "ua_opts", newRV_inc((SV *)ua_opts));
RETVAL = sv_bless(newRV_inc((SV *)self), gv_stashpv(cls, GV_ADD));
}
OUTPUT:
RETVAL
# Fire one operation: $client->call($operationId, %params). Flat %params are
# matched to the operation's declared parameters by name (body => the request
# body). Croaks on invalid input BEFORE any I/O; returns a Fetch::Future
# resolving to { status, headers, data, error? }.
SV *
call(self, op_id, ...)
SV *self
SV *op_id
CODE:
{
HV *params = (HV *)sv_2mortal((SV *)newHV());
int i;
if (!SvROK(self) || SvTYPE(SvRV(self)) != SVt_PVHV)
croak("Open::API::Client: not a client");
for (i = 2; i + 1 < items; i += 2) {
STRLEN kl; const char *k = SvPV_const(ST(i), kl);
(void)hv_store(params, k, (I32)kl, newSVsv(ST(i + 1)), 0);
}
RETVAL = oa_cli_call(aTHX_ (HV *)SvRV(self), op_id, params);
}
OUTPUT:
RETVAL
# True when the operationId exists (can() support; can stays pure Perl).
int
_has_op(self, name)
SV *self
SV *name
CODE:
RETVAL = (SvROK(self) && SvTYPE(SvRV(self)) == SVt_PVHV)
? oa_op_exists(aTHX_ (HV *)SvRV(self), name) : 0;
OUTPUT:
RETVAL
# $client->$operationId(%params) sugar. Perl sets $Open::API::Client::AUTOLOAD
# to the fully-qualified name; we dispatch straight to oa_cli_call (the same C
# path as ->call), skipping a Perl method hop. An unknown name croaks - a typo
# dies rather than silently 404ing.
void
AUTOLOAD(self, ...)
SV *self
PPCODE:
{
SV *avar = get_sv("Open::API::Client::AUTOLOAD", 0);
const char *full = NULL, *mp;
SV *op, *ret;
HV *params;
int i;
/* Perl hands an XSUB AUTOLOAD its method name one of two ways. Newer
* perls set $AUTOLOAD; perls through 5.14 skip that deliberately -
* rather than build the variable only for the XSUB to parse it back
* apart, gv_autoload stores the name in the CV's own PV slot - so
* $AUTOLOAD is simply undef there and a typo'd method silently
* returned empty instead of croaking. Read whichever one is present.
*
* Test SvPVX/SvCUR rather than SvPOK: gv_autoload does the assignment
* with SvPV_set/SvCUR_set and never turns the POK flag on, so the CV
* carries the name with POK clear. The CV holds no prototype that
* could be mistaken for it - PROTOTYPES is DISABLE above. */
if (avar && SvOK(avar)) full = SvPV_nolen(avar);
else if (SvPVX((SV *)cv) && SvCUR((SV *)cv)) full = SvPVX((SV *)cv);
if (!full) XSRETURN_EMPTY;
mp = strrchr(full, ':');
mp = mp ? mp + 1 : full;
if (strEQ(mp, "DESTROY")) XSRETURN_EMPTY;
op = sv_2mortal(newSVpv(mp, 0));
if (!(SvROK(self) && SvTYPE(SvRV(self)) == SVt_PVHV
&& oa_op_exists(aTHX_ (HV *)SvRV(self), op)))
croak("Open::API::Client: no such method or operation '%s'", mp);
params = (HV *)sv_2mortal((SV *)newHV());
for (i = 1; i + 1 < items; i += 2) {
STRLEN kl; const char *k = SvPV_const(ST(i), kl);
(void)hv_store(params, k, (I32)kl, newSVsv(ST(i + 1)), 0);
}
ret = oa_cli_call(aTHX_ (HV *)SvRV(self), op, params);
ST(0) = sv_2mortal(ret);
XSRETURN(1);
}
# can(): a real method if one exists (like UNIVERSAL::can - Open::API::Client
# has no @ISA, so the original SUPER::can collapsed to that), else a coderef
# for an operationId (so `$c->can($op)->($c, %p)` works), else undef.
SV *
can(self, method)
SV *self
SV *method
CODE:
{
const char *m = SvPV_nolen(method);
HV *stash = (SvROK(self) && SvOBJECT(SvRV(self))) ? SvSTASH(SvRV(self))
: SvPOK(self) ? gv_stashsv(self, 0) : NULL;
GV *gv;
RETVAL = &PL_sv_undef;
if (stash && (gv = gv_fetchmethod_autoload(stash, m, FALSE)) && GvCV(gv))
RETVAL = newRV_inc((SV *)GvCV(gv)); /* a real method */
else if (SvROK(self) && SvTYPE(SvRV(self)) == SVt_PVHV
&& oa_op_exists(aTHX_ (HV *)SvRV(self), method)) {
AV *cap = newAV();
av_push(cap, newSVsv(method)); /* capture the op id */
RETVAL = oa_closure(aTHX_ oa_op_call_cb, cap); /* +1 owned coderef */
}
}
( run in 1.619 second using v1.01-cache-2.11-cpan-4e7a2411597 )