view release on metacpan or  search on metacpan

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)))
        PUSHs(svp[0]);
      else
        XSRETURN_UNDEF;
    }

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 */
        CvLVALUE_on(cv);
        break;
      }
    case 2: /* newxs_predicate */
      INSTALL_NEW_CV_ARRAY_OBJ(name, CXAA(predicate), index);
      break;
    default:
      croak("Invalid alias of newxs_getter called");
      break;
    }

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);
    }