view release on metacpan or  search on metacpan

XS.xs  view on Meta::CPAN

                                                                             \
    if ((svp = CXSA_HASH_FETCH(                                              \
            object, readfrom.accessor_name, readfrom.accessor_len,           \
            readfrom.hash)))                                                 \
    {                                                                        \
        PUSHs(*svp);                                                         \
        XSRETURN(1);                                                         \
    }                                                                        \
                                                                             \
    if (readfrom.default_value != NULL)                                      \
    {                                                                        \
        SV **retval;                                                         \
        if (readfrom.default_coderef) {                                      \
            /* Coderef to generate defautl value */                          \
          {                                                                  \
            ENTER;                                                           \
            SAVETMPS;                                                        \
            PUSHMARK(SP);                                                    \
            XPUSHs(self);                                                    \
            PUTBACK;                                                         \
            int number =                                                     \
                call_sv(SvRV(readfrom.default_value),                        \
                  G_SCALAR|G_EVAL|G_KEEPERR);                                \
            SPAGAIN;                                                         \
            if (number == 1) {                                               \
                retval = &POPs;                                              \
            } else {                                                         \
                XSRETURN_UNDEF;                                              \
            }                                                                \
            retval = hv_store(                                               \
                    object, readfrom.accessor_name, readfrom.accessor_len,   \
                    newSVsv(*retval), readfrom.hash);                        \
            if (!retval) {                                                   \
                warn("hv_store failed\n\n\n\n");                             \
                XSRETURN_UNDEF;                                              \
            }                                                                \
            PUTBACK;                                                         \
            FREETMPS;                                                        \
            LEAVE;                                                           \
          }                                                                  \
        } else {                                                             \
            retval = hv_store(                                               \
                object, readfrom.accessor_name, readfrom.accessor_len,       \
                newSVsv(readfrom.default_value), readfrom.hash);             \
        }                                                                    \
        PUSHs(*retval);                                                      \
        XSRETURN(1);                                                         \
    }                                                                        \
    XSRETURN_UNDEF;                                                          \

void
accessor_init(self, ...)
    SV *self;
ALIAS:
INIT:
    /* Get the const hash key struct from the global storage */
    /* ix is the magic integer variable that is set by the perl guts for us.
     * We uses it to identify the currently running alias of the accessor. Gollum! */
    const autoxs_hashkey readfrom = CXSAccessor_hashkeys[ix];
    SV** svp;
PPCODE:
    CXAH_OPTIMIZE_ENTERSUB(accessor);
    ACCESSOR_BODY

void
accessor(self, ...)
    SV* self;
ALIAS:
INIT:
    /* Get the const hash key struct from the global storage */
    /* ix is the magic integer variable that is set by the perl guts for us.
    * We uses it to identify the currently running alias of the accessor. Gollum! */
    const autoxs_hashkey readfrom = CXSAccessor_hashkeys[ix];
    SV** svp;
PPCODE:
    ACCESSOR_BODY


void
attr(caller_obj, name, ...)
    SV *caller_obj;
    SV *name;
PREINIT:
    char *cstname = SvPV_nolen(PL_curstname);
    SV *default_value = items > 2 ? ST(2) : NULL;
    const char *caller = SvROK(caller_obj) ?
        sv_reftype(SvRV(caller_obj), TRUE) :
        SvPV_nolen(caller_obj);
CODE:
    if (items > 3) {
        croak("Attribute generator called with too many arguments");
        return;
    }

    if (SvROK(name) && SvTYPE(SvRV(name)) == SVt_PVAV) {
        int i;
        for (i = av_len((AV*)SvRV(name)); i >= 0; i--) {
            CV* cv;
            SV **elem = av_fetch((AV*)SvRV(name), i, 0);
            INSTALL_NEW_CV_HASH_OBJ(
                caller, CXAH(accessor_init),
                SvPV_nolen(*elem), default_value);
        }
    } else {
        CV* cv;
        INSTALL_NEW_CV_HASH_OBJ(
            caller, CXAH(accessor_init), SvPV_nolen(name), default_value);
    }
    PUSHs(caller_obj);

#define CONSTRUCTOR_BODY                                                         \
    classname = SvROK(class)       ?                                             \
        sv_reftype(SvRV(class), 1) :                                             \
        SvPV_nolen_const(class);                                                 \
    hash = newHV();                                                              \
    if (items > 2) {                                                             \
        for (iStack = 1; iStack < items; iStack += 2) {                          \
            /* we could check for the hv_store_ent return value,          */     \
            /* but perl doesn't in this situation (see pp_anonhash)       */     \
            (void)hv_store_ent(                                                  \
                hash, ST(iStack),                                                \
                newSVsv(iStack > items ? &PL_sv_undef : ST(iStack+1)), 0);       \
        }                                                                        \
    } else if (items > 1) {                                                      \
        HV *hv_hashopt;                                                          \
        SV *optref = ST(1);                                                      \
        if (SvROK(optref) &&                                                     \
            SvTYPE((hv_hashopt = (HV*)SvRV(optref))) == SVt_PVHV) {              \
            I32 key_len;                                                         \
            char *key;                                                           \
            SV *val;                                                             \
            hv_iterinit(hv_hashopt);                                             \
            while ((val = hv_iternextsv(hv_hashopt, &key, &key_len))) {          \
                (void)hv_common_key_len(                                         \
                    hash, key, key_len,  HV_FETCH_ISSTORE, newSVsv(val), 0);     \
            }                                                                    \
        } else {                                                                 \
            croak("Not a hash reference");                                       \
        }                                                                        \
    }                                                                            \
    obj = sv_bless(newRV_noinc((SV *)hash), gv_stashpv(classname, 1));           \
    PUSHs(sv_2mortal(obj));                                                      \

void
constructor_init(class, ...)
    SV* class;
  PREINIT:
    int iStack;
    HV* hash;
    SV* obj;
    const char* classname;
  PPCODE:
    CXAH_OPTIMIZE_ENTERSUB(constructor);
    CONSTRUCTOR_BODY


void
constructor(class, ...)
    SV* class;
  PREINIT:
    int iStack;
    HV* hash;
    SV* obj;
    const char* classname;
  PPCODE:
    CONSTRUCTOR_BODY

void
newxs_constructor(name)
  char* name;
  PPCODE:
    INSTALL_NEW_CV(name, CXAH(constructor_init));

void
newxs_attr(name)
  char* name;
  PPCODE:
    INSTALL_NEW_CV(name, CXAH(attr));