Object-Pad

 view release on metacpan or  search on metacpan

Changes  view on Meta::CPAN

         * Trim whitespace within :attribute values (RT140109)

        [BUGFIXES]
         * Early seal on outer class when deriving an inner subclass of it
         * Store the real slotix in fasthook cache, not its index within the
           direct_slots AV

0.57    2021-11-18
        [CHANGES]
         * Defined new ABI version for class/slot hooks
            + Adds `funcdata` at registration and callback time
            + Adds MOP accessor functions for slotmeta default SV
         * Added :isa() and :does() class attributes; encourage those rather
           than the older keyword style
         * Added more MOP methods:
            + $classmeta->direct_methods, ->get_direct_method
            + $classmeta->all_methods, ->get_method
            + $slotmeta->has_attribute, ->get_attribute_value
         * Added Object::Pad::MOP::SlotAttr, allowing pure-perl slot
           attributes that provide simple metadata storage

include/class.h  view on Meta::CPAN

    } adjust;
  };
} ParamMeta;

#define MOP_CLASS_RUN_HOOKS_NOARGS(classmeta, func)                                       \
  {                                                                                       \
    U32 hooki;                                                                            \
    for(hooki = 0; classmeta->hooks && hooki < av_count(classmeta->hooks); hooki++) {     \
      struct ClassHook *h = (struct ClassHook *)AvARRAY(classmeta->hooks)[hooki];         \
      if(*h->funcs->func)                                                                 \
        (*h->funcs->func)(aTHX_ classmeta, h->attrdata, h->funcdata);                     \
    }                                                                                     \
  }

#define MOP_CLASS_RUN_HOOKS(classmeta, func, ...)                                         \
  {                                                                                       \
    U32 hooki;                                                                            \
    for(hooki = 0; classmeta->hooks && hooki < av_count(classmeta->hooks); hooki++) {     \
      struct ClassHook *h = (struct ClassHook *)AvARRAY(classmeta->hooks)[hooki];         \
      if(*h->funcs->func)                                                                 \
        (*h->funcs->func)(aTHX_ classmeta, h->attrdata, h->funcdata, __VA_ARGS__);        \
    }                                                                                     \
  }

#define mop_class_get_direct_roles(class, embeddings)  ObjectPad_mop_class_get_direct_roles(aTHX_ class, embeddings)
RoleEmbedding **ObjectPad_mop_class_get_direct_roles(pTHX_ const ClassMeta *meta, U32 *nroles);

#define mop_class_get_all_roles(class, embeddings)  ObjectPad_mop_class_get_all_roles(aTHX_ class, embeddings)
RoleEmbedding **ObjectPad_mop_class_get_all_roles(pTHX_ const ClassMeta *meta, U32 *nroles);

#define prepare_method_parse(meta)  ObjectPad__prepare_method_parse(aTHX_ meta)

include/field.h  view on Meta::CPAN

  SV *paramname;
  AV *hooks; /* NULL, or AV of raw pointers directly to FieldHook structs */
};

#define MOP_FIELD_RUN_HOOKS_NOARGS(fieldmeta, func)                                       \
  {                                                                                       \
    U32 hooki;                                                                            \
    for(hooki = 0; fieldmeta->hooks && hooki < av_count(fieldmeta->hooks); hooki++) {     \
      struct FieldHook *h = (struct FieldHook *)AvARRAY(fieldmeta->hooks)[hooki];         \
      if(*h->funcs->func)                                                                 \
        (*h->funcs->func)(aTHX_ fieldmeta, h->attrdata, h->funcdata);                     \
    }                                                                                     \
  }

#define MOP_FIELD_RUN_HOOKS(fieldmeta, func, ...)                                         \
  {                                                                                       \
    U32 hooki;                                                                            \
    for(hooki = 0; fieldmeta->hooks && hooki < av_count(fieldmeta->hooks); hooki++) {     \
      struct FieldHook *h = (struct FieldHook *)AvARRAY(fieldmeta->hooks)[hooki];         \
      if(*h->funcs->func)                                                                 \
        (*h->funcs->func)(aTHX_ fieldmeta, h->attrdata, h->funcdata, __VA_ARGS__);        \
    }                                                                                     \
  }

void ObjectPad__boot_fields(pTHX);

#endif

lib/Object/Pad.xs  view on Meta::CPAN


/*********************
 * Custom FieldHooks *
 *********************/

struct CustomFieldHookData
{
  SV *apply_cb;
};

