Class-XSAccessor

 view release on metacpan or  search on metacpan

XS/Array.xs  view on Meta::CPAN

void
getter(self)
    SV* self;
  ALIAS:
  INIT:
    /* Get the array index 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 I32 index = CXSAccessor_arrayindices[ix];
    SV** svp;
  PPCODE:
    CXA_CHECK_ARRAY(self);
    CXAA_OPTIMIZE_ENTERSUB(getter);
    if ((svp = av_fetch((AV *)SvRV(self), index, 1)))
      PUSHs(svp[0]);
    else
      XSRETURN_UNDEF;

void
lvalue_accessor(self)
    SV* self;
  ALIAS:
  INIT:
    /* Get the array index 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 I32 index = CXSAccessor_arrayindices[ix];
    SV** svp;
    SV* sv;
  PPCODE:
    CXA_CHECK_ARRAY(self);
    CXAA_OPTIMIZE_ENTERSUB(lvalue_accessor);
    if ((svp = av_fetch((AV *)SvRV(self), index, 1))) {
      sv = *svp;
      sv_upgrade(sv, SVt_PVLV);
      sv_magic(sv, 0, PERL_MAGIC_ext, Nullch, 0);
      SvSMAGICAL_on(sv);
      LvTYPE(sv) = '~';
      SvREFCNT_inc(sv);
      LvTARG(sv) = SvREFCNT_inc(sv);

XS/Array.xs  view on Meta::CPAN

void
setter(self, newvalue)
    SV* self;
    SV* newvalue;
  ALIAS:
  INIT:
    /* Get the array index 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 I32 index = CXSAccessor_arrayindices[ix];
  PPCODE:
    CXA_CHECK_ARRAY(self);
    CXAA_OPTIMIZE_ENTERSUB(setter);
    if (NULL == av_store((AV*)SvRV(self), index, newSVsv(newvalue)))
      croak("Failed to write new value to array.");
    PUSHs(newvalue);

void
chained_setter(self, newvalue)
    SV* self;
    SV* newvalue;
  ALIAS:
  INIT:
    /* Get the array index 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 I32 index = CXSAccessor_arrayindices[ix];
  PPCODE:
    CXA_CHECK_ARRAY(self);
    CXAA_OPTIMIZE_ENTERSUB(chained_setter);
    if (NULL == av_store((AV*)SvRV(self), index, newSVsv(newvalue)))
      croak("Failed to write new value to array.");
    PUSHs(self);

void
accessor(self, ...)
    SV* self;
  ALIAS:
  INIT:
    /* Get the array index 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 I32 index = CXSAccessor_arrayindices[ix];
    SV** svp;
  PPCODE:
    CXA_CHECK_ARRAY(self);
    CXAA_OPTIMIZE_ENTERSUB(accessor);
    if (items > 1) {
      SV* newvalue = ST(1);
      if (NULL == av_store((AV*)SvRV(self), index, newSVsv(newvalue)))
        croak("Failed to write new value to array.");
      PUSHs(newvalue);
    }
    else {
      if ((svp = av_fetch((AV *)SvRV(self), index, 1)))

XS/Array.xs  view on Meta::CPAN

void
chained_accessor(self, ...)
    SV* self;
  ALIAS:
  INIT:
    /* Get the array index 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 I32 index = CXSAccessor_arrayindices[ix];
    SV** svp;
  PPCODE:
    CXA_CHECK_ARRAY(self);
    CXAA_OPTIMIZE_ENTERSUB(chained_accessor);
    if (items > 1) {
      SV* newvalue = ST(1);
      if (NULL == av_store((AV*)SvRV(self), index, newSVsv(newvalue)))
        croak("Failed to write new value to array.");
      PUSHs(self);
    }
    else {
      if ((svp = av_fetch((AV *)SvRV(self), index, 1)))

XS/Array.xs  view on Meta::CPAN

void
predicate(self)
    SV* self;
  ALIAS:
  INIT:
    /* Get the array index 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 I32 index = CXSAccessor_arrayindices[ix];
    SV** svp;
  PPCODE:
    CXA_CHECK_ARRAY(self);
    CXAA_OPTIMIZE_ENTERSUB(predicate);
    if ( (svp = av_fetch((AV *)SvRV(self), index, 1)) && SvOK(svp[0]) )
      XSRETURN_YES;
    else
      XSRETURN_NO;

void
constructor(class, ...)
    SV* class;
  PREINIT:
    AV* array;
    SV* obj;
    const char* classname;
  PPCODE:
    CXAA_OPTIMIZE_ENTERSUB(constructor);

    classname = SvROK(class) ? sv_reftype(SvRV(class), 1) : SvPV_nolen_const(class);
    array = newAV();
    obj = sv_bless( newRV_noinc((SV*)array), gv_stashpv(classname, 1) );
    /* we ignore arguments. See Class::XSAccessor's XS code for
     * how we'd use them in case of bless {@_} => $class.
     */
    PUSHs(sv_2mortal(obj));

