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

#define PERL_NO_GET_CONTEXT
#ifdef __cplusplus
extern "C++" {
#include <algorithm>
}
#endif
extern "C" {
#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"
}
static MGVTBL sv_payload_marker;
static bool optimize_entersub = 1;
static int unstolen = 0;
#include "xs/compat.h"
#include "xs/types.h"
#include "xs/accessors.h"
#include "xs/installer.h"
static void
CAIXS_install_inherited_accessor(pTHX_ SV* full_name, SV* hash_key, SV* pkg_key, SV* read_cb, SV* write_cb, int opts) {
shared_keys* payload;
bool need_cb = read_cb && write_cb;
if (need_cb) {
assert(pkg_key != NULL);
if (opts & IsNamed) {
payload = CAIXS_install_accessor<InheritedCbNamed>(aTHX_ full_name, (AccessorOpts)(opts & ~IsNamed));
} else {
payload = CAIXS_install_accessor<InheritedCb>(aTHX_ full_name, (AccessorOpts)opts);
}
} else if (pkg_key != NULL) {
payload = CAIXS_install_accessor<Inherited>(aTHX_ full_name, (AccessorOpts)opts);
} else {
payload = CAIXS_install_accessor<ObjectOnly>(aTHX_ full_name, (AccessorOpts)opts);
}
STRLEN len;
const char* hash_key_buf = SvPV_const(hash_key, len);
SV* s_hash_key = newSVpvn_share(hash_key_buf, SvUTF8(hash_key) ? -(I32)len : (I32)len, 0);
payload->hash_key = s_hash_key;
if (pkg_key != NULL) {
const char* pkg_key_buf = SvPV_const(pkg_key, len);
SV* s_pkg_key = newSVpvn_share(pkg_key_buf, SvUTF8(pkg_key) ? -(I32)len : (I32)len, 0);
payload->pkg_key = s_pkg_key;
}
if (need_cb) {
if (SvROK(read_cb) && SvTYPE(SvRV(read_cb)) == SVt_PVCV) {
payload->read_cb = SvREFCNT_inc_NN(SvRV(read_cb));
} else {
payload->read_cb = NULL;
}
if (SvROK(write_cb) && SvTYPE(SvRV(write_cb)) == SVt_PVCV) {
payload->write_cb = SvREFCNT_inc_NN(SvRV(write_cb));
} else {
payload->write_cb = NULL;
}
}
}
static void
CAIXS_install_class_accessor(pTHX_ SV* full_name, SV* default_sv, bool is_varclass, int opts) {
bool is_lazy = SvROK(default_sv) && SvTYPE(SvRV(default_sv)) == SVt_PVCV;
shared_keys* payload;
if (is_lazy) {
payload = CAIXS_install_accessor<LazyClass>(aTHX_ full_name, (AccessorOpts)opts);
} else {
payload = CAIXS_install_accessor<PrivateClass>(aTHX_ full_name, (AccessorOpts)opts);
}
if (is_varclass) {
GV* gv = gv_fetchsv(full_name, GV_ADD, SVt_PV);
assert(gv);
payload->storage = GvSV(gv);
assert(payload->storage);
/* We take ownership of this glob slot, so if someone changes the glob - they're in trouble */
SvREFCNT_inc_simple_void_NN(payload->storage);
} else {
payload->storage = newSV(0);
}
if (SvOK(default_sv)) {
if (is_lazy) {
payload->lazy_cb = SvREFCNT_inc_NN(SvRV(default_sv));
} else {
sv_setsv(payload->storage, default_sv);
}
}
}
MODULE = Class::Accessor::Inherited::XS PACKAGE = Class::Accessor::Inherited::XS
PROTOTYPES: DISABLE
BOOT:
{
SV** check_env = hv_fetch(GvHV(PL_envgv), "CAIXS_DISABLE_ENTERSUB", 22, 0);
if (check_env && SvTRUE(*check_env)) optimize_entersub = 0;
#ifdef CAIX_OPTIMIZE_OPMETHOD
MUTEX_LOCK(&PL_my_ctx_mutex);
qsort(accessor_map, ACCESSOR_MAP_SIZE, sizeof(accessor_cb_pair_t), CAIXS_map_compare);
MUTEX_UNLOCK(&PL_my_ctx_mutex);
#endif
HV* stash = gv_stashpv("Class::Accessor::Inherited::XS", 0);
newCONSTSUB(stash, "BINARY_UNSAFE", CAIX_BINARY_UNSAFE_RESULT);
newCONSTSUB(stash, "OPTIMIZED_OPMETHOD", CAIX_OPTIMIZE_OPMETHOD_RESULT);
}
void
install_object_accessor(SV* full_name, SV* hash_key, int opts)
PPCODE:
{
CAIXS_install_inherited_accessor(aTHX_ full_name, hash_key, NULL, NULL, NULL, opts);
XSRETURN_UNDEF;
}
void
install_inherited_accessor(SV* full_name, SV* hash_key, SV* pkg_key, int opts)
PPCODE:
{
CAIXS_install_inherited_accessor(aTHX_ full_name, hash_key, pkg_key, NULL, NULL, opts);
XSRETURN_UNDEF;
}
void
install_inherited_cb_accessor(SV* full_name, SV* hash_key, SV* pkg_key, SV* read_cb, SV* write_cb, int opts)
PPCODE:
{
CAIXS_install_inherited_accessor(aTHX_ full_name, hash_key, pkg_key, read_cb, write_cb, opts);
XSRETURN_UNDEF;
}
void
install_class_accessor(SV* full_name, SV* default_sv, SV* is_varclass, SV* opts)
PPCODE:
{
CAIXS_install_class_accessor(aTHX_ full_name, default_sv, SvTRUE(is_varclass), SvIV(opts));
XSRETURN_UNDEF;
}
void
install_constructor(SV* full_name)
PPCODE:
{
CAIXS_install_cv<Constructor, None>(aTHX_ full_name);
XSRETURN_UNDEF;
}
MODULE = Class::Accessor::Inherited::XS PACKAGE = Class::Accessor::Inherited::XS::Constants
PROTOTYPES: DISABLE
BOOT:
{
HV* stash = gv_stashpv("Class::Accessor::Inherited::XS::Constants", GV_ADD);
AV* exp = get_av("Class::Accessor::Inherited::XS::Constants::EXPORT", GV_ADD);
#define RGSTR(c) \
newCONSTSUB(stash, #c , newSViv(c)); \
av_push(exp, newSVpvn(#c, strlen(#c)));
RGSTR(None);
RGSTR(IsReadonly);
RGSTR(IsWeak);
RGSTR(IsNamed);
AV* isa = get_av("Class::Accessor::Inherited::XS::Constants::ISA", GV_ADD);
av_push(isa, newSVpvs("Exporter"));
hv_stores(get_hv("INC", GV_ADD), "Class/Accessor/Inherited/XS/Constants.pm", &PL_sv_yes);
}
MODULE = Class::Accessor::Inherited::XS PACKAGE = Class::Accessor::Inherited::XS::Debug
PROTOTYPES: DISABLE
void unstolen_count()
PPCODE:
{
XSRETURN_IV(unstolen);
}