static bool fieldhook_custom_apply(pTHX_ FieldMeta *fieldmeta, SV *value, SV **hookdata_ptr, void *_funcdata)
{
  struct CustomFieldHookData *funcdata = _funcdata;

  SV *cb;
  if((cb = funcdata->apply_cb)) {
    dSP;
    ENTER;
    SAVETMPS;

    SV *fieldmetasv = sv_newmortal();
    sv_setref_uv(fieldmetasv, "Object::Pad::MOP::Field", PTR2UV(fieldmeta));

    PUSHMARK(SP);
    EXTEND(SP, 2);
    PUSHs(fieldmetasv);

lib/Object/Pad.xs  view on Meta::CPAN

    dKWARG(2);

    {
      if(!cophh_exists_pvs(CopHINTHASH_get(PL_curcop), "Object::Pad/experimental(custom_field_attr)", 0))
        Perl_ck_warner(aTHX_ packWARN(WARN_EXPERIMENTAL),
          "Object::Pad::MOP::FieldAttr is experimental and may be changed or removed without notice");
    }

    struct FieldHookFuncs funcs = {};

    struct CustomFieldHookData funcdata = {};

    funcs.ver = OBJECTPAD_ABIVERSION;

    funcs.apply = &fieldhook_custom_apply;

    static const char *args[] = {
      "permit_hintkey",
      "apply",
      "no_value",
      "must_value",
      NULL,
    };
    while(KWARG_NEXT(args)) {
      switch(kwarg) {
        case 0: /* permit_hintkey */
          funcs.permit_hintkey = SvPV_nolen(kwval);
          break;

        case 1: /* apply */
          funcdata.apply_cb = kwval;
          break;

        case 2: /* no_value */
          if(SvTRUE(kwval))
            funcs.flags |= OBJECTPAD_FLAG_ATTR_NO_VALUE;
          break;

        case 3: /* must_value */
          if(SvTRUE(kwval))
            funcs.flags |= OBJECTPAD_FLAG_ATTR_MUST_VALUE;

lib/Object/Pad.xs  view on Meta::CPAN

    if((funcs.flags & OBJECTPAD_FLAG_ATTR_NO_VALUE) &&
       (funcs.flags & OBJECTPAD_FLAG_ATTR_MUST_VALUE))
       croak("Cannot register a FieldAttr with both 'no_value' and 'must_value'");

    struct FieldHookFuncs *_funcs;
    Newxz(_funcs, 1, struct FieldHookFuncs);
    Copy(&funcs, _funcs, 1, struct FieldHookFuncs);
    if(_funcs->permit_hintkey)
      _funcs->permit_hintkey = savepv(_funcs->permit_hintkey);

    struct CustomFieldHookData *_funcdata;
    Newxz(_funcdata, 1, struct CustomFieldHookData);
    Copy(&funcdata, _funcdata, 1, struct CustomFieldHookData);
    if(_funcdata->apply_cb)
      _funcdata->apply_cb = newSVsv(_funcdata->apply_cb);

    register_field_attribute(savepv(SvPV_nolen(name)), _funcs, _funcdata);
  }

MODULE = Object::Pad    PACKAGE = Object::Pad::MetaFunctions

SV *
metaclass(SV *obj)
  CODE:
  {
    if(!SvROK(obj) || !SvOBJECT(SvRV(obj)))
      croak("Expected an object reference to metaclass");

share/include/object_pad.h  view on Meta::CPAN

  OBJECTPAD_FLAG_ATTR_NO_VALUE = (1<<0),
  OBJECTPAD_FLAG_ATTR_MUST_VALUE = (1<<1),
};

struct ClassHookFuncs {
  U32 ver;  /* caller must initialise to OBJECTPAD_VERSION */
  U32 flags;
  const char *permit_hintkey;

  /* called immediately at apply time; return FALSE means it did its thing immediately, so don't store it */
  bool (*apply)(pTHX_ ClassMeta *classmeta, SV *value, SV **attrdata_ptr, void *funcdata);

  /* called immediately before class seal */
  void (*pre_seal)(pTHX_ ClassMeta *classmeta, SV *attrdata, void *funcdata);
  /* called immediately after class seal */
  void (*post_seal)(pTHX_ ClassMeta *classmeta, SV *attrdata, void *funcdata);

  /* called by mop_class_add_field() */
  void (*post_add_field)(pTHX_ ClassMeta *classmeta, SV *attrdata, void *funcdata, FieldMeta *fieldmeta);
};

struct ClassHook {
  const struct ClassHookFuncs *funcs;
  void *funcdata;
  SV *attrdata; /* used to be called 'hookdata' */
};

struct FieldHookFuncs {
  U32 ver;   /* caller must initialise to OBJECTPAD_VERSION */
  U32 flags;
  const char *permit_hintkey;

  /* optional; called when parsing `:ATTRNAME(ATTRVALUE)` source code */
  SV *(*parse)(pTHX_ FieldMeta *fieldmeta, SV *valuesrc, void *funcdata);

  /* called immediately at apply time; return FALSE means it did its thing immediately, so don't store it */
  bool (*apply)(pTHX_ FieldMeta *fieldmeta, SV *value, SV **attrdata_ptr, void *funcdata);

  /* called at the end of `has` statement compiletime */
  void (*seal)(pTHX_ FieldMeta *fieldmeta, SV *attrdata, void *funcdata);

  /* called as part of accessor generation */
  void (*gen_accessor_ops)(pTHX_ FieldMeta *fieldmeta, SV *attrdata, void *funcdata,
          enum AccessorType type, struct AccessorGenerationCtx *ctx);

  /* called by constructor */
  union {
    void (*post_makefield)(pTHX_ FieldMeta *fieldmeta, SV *attrdata, void *funcdata, SV *field);

    // This used to be called post_initfield but was badly named because it 
    // actually ran *before* initfields
    void (*post_initfield)(pTHX_ FieldMeta *fieldmeta, SV *attrdata, void *funcdata, SV *field);
  };
  void (*post_construct)(pTHX_ FieldMeta *fieldmeta, SV *attrdata, void *funcdata, SV *field);

  /* called as part of constructor generation
   * TODO: Not yet used by accessors, but maybe a future version will add a
   * flag to do this.
   */
  OP *(*gen_valueassert_op)(pTHX_ FieldMeta *fieldmeta, SV *attrdata, void *funcdata, OP *valueop);
};

struct FieldHook {
  FIELDOFFSET fieldix; /* unused when in FieldMeta->hooks; used by ClassMeta->fieldhooks_* */
  FieldMeta *fieldmeta;
  const struct FieldHookFuncs *funcs;
  void *funcdata;
  SV *attrdata; /* used to be called 'hookdata' */
};

enum MetaType {
  METATYPE_CLASS,
  METATYPE_ROLE,
};

enum ReprType {
  REPR_NATIVE,       /* instances are in native format - blessed AV as backing */

share/include/object_pad.h  view on Meta::CPAN


#define mop_class_apply_attribute(classmeta, name, value)  ObjectPad_mop_class_apply_attribute(aTHX_ classmeta, name, value)
void ObjectPad_mop_class_apply_attribute(pTHX_ ClassMeta *classmeta, const char *name, SV *value);

#define mop_class_get_attribute(classmeta, name)  ObjectPad_mop_class_get_attribute(aTHX_ classmeta, name)
struct ClassHook *ObjectPad_mop_class_get_attribute(pTHX_ ClassMeta *classmeta, const char *name);

#define mop_class_get_attribute_values(classmeta, name)  ObjectPad_mop_class_get_attribute_values(aTHX_ classmeta, name)
AV *ObjectPad_mop_class_get_attribute_values(pTHX_ ClassMeta *classmeta, const char *name);

#define register_class_attribute(name, funcs, funcdata)  ObjectPad_register_class_attribute(aTHX_ name, funcs, funcdata)
void ObjectPad_register_class_attribute(pTHX_ const char *name, const struct ClassHookFuncs *funcs, void *funcdata);

/* Field API */
#define mop_create_field(fieldname, fieldix, classmeta)  ObjectPad_mop_create_field(aTHX_ fieldname, fieldix, classmeta)
FieldMeta *ObjectPad_mop_create_field(pTHX_ SV *fieldname, FIELDOFFSET fieldix, ClassMeta *classmeta);

#define mop_field_seal(fieldmeta)  ObjectPad_mop_field_seal(aTHX_ fieldmeta)
void ObjectPad_mop_field_seal(pTHX_ FieldMeta *fieldmeta);

#define mop_field_get_class(fieldmeta)  ObjectPad_mop_field_get_class(aTHX_ fieldmeta)
ClassMeta *ObjectPad_mop_field_get_class(pTHX_ FieldMeta *fieldmeta);

share/include/object_pad.h  view on Meta::CPAN


#define mop_field_get_attribute_values(fieldmeta, name)  ObjectPad_mop_field_get_attribute_values(aTHX_ fieldmeta, name)
AV *ObjectPad_mop_field_get_attribute_values(pTHX_ FieldMeta *fieldmeta, const char *name);

#define mop_field_get_default_sv(fieldmeta)  ObjectPad_mop_field_get_default_sv(aTHX_ fieldmeta)
SV *ObjectPad_mop_field_get_default_sv(pTHX_ FieldMeta *fieldmeta);

#define mop_field_set_default_sv(fieldmeta, sv)  ObjectPad_mop_field_set_default_sv(aTHX_ fieldmeta, sv)
void ObjectPad_mop_field_set_default_sv(pTHX_ FieldMeta *fieldmeta, SV *sv);

#define register_field_attribute(name, funcs, funcdata)  ObjectPad_register_field_attribute(aTHX_ name, funcs, funcdata)
void ObjectPad_register_field_attribute(pTHX_ const char *name, const struct FieldHookFuncs *funcs, void *funcdata);

/* Integration with XS::Parse::Keyword v0.30
 *   To enable this you must #include "XSParseKeyword.h" before this file
 */
#ifdef XPK_STAGED_ANONSUB
  /* These are not really API functions but we need to see them to let these call it */
  void ObjectPad__prepare_method_parse(pTHX_ ClassMeta *meta);
  void ObjectPad__start_method_parse(pTHX_ ClassMeta *meta, bool is_common);
  OP *ObjectPad__finish_method_parse(pTHX_ ClassMeta *meta, bool is_common, OP *body);

src/class.c  view on Meta::CPAN


typedef struct ClassAttributeRegistration ClassAttributeRegistration;

struct ClassAttributeRegistration {
  ClassAttributeRegistration *next;

  const char *name;
  STRLEN permit_hintkeylen;

  const struct ClassHookFuncs *funcs;
  void *funcdata;
};

static ClassAttributeRegistration *classattrs = NULL;

static void register_class_attribute(const char *name, const struct ClassHookFuncs *funcs, void *funcdata)
{
  ClassAttributeRegistration *reg;
  Newx(reg, 1, struct ClassAttributeRegistration);

  *reg = (struct ClassAttributeRegistration){
    .name     = name,
    .funcs    = funcs,
    .funcdata = funcdata,
  };

  if(funcs->permit_hintkey)
    reg->permit_hintkeylen = strlen(funcs->permit_hintkey);
  else
    reg->permit_hintkeylen = 0;

  reg->next  = classattrs;
  classattrs = reg;
}

struct ClassHookFuncs_v57 {
  U32 ver;
  U32 flags;
  const char *permit_hintkey;
  bool (*apply)(pTHX_ ClassMeta *classmeta, SV *value, SV **hookdata_ptr, void *funcdata);
  /* No pre- or post-seal */
  void (*post_add_field)(pTHX_ ClassMeta *classmeta, SV *hookdata, void *funcdata, FieldMeta *fieldmeta);
};

void ObjectPad_register_class_attribute(pTHX_ const char *name, const struct ClassHookFuncs *funcs, void *funcdata)
{
  if(funcs->ver < 57)
    croak("Mismatch in third-party class attribute ABI version field: module wants %d, we require >= 57\n",
        funcs->ver);
  if(funcs->ver > OBJECTPAD_ABIVERSION)
    croak("Mismatch in third-party class attribute ABI version field: attribute supplies %d, module wants %d\n",
        funcs->ver, OBJECTPAD_ABIVERSION);

  if(!name || !(name[0] >= 'A' && name[0] <= 'Z'))
    croak("Third-party class attribute names must begin with a capital letter");

src/class.c  view on Meta::CPAN

      .ver            = OBJECTPAD_ABIVERSION,
      .flags          = funcs_v57->flags,
      .permit_hintkey = funcs_v57->permit_hintkey,
      .apply          = funcs_v57->apply,
      .post_add_field = funcs_v57->post_add_field,
    };

    funcs = funcs_v76;
  }

  register_class_attribute(name, funcs, funcdata);
}

void ObjectPad_mop_class_apply_attribute(pTHX_ ClassMeta *classmeta, const char *name, SV *value)
{
  HV *hints = GvHV(PL_hintgv);

  if(value && (!SvPOK(value) || !SvCUR(value)))
    value = NULL;

  ClassAttributeRegistration *reg;

src/class.c  view on Meta::CPAN

      continue;

    if((reg->funcs->flags & OBJECTPAD_FLAG_ATTR_NO_VALUE) && value)
      croak("Attribute :%s does not permit a value", name);
    if((reg->funcs->flags & OBJECTPAD_FLAG_ATTR_MUST_VALUE) && !value)
      croak("Attribute :%s requires a value", name);

    SV *attrdata = value;

    if(reg->funcs->apply) {
      if(!(*reg->funcs->apply)(aTHX_ classmeta, value, &attrdata, reg->funcdata))
        return;
    }

    if(!classmeta->hooks)
      classmeta->hooks = newAV();

    struct ClassHook *hook;
    Newx(hook, 1, struct ClassHook);

    *hook = (struct ClassHook){
      .funcs    = reg->funcs,
      .funcdata = reg->funcdata,
      .attrdata = attrdata,
    };

    av_push(classmeta->hooks, (SV *)hook);

    if(value && value != attrdata)
      SvREFCNT_dec(value);

    return;
  }

src/class.c  view on Meta::CPAN

          if(!meta->fieldhooks_makefield)
            meta->fieldhooks_makefield = newAV();

          struct FieldHook *fasth;
          Newx(fasth, 1, struct FieldHook);

          *fasth = (struct FieldHook){
            .fieldix   = fieldmeta->fieldix,
            .fieldmeta = fieldmeta,
            .funcs     = h->funcs,
            .funcdata  = h->funcdata,
            .attrdata  = h->attrdata,
          };

          av_push(meta->fieldhooks_makefield, (SV *)fasth);
        }

        if(*h->funcs->post_construct) {
          if(!meta->fieldhooks_construct)
            meta->fieldhooks_construct = newAV();

          struct FieldHook *fasth;
          Newx(fasth, 1, struct FieldHook);

          *fasth = (struct FieldHook){
            .fieldix   = fieldmeta->fieldix,
            .fieldmeta = fieldmeta,
            .funcs     = h->funcs,
            .funcdata  = h->funcdata,
            .attrdata  = h->attrdata,
          };

          av_push(meta->fieldhooks_construct, (SV *)fasth);
        }
      }
    }
  }

  S_generate_initfields_method(aTHX_ meta);