void
newxs_getter(namesv, index)
    SV *namesv;
    U32 index;
  ALIAS:
    Class::XSAccessor::Array::newxs_lvalue_accessor = 1
    Class::XSAccessor::Array::newxs_predicate       = 2
  PREINIT:
    char *name;
    STRLEN namelen;
  PPCODE:
    name = SvPV(namesv, namelen);
    switch (ix) {
    case 0: /* newxs_getter */
      INSTALL_NEW_CV_ARRAY_OBJ(name, CXAA(getter), index);
      break;
    case 1: /* newxs_lvalue_accessor */
      {
        CV* cv;
        INSTALL_NEW_CV_ARRAY_OBJ(name, CXAA(lvalue_accessor), index);
        /* Make the CV lvalue-able. "cv" was set by the previous macro */

XS/Array.xs  view on Meta::CPAN

void
newxs_setter(namesv, index, chained)
    SV *namesv;
    U32 index;
    bool chained;
  ALIAS:
    Class::XSAccessor::Array::newxs_accessor = 1
  PREINIT:
    char *name;
    STRLEN namelen;
  PPCODE:
    name = SvPV(namesv, namelen);
    if (ix == 0) { /* newxs_setter */
      if (chained)
        INSTALL_NEW_CV_ARRAY_OBJ(name, CXAA(chained_setter), index);
      else
        INSTALL_NEW_CV_ARRAY_OBJ(name, CXAA(setter), index);
    }
    else { /* newxs_accessor */
      if (chained)
        INSTALL_NEW_CV_ARRAY_OBJ(name, CXAA(chained_accessor), index);
      else
        INSTALL_NEW_CV_ARRAY_OBJ(name, CXAA(accessor), index);
    }

void
newxs_constructor(namesv)
    SV *namesv;
  PREINIT:
    char *name;
    STRLEN namelen;
  PPCODE:
    name = SvPV(namesv, namelen);
    INSTALL_NEW_CV(name, CXAA(constructor));

XS/Hash.xs  view on Meta::CPAN

MODULE = Class::XSAccessor        PACKAGE = Class::XSAccessor
PROTOTYPES: DISABLE

void
getter(self)
    SV* self;
  INIT:
    /* Get the const hash key struct from the global storage */
    const autoxs_hashkey * readfrom = CXAH_GET_HASHKEY;
    SV** svp;
  PPCODE:
    CXA_CHECK_HASH(self);
    CXAH_OPTIMIZE_ENTERSUB(getter);
    if ((svp = CXSA_HASH_FETCH((HV *)SvRV(self), readfrom->key, readfrom->len, readfrom->hash)))
      PUSHs(*svp);
    else
      XSRETURN_UNDEF;

void
lvalue_accessor(self)
    SV* self;
  INIT:
    /* Get the const hash key struct from the global storage */
    const autoxs_hashkey * readfrom = CXAH_GET_HASHKEY;
    SV** svp;
    SV* sv;
  PPCODE:
    CXA_CHECK_HASH(self);
    CXAH_OPTIMIZE_ENTERSUB(lvalue_accessor);
    if ((svp = CXSA_HASH_FETCH_LVALUE((HV *)SvRV(self), readfrom->key, readfrom->len, readfrom->hash))) {
      sv = *svp;
      sv_upgrade(sv, SVt_PVLV);
      sv_magic(sv, 0, PERL_MAGIC_ext, Nullch, 0);
      SvSMAGICAL_on(sv);
      LvTYPE(sv) = '~';
      SvREFCNT_inc(sv);
      LvTARG(sv) = SvREFCNT_inc(sv);

XS/Hash.xs  view on Meta::CPAN

    else
      XSRETURN_UNDEF;

void
setter(self, newvalue)
    SV* self;
    SV* newvalue;
  INIT:
    /* Get the const hash key struct from the global storage */
    const autoxs_hashkey * readfrom = CXAH_GET_HASHKEY;
  PPCODE:
    CXA_CHECK_HASH(self);
    CXAH_OPTIMIZE_ENTERSUB(setter);
    if (NULL == hv_store((HV*)SvRV(self), readfrom->key, readfrom->len, newSVsv(newvalue), readfrom->hash))
      croak("Failed to write new value to hash.");
    PUSHs(newvalue);

void
chained_setter(self, newvalue)
    SV* self;
    SV* newvalue;
  INIT:
    /* Get the const hash key struct from the global storage */
    const autoxs_hashkey * readfrom = CXAH_GET_HASHKEY;
  PPCODE:
    CXA_CHECK_HASH(self);
    CXAH_OPTIMIZE_ENTERSUB(chained_setter);
    if (NULL == hv_store((HV*)SvRV(self), readfrom->key, readfrom->len, newSVsv(newvalue), readfrom->hash))
      croak("Failed to write new value to hash.");
    PUSHs(self);

void
accessor(self, ...)
    SV* self;
  INIT:
    /* Get the const hash key struct from the global storage */
    const autoxs_hashkey * readfrom = CXAH_GET_HASHKEY;
    SV** svp;
  PPCODE:
    CXA_CHECK_HASH(self);
    CXAH_OPTIMIZE_ENTERSUB(accessor);
    if (items > 1) {
      SV* newvalue = ST(1);
      if (NULL == hv_store((HV*)SvRV(self), readfrom->key, readfrom->len, newSVsv(newvalue), readfrom->hash))
        croak("Failed to write new value to hash.");
      PUSHs(newvalue);
    }
    else {
      if ((svp = CXSA_HASH_FETCH((HV *)SvRV(self), readfrom->key, readfrom->len, readfrom->hash)))

XS/Hash.xs  view on Meta::CPAN

        XSRETURN_UNDEF;
    }

void
chained_accessor(self, ...)
    SV* self;
  INIT:
    /* Get the const hash key struct from the global storage */
    const autoxs_hashkey * readfrom = CXAH_GET_HASHKEY;
    SV** svp;
  PPCODE:
    CXA_CHECK_HASH(self);
    CXAH_OPTIMIZE_ENTERSUB(chained_accessor);
    if (items > 1) {
      SV* newvalue = ST(1);
      if (NULL == hv_store((HV*)SvRV(self), readfrom->key, readfrom->len, newSVsv(newvalue), readfrom->hash))
        croak("Failed to write new value to hash.");
      PUSHs(self);
    }
    else {
      if ((svp = CXSA_HASH_FETCH((HV *)SvRV(self), readfrom->key, readfrom->len, readfrom->hash)))

XS/Hash.xs  view on Meta::CPAN

      else
        XSRETURN_UNDEF;
    }

void
exists_predicate(self)
    SV* self;
  INIT:
    /* Get the const hash key struct from the global storage */
    const autoxs_hashkey * readfrom = CXAH_GET_HASHKEY;
  PPCODE:
    CXA_CHECK_HASH(self);
    CXAH_OPTIMIZE_ENTERSUB(exists_predicate);
    if ( CXSA_HASH_EXISTS((HV *)SvRV(self), readfrom->key, readfrom->len, readfrom->hash) != NULL )
      XSRETURN_YES;
    else
      XSRETURN_NO;

void
defined_predicate(self)
    SV* self;
  INIT:
    /* Get the const hash key struct from the global storage */
    const autoxs_hashkey * readfrom = CXAH_GET_HASHKEY;
    SV** svp;
  PPCODE:
    CXA_CHECK_HASH(self);
    CXAH_OPTIMIZE_ENTERSUB(defined_predicate);
    if ( ((svp = CXSA_HASH_FETCH((HV *)SvRV(self), readfrom->key, readfrom->len, readfrom->hash))) && SvOK(*svp) )
      XSRETURN_YES;
    else
      XSRETURN_NO;

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

    classname = SvROK(class) ? sv_reftype(SvRV(class), 1) : SvPV_nolen_const(class);
    hash = newHV();
    obj = sv_bless(newRV_noinc((SV *)hash), gv_stashpv(classname, 1));

    if (items > 1) {
      /* if @_ - 1 (for $class) is even: most compilers probably convert items % 2 into this, but just in case */
      if (items & 1) {
        for (iStack = 1; iStack < items; iStack += 2) {

XS/Hash.xs  view on Meta::CPAN

      } else {
        croak("Uneven number of arguments to constructor.");
      }
    }

    PUSHs(sv_2mortal(obj));

void
constant_false(self)
  SV *self;
  PPCODE:
    PERL_UNUSED_VAR(self);
    CXAH_OPTIMIZE_ENTERSUB(constant_false);
    {
      XSRETURN_NO;
    }

void
constant_true(self)
    SV* self;
  PPCODE:
    PERL_UNUSED_VAR(self);
    CXAH_OPTIMIZE_ENTERSUB(constant_true);
    {
      XSRETURN_YES;
    }

void
test(self, ...)
    SV* self;
  INIT:
    /* Get the const hash key struct from the global storage */
    const autoxs_hashkey * readfrom = CXAH_GET_HASHKEY;
    SV** svp;
  PPCODE:
    CXA_CHECK_HASH(self);
    warn("cxah: accessor: inside test");
    CXAH_OPTIMIZE_ENTERSUB_TEST(test);
    if (items > 1) {
      SV* newvalue = ST(1);
      if (NULL == hv_store((HV*)SvRV(self), readfrom->key, readfrom->len, newSVsv(newvalue), readfrom->hash))
        croak("Failed to write new value to hash.");
      PUSHs(newvalue);
    }
    else {

XS/Hash.xs  view on Meta::CPAN

    SV *keysv;
  ALIAS:
    Class::XSAccessor::newxs_lvalue_accessor = 1
    Class::XSAccessor::newxs_predicate = 2
    Class::XSAccessor::newxs_defined_predicate = 3
    Class::XSAccessor::newxs_exists_predicate = 4
  PREINIT:
    char *name;
    char *key;
    STRLEN namelen, keylen;
  PPCODE:
    name = SvPV(namesv, namelen);
    key = SvPV(keysv, keylen);
    switch (ix) {
    case 0: /* newxs_getter */
      INSTALL_NEW_CV_HASH_OBJ(name, CXAH(getter), key, keylen);
      break;
    case 1: { /* newxs_lvalue_accessor */
        CV* cv;
        INSTALL_NEW_CV_HASH_OBJ(name, CXAH(lvalue_accessor), key, keylen);
        /* Make the CV lvalue-able. "cv" was set by the previous macro */

XS/Hash.xs  view on Meta::CPAN

newxs_setter(namesv, keysv, chained)
    SV *namesv;
    SV *keysv;
    bool chained;
  ALIAS:
    Class::XSAccessor::newxs_accessor = 1
  PREINIT:
    char *name;
    char *key;
    STRLEN namelen, keylen;
  PPCODE:
    name = SvPV(namesv, namelen);
    key = SvPV(keysv, keylen);
    if (ix == 0) { /* newxs_setter */
    if (chained)
      INSTALL_NEW_CV_HASH_OBJ(name, CXAH(chained_setter), key, keylen);
    else
      INSTALL_NEW_CV_HASH_OBJ(name, CXAH(setter), key, keylen);
    }
    else { /* newxs_accessor */
      if (chained)

XS/Hash.xs  view on Meta::CPAN

      else
        INSTALL_NEW_CV_HASH_OBJ(name, CXAH(accessor), key, keylen);
    }

void
newxs_constructor(namesv)
    SV *namesv;
  PREINIT:
    char *name;
    STRLEN namelen;
  PPCODE:
    name = SvPV(namesv, namelen);
    INSTALL_NEW_CV(name, CXAH(constructor));

void
newxs_boolean(namesv, truth)
    SV *namesv;
    bool truth;
  PREINIT:
    char *name;
    STRLEN namelen;
  PPCODE:
    name = SvPV(namesv, namelen);
    if (truth)
      INSTALL_NEW_CV(name, CXAH(constant_true));
    else
      INSTALL_NEW_CV(name, CXAH(constant_false));

void
newxs_test(namesv, keysv)
    SV *namesv;
    SV *keysv;
  PREINIT:
    char *name;
    char *key;
    STRLEN namelen, keylen;
  PPCODE:
    name = SvPV(namesv, namelen);
    key = SvPV(keysv, keylen);
    INSTALL_NEW_CV_HASH_OBJ(name, CXAH(test), key, keylen);


XS/HashCACompat.xs  view on Meta::CPAN

void
array_setter_init(self, ...)
    SV* self;
  INIT:
    /* NOTE: This method is for Class::Accessor compatibility only. It's not
     *       part of the normal API! */
    SV* newvalue = NULL; /* squelch may-be-used-uninitialized warning that doesn't apply */
    SV ** hashAssignRes;
    /* Get the const hash key struct from the global storage */
    const autoxs_hashkey * readfrom = CXAH_GET_HASHKEY;
  PPCODE:
    CXA_CHECK_HASH(self);
    CXAH_OPTIMIZE_ENTERSUB(array_setter);
    if (items == 2) {
      newvalue = newSVsv(ST(1));
    }
    else if (items > 2) {
      I32 i;
      AV* tmp = newAV();
      av_extend(tmp, items-1);
      for (i = 1; i < items; ++i) {

XS/HashCACompat.xs  view on Meta::CPAN

void
array_setter(self, ...)
    SV* self;
  INIT:
    /* NOTE: This method is for Class::Accessor compatibility only. It's not
     *       part of the normal API! */
    SV* newvalue = NULL; /* squelch may-be-used-uninitialized warning that doesn't apply */
    SV ** hashAssignRes;
    /* Get the const hash key struct from the global storage */
    const autoxs_hashkey * readfrom = CXAH_GET_HASHKEY;
  PPCODE:
    CXA_CHECK_HASH(self);
    if (items == 2) {
      newvalue = newSVsv(ST(1));
    }
    else if (items > 2) {
      I32 i;
      AV* tmp = newAV();
      av_extend(tmp, items-1);
      for (i = 1; i < items; ++i) {
        newvalue = newSVsv(ST(i));

XS/HashCACompat.xs  view on Meta::CPAN


void
array_accessor_init(self, ...)
    SV* self;
  INIT:
    /* NOTE: This method is for Class::Accessor compatibility only. It's not
     *       part of the normal API! */
    SV ** hashAssignRes;
    /* Get the const hash key struct from the global storage */
    const autoxs_hashkey * readfrom = CXAH_GET_HASHKEY;
  PPCODE:
    CXA_CHECK_HASH(self);
    CXAH_OPTIMIZE_ENTERSUB(array_accessor);
    if (items == 1) {
      SV** svp;
      if ((svp = CXSA_HASH_FETCH((HV *)SvRV(self), readfrom->key, readfrom->len, readfrom->hash)))
        PUSHs(*svp);
      else
        XSRETURN_UNDEF;
    }
    else { /* writing branch */

XS/HashCACompat.xs  view on Meta::CPAN


void
array_accessor(self, ...)
    SV* self;
  INIT:
    /* NOTE: This method is for Class::Accessor compatibility only. It's not
     *       part of the normal API! */
    SV ** hashAssignRes;
    /* Get the const hash key struct from the global storage */
    const autoxs_hashkey * readfrom = CXAH_GET_HASHKEY;
  PPCODE:
    CXA_CHECK_HASH(self);
    if (items == 1) {
      SV** svp;
      if ((svp = CXSA_HASH_FETCH((HV *)SvRV(self), readfrom->key, readfrom->len, readfrom->hash)))
        PUSHs(*svp);
      else
        XSRETURN_UNDEF;
    }
    else { /* writing branch */
      SV* newvalue;

XS/HashCACompat.xs  view on Meta::CPAN

    } /* end writing branch */

void
_newxs_compat_setter(namesv, keysv)
    SV *namesv;
    SV *keysv;
  PREINIT:
    char *name;
    char *key;
    STRLEN namelen, keylen;
  PPCODE:
    name = SvPV(namesv, namelen);
    key = SvPV(keysv, keylen);
    /* WARNING: If this is called in your code, you're doing it WRONG! */
    INSTALL_NEW_CV_HASH_OBJ(name, CXAH(array_setter_init), key, keylen);

void
_newxs_compat_accessor(namesv, keysv)
    SV *namesv;
    SV *keysv;
  PREINIT:
    char *name;
    char *key;
    STRLEN namelen, keylen;
  PPCODE:
    name = SvPV(namesv, namelen);
    key = SvPV(keysv, keylen);
    /* WARNING: If this is called in your code, you're doing it WRONG! */
    INSTALL_NEW_CV_HASH_OBJ(name, CXAH(array_accessor_init), key, keylen);



( run in 1.068 second using v1.01-cache-2.11-cpan-71847e10f99 )