src/class.c  view on Meta::CPAN

  if(meta->fieldhooks_makefield) {
    DEBUG_SET_CURCOP_LINE(__LINE__);

    AV *fieldhooks = meta->fieldhooks_makefield;

    U32 i;
    for(i = 0; i < av_count(fieldhooks); i++) {
      struct FieldHook *h = (struct FieldHook *)AvARRAY(fieldhooks)[i];
      FIELDOFFSET fieldix = h->fieldix;

      (*h->funcs->post_makefield)(aTHX_ h->fieldmeta, h->attrdata, h->funcdata, fieldsvs[fieldix]);
    }
  }

  HV *paramhv = NULL;
  if(meta->parammap || meta->has_adjust || meta->strict_params) {
    paramhv = newHV();
    SAVEFREESV((SV *)paramhv);

    if(nargs % 2)
      warn("Odd-length list passed to %" SVf " constructor", class);

src/class.c  view on Meta::CPAN

  if(meta->fieldhooks_construct) {
    DEBUG_SET_CURCOP_LINE(__LINE__);

    AV *fieldhooks = meta->fieldhooks_construct;

    U32 i;
    for(i = 0; i < av_count(fieldhooks); i++) {
      struct FieldHook *h = (struct FieldHook *)AvARRAY(fieldhooks)[i];
      FIELDOFFSET fieldix = h->fieldix;

      (*h->funcs->post_construct)(aTHX_ h->fieldmeta, h->attrdata, h->funcdata, fieldsvs[fieldix]);
    }
  }

#ifdef DEBUG_OVERRIDE_PLCURCOP
  PL_curcop = prevcop;
#endif
  ST(0) = self;
  XSRETURN(1);
}

src/class.c  view on Meta::CPAN

  }

  while(*p && isSPACE_utf8_safe(p, end))
    p += UTF8SKIP(p);

  return p;
}

/* :isa */

static bool classhook_isa_apply(pTHX_ ClassMeta *classmeta, SV *value, SV **attrdata, void *_funcdata)
{
  SV *superclassname = newSV(0), *superclassver = newSV(0);
  SAVEFREESV(superclassname);
  SAVEFREESV(superclassver);

  const char *end = split_package_ver(value, superclassname, superclassver);

  if(*end)
    croak("Unexpected characters while parsing :isa() attribute: %s", end);

src/class.c  view on Meta::CPAN

}

static const struct ClassHookFuncs classhooks_isa = {
  .ver   = OBJECTPAD_ABIVERSION,
  .flags = OBJECTPAD_FLAG_ATTR_MUST_VALUE,
  .apply = &classhook_isa_apply,
};

/* :does */

static bool classhook_does_apply(pTHX_ ClassMeta *classmeta, SV *value, SV **attrdata, void *_funcdata)
{
  SV *rolename = newSV(0), *rolever = newSV(0);
  SAVEFREESV(rolename);
  SAVEFREESV(rolever);

  const char *end = split_package_ver(value, rolename, rolever);

  if(*end)
    croak("Unexpected characters while parsing :does() attribute: %s", end);

src/class.c  view on Meta::CPAN

}

static const struct ClassHookFuncs classhooks_does = {
  .ver   = OBJECTPAD_ABIVERSION,
  .flags = OBJECTPAD_FLAG_ATTR_MUST_VALUE,
  .apply = &classhook_does_apply,
};

/* :abstract */

static bool classhook_abstract_apply(pTHX_ ClassMeta *classmeta, SV *value, SV **attrdata_ptr, void *_funcdata)
{
  if(classmeta->type == METATYPE_ROLE)
    warn("All roles are already abstract; there is no need to declare them as such");

  classmeta->abstract = TRUE;

  return FALSE;
}

static const struct ClassHookFuncs classhooks_abstract = {
  .ver   = OBJECTPAD_ABIVERSION,
  .flags = OBJECTPAD_FLAG_ATTR_NO_VALUE,
  .apply = &classhook_abstract_apply,
};

/* :repr */

static bool classhook_repr_apply(pTHX_ ClassMeta *classmeta, SV *value, SV **attrdata, void *_funcdata)
{
  char *val = SvPV_nolen(value); /* all comparisons are ASCII */

  if(strEQ(val, "native")) {
    if(classmeta->type == METATYPE_CLASS && classmeta->cls.foreign_new)
      croak("Cannot switch a subclass of a foreign superclass type to :repr(native)");
    classmeta->repr = REPR_NATIVE;
  }
  else if(strEQ(val, "HASH"))
    classmeta->repr = REPR_HASH;

src/class.c  view on Meta::CPAN

}

static const struct ClassHookFuncs classhooks_repr = {
  .ver   = OBJECTPAD_ABIVERSION,
  .flags = OBJECTPAD_FLAG_ATTR_MUST_VALUE,
  .apply = &classhook_repr_apply,
};

/* :compat */

static bool classhook_compat_apply(pTHX_ ClassMeta *classmeta, SV *value, SV **attrdata, void *_funcdata)
{
  if(strEQ(SvPV_nolen(value), "invokable")) {
    if(classmeta->type != METATYPE_ROLE)
      croak(":compat(invokable) only applies to a role");

    classmeta->role_is_invokable = true;
  }
  else
    croak("Unrecognised class compatibility argument %" SVf, SVfARG(value));

src/class.c  view on Meta::CPAN

}

static const struct ClassHookFuncs classhooks_compat = {
  .ver   = OBJECTPAD_ABIVERSION,
  .flags = OBJECTPAD_FLAG_ATTR_MUST_VALUE,
  .apply = &classhook_compat_apply,
};

/* :strict */

static bool classhook_strict_apply(pTHX_ ClassMeta *classmeta, SV *value, SV **attrdata_ptr, void *_funcdata)
{
  if(strEQ(SvPV_nolen(value), "params"))
    classmeta->strict_params = TRUE;
  else
    croak("Unrecognised class strictness type %" SVf, SVfARG(value));

  return FALSE;
}

static const struct ClassHookFuncs classhooks_strict = {

src/field.c  view on Meta::CPAN


typedef struct FieldAttributeRegistration FieldAttributeRegistration;

struct FieldAttributeRegistration {
  FieldAttributeRegistration *next;

  const char *name;
  STRLEN permit_hintkeylen;

  const struct FieldHookFuncs *funcs;
  void *funcdata;
};

static FieldAttributeRegistration *fieldattrs = NULL;

static void register_field_attribute(const char *name, const struct FieldHookFuncs *funcs, void *funcdata)
{
  FieldAttributeRegistration *reg;
  Newx(reg, 1, struct FieldAttributeRegistration);

  *reg = (struct FieldAttributeRegistration){
    .name     = name,
    .funcs    = funcs,
    .funcdata = funcdata,
  };

  if(funcs->permit_hintkey)
    reg->permit_hintkeylen = strlen(funcs->permit_hintkey);
  else
    reg->permit_hintkeylen = 0;

  reg->next = fieldattrs;
  fieldattrs = reg;
}

src/field.c  view on Meta::CPAN


  if(!reg)
    croak("Unrecognised field attribute :%s", name);

  if((reg->funcs->flags & OBJECTPAD_FLAG_ATTR_NO_VALUE) && value)
    croak("Attribute :%s does not permit a value", name);
  if((reg->funcs->flags & OBJECTPAD_FLAG_ATTR_MUST_VALUE) && !value)
    croak("Attribute :%s requires a value", name);

  if((flags & APPLY_ATTRIBUTE_PARSE) && reg->funcs->parse)
    value = (*reg->funcs->parse)(aTHX_ fieldmeta, value, reg->funcdata);

  SV *attrdata = value;

  if(reg->funcs->apply) {
    if(!(*reg->funcs->apply)(aTHX_ fieldmeta, value, &attrdata, reg->funcdata))
      return;
  }

  if(attrdata && attrdata == value)
    SvREFCNT_inc(attrdata);

  if(!fieldmeta->hooks)
    fieldmeta->hooks = newAV();

  struct FieldHook *hook;
  Newx(hook, 1, struct FieldHook);

  *hook = (struct FieldHook){
    .funcs    = reg->funcs,
    .attrdata = attrdata,
    .funcdata = reg->funcdata,
  };

  av_push(fieldmeta->hooks, (SV *)hook);
}

void ObjectPad_mop_field_apply_attribute(pTHX_ FieldMeta *fieldmeta, const char *name, SV *value)
{
  bool runtime = !IN_PERL_COMPILETIME;
  apply_attribute(aTHX_ fieldmeta, name, value, runtime ? APPLY_ATTRIBUTE_USE_RUNTIME_HINTS : 0);
}

src/field.c  view on Meta::CPAN

        /* Can't just
         *   MOP_FIELD_RUN_HOOKS(fieldmeta, gen_valueassert_op, ...)
         * because of collecting up the return values
         */
        U32 hooki;
        for(hooki = 0; fieldmeta->hooks && hooki < av_count(fieldmeta->hooks); hooki++) {
          struct FieldHook *h = (struct FieldHook *)AvARRAY(fieldmeta->hooks)[hooki];         \
          if(!h->funcs->gen_valueassert_op)
            continue;

          OP *assertop = (*h->funcs->gen_valueassert_op)(aTHX_ fieldmeta, h->attrdata, h->funcdata,
            newFIELDSVOP(opflags_if_role, fieldmeta->fieldix));

          if(!assertop)
            continue;

          op = op_append_elem(OP_LINESEQ, op,
            assertop);
        }
      }

src/field.c  view on Meta::CPAN


  classmeta->initfields_lines = lines;
}

/*******************
 * Attribute hooks *
 *******************/

/* :weak */

static void fieldhook_weak_post_construct(pTHX_ FieldMeta *fieldmeta, SV *_attrdata, void *_funcdata, SV *field)
{
  sv_rvweaken(field);
}

#ifndef HAVE_OP_WEAKEN
static XOP xop_weaken;
static OP *pp_weaken(pTHX)
{
  dSP;
  sv_rvweaken(POPs);
  return NORMAL;
}
#endif

static void fieldhook_weak_gen_accessor(pTHX_ FieldMeta *fieldmeta, SV *attrdata, void *_funcdata, enum AccessorType type, struct AccessorGenerationCtx *ctx)
{
  if(type != ACCESSOR_WRITER)
    return;

  ctx->post_bodyops = op_append_list(OP_LINESEQ, ctx->post_bodyops,
#ifdef HAVE_OP_WEAKEN
    newUNOP(OP_WEAKEN, 0,
#else
    newUNOP_CUSTOM(&pp_weaken, 0,
#endif

src/field.c  view on Meta::CPAN

}

static struct FieldHookFuncs fieldhooks_weak = {
  .flags            = OBJECTPAD_FLAG_ATTR_NO_VALUE,
  .post_construct   = &fieldhook_weak_post_construct,
  .gen_accessor_ops = &fieldhook_weak_gen_accessor,
};

/* :param */

static bool fieldhook_param_apply(pTHX_ FieldMeta *fieldmeta, SV *value, SV **attrdata_ptr, void *_funcdata)
{
  if(SvPVX(fieldmeta->name)[0] != '$')
    croak("Can only add a named constructor parameter for scalar fields");

  char *paramname = value ? SvPVX(value) : NULL;

  U32 flags = 0;
  if(value && SvUTF8(value))
    flags |= SVf_UTF8;

src/field.c  view on Meta::CPAN

  ops = block_end(save_ix, ops);

  CV *cv = newATTRSUB(floor_ix, NULL, NULL, NULL, ops);
  CvMETHOD_on(cv);

  mop_class_add_method_cv(classmeta, mname, cv);

  LEAVE;
}

static bool fieldhook_reader_apply(pTHX_ FieldMeta *fieldmeta, SV *value, SV **attrdata_ptr, void *_funcdata)
{
  *attrdata_ptr = make_accessor_mnamesv(aTHX_ fieldmeta, value, "%s");
  return TRUE;
}

static void fieldhook_reader_seal(pTHX_ FieldMeta *fieldmeta, SV *attrdata, void *_funcdata)
{
  S_generate_field_accessor_method(aTHX_ fieldmeta, attrdata, ACCESSOR_READER);
}

static struct FieldHookFuncs fieldhooks_reader = {
  .ver   = OBJECTPAD_ABIVERSION,
  .apply = &fieldhook_reader_apply,
  .seal  = &fieldhook_reader_seal,
};

/* :writer */

static bool fieldhook_writer_apply(pTHX_ FieldMeta *fieldmeta, SV *value, SV **attrdata_ptr, void *_funcdata)
{
  *attrdata_ptr = make_accessor_mnamesv(aTHX_ fieldmeta, value, "set_%s");
  return TRUE;
}

static void fieldhook_writer_seal(pTHX_ FieldMeta *fieldmeta, SV *attrdata, void *_funcdata)
{
  S_generate_field_accessor_method(aTHX_ fieldmeta, attrdata, ACCESSOR_WRITER);
}

static struct FieldHookFuncs fieldhooks_writer = {
  .ver   = OBJECTPAD_ABIVERSION,
  .apply = &fieldhook_writer_apply,
  .seal  = &fieldhook_writer_seal,
};

/* :mutator */

static bool fieldhook_mutator_apply(pTHX_ FieldMeta *fieldmeta, SV *value, SV **attrdata_ptr, void *_funcdata)
{
  if(SvPVX(fieldmeta->name)[0] != '$')
    /* TODO: A reader for an array or hash field should also be fine */
    croak("Can only generate accessors for scalar fields");

  *attrdata_ptr = make_accessor_mnamesv(aTHX_ fieldmeta, value, "%s");
  return TRUE;
}

static void fieldhook_mutator_seal(pTHX_ FieldMeta *fieldmeta, SV *attrdata, void *_funcdata)
{
  S_generate_field_accessor_method(aTHX_ fieldmeta, attrdata, ACCESSOR_LVALUE_MUTATOR);
}

static struct FieldHookFuncs fieldhooks_mutator = {
  .ver   = OBJECTPAD_ABIVERSION,
  .apply = &fieldhook_mutator_apply,
  .seal  = &fieldhook_mutator_seal,
};

/* :accessor */

static void fieldhook_accessor_seal(pTHX_ FieldMeta *fieldmeta, SV *attrdata, void *_funcdata)
{
  S_generate_field_accessor_method(aTHX_ fieldmeta, attrdata, ACCESSOR_COMBINED);
}

static struct FieldHookFuncs fieldhooks_accessor = {
  .ver   = OBJECTPAD_ABIVERSION,
  .apply = &fieldhook_mutator_apply, /* generate method name the same as :mutator */
  .seal  = &fieldhook_accessor_seal,
};

/* :inheritable */

static bool fieldhook_inheritble_apply(pTHX_ FieldMeta *fieldmeta, SV *value, SV **attrdata_ptr, void *_funcdata)
{
  HV *hints = GvHV(PL_hintgv);
  if(!hv_fetchs(hints, "Object::Pad/experimental(inherit_field)", 0))
    Perl_ck_warner(aTHX_ packWARN(WARN_EXPERIMENTAL),
      "inheriting fields is experimental and may be changed or removed without notice");

  fieldmeta->is_inheritable = true;

  return false;
}

src/field.c  view on Meta::CPAN

static struct FieldHookFuncs fieldhooks_inheritable = {
  .ver   = OBJECTPAD_ABIVERSION,
  .flags = OBJECTPAD_FLAG_ATTR_NO_VALUE,
  .apply = &fieldhook_inheritble_apply,
};

struct FieldHookFuncs_v76 {
  U32 ver;
  U32 flags;
  const char *permit_hintkey;
  bool (*apply)(pTHX_ FieldMeta *fieldmeta, SV *value, SV **attrdata_ptr, void *funcdata);
  void (*seal)(pTHX_ FieldMeta *fieldmeta, SV *attrdata, void *funcdata);
  void (*gen_accessor_ops)(pTHX_ FieldMeta *fieldmeta, SV *attrdata, void *funcdata,
          enum AccessorType type, struct AccessorGenerationCtx *ctx);
  void (*post_makefield)(pTHX_ FieldMeta *fieldmeta, SV *attrdata, void *funcdata, SV *field);
  void (*post_construct)(pTHX_ FieldMeta *fieldmeta, SV *attrdata, void *funcdata, SV *field);
};

void ObjectPad_register_field_attribute(pTHX_ const char *name, const struct FieldHookFuncs *funcs, void *funcdata)
{
  if(funcs->ver < 57)
    croak("Mismatch in third-party field attribute ABI version field: module wants %d, we require >= 57\n",
        funcs->ver);
  if(funcs->ver > OBJECTPAD_ABIVERSION)
    croak("Mismatch in third-party field attribute ABI version field: attribute supplies %d, module wants %d\n",
        funcs->ver, OBJECTPAD_ABIVERSION);

  if(!name || !(name[0] >= 'A' && name[0] <= 'Z'))
    croak("Third-party field attribute names must begin with a capital letter");

src/field.c  view on Meta::CPAN

      .apply            = funcs_v76->apply,
      .seal             = funcs_v76->seal,
      .gen_accessor_ops = funcs_v76->gen_accessor_ops,
      .post_makefield   = funcs_v76->post_makefield,
      .post_construct   = funcs_v76->post_construct,
    };

    funcs = funcs_v810;
  }

  register_field_attribute(name, funcs, funcdata);
}

void ObjectPad__boot_fields(pTHX)
{
#ifndef HAVE_OP_WEAKEN
  XopENTRY_set(&xop_weaken, xop_name, "weaken");
  XopENTRY_set(&xop_weaken, xop_desc, "weaken an RV");
  XopENTRY_set(&xop_weaken, xop_class, OA_UNOP);
  Perl_custom_op_register(aTHX_ &pp_weaken, &xop_weaken);
#endif



( run in 0.285 second using v1.01-cache-2.11-cpan-454fe037f31 )