xs/Instance.xs

   1 #include "mop.h"
   2
   3 #define CHECK_INSTANCE(instance) STMT_START{                          \
   4         if(!(SvROK(instance) && SvTYPE(SvRV(instance)) == SVt_PVHV)){ \
   5             croak("Invalid object");                                  \
   6         }                                                             \
   7         if(SvTIED_mg(SvRV(instance), PERL_MAGIC_tied)){               \
   8             croak("MOP::Instance: tied HASH is not yet supported");   \
   9         }                                                             \
  10     } STMT_END
  11
  12 static SV*
  13 mop_instance_create_instance(pTHX_ HV* const stash) {
  14     assert(stash);
  15     return sv_bless( newRV_noinc((SV*)newHV()), stash );
  16 }
  17
  18 static bool
  19 mop_instance_has_slot(pTHX_ SV* const instance, SV* const slot) {
  20     assert(instance);
  21     assert(slot);
  22     CHECK_INSTANCE(instance);
  23     return hv_exists_ent((HV*)SvRV(instance), slot, 0U);
  24 }
  25
  26 static SV*
  27 mop_instance_get_slot(pTHX_ SV* const instance, SV* const slot) {
  28     HE* he;
  29     assert(instance);
  30     assert(slot);
  31     CHECK_INSTANCE(instance);
  32     he = hv_fetch_ent((HV*)SvRV(instance), slot, FALSE, 0U);
  33     return he ? HeVAL(he) : NULL;
  34 }
  35
  36 static SV*
  37 mop_instance_set_slot(pTHX_ SV* const instance, SV* const slot, SV* const value) {
  38     HE* he;
  39     SV* sv;
  40     assert(instance);
  41     assert(slot);
  42     assert(value);
  43     CHECK_INSTANCE(instance);
  44     he = hv_fetch_ent((HV*)SvRV(instance), slot, TRUE, 0U);
  45     sv = HeVAL(he);
  46     sv_setsv_mg(sv, value);
  47     return sv;
  48 }
  49
  50 static SV*
  51 mop_instance_delete_slot(pTHX_ SV* const instance, SV* const slot) {
  52     assert(instance);
  53     assert(slot);
  54     CHECK_INSTANCE(instance);
  55     return hv_delete_ent((HV*)SvRV(instance), slot, 0, 0U);
  56 }
  57
  58 static void
  59 mop_instance_weaken_slot(pTHX_ SV* const instance, SV* const slot) {
  60     HE* he;
  61     assert(instance);
  62     assert(slot);
  63     CHECK_INSTANCE(instance);
  64     he = hv_fetch_ent((HV*)SvRV(instance), slot, FALSE, 0U);
  65     if(he){
  66         sv_rvweaken(HeVAL(he));
  67     }
  68 }
  69
  70 static const mop_instance_vtbl mop_default_instance = {
  71         mop_instance_create_instance,
  72         mop_instance_has_slot,
  73         mop_instance_get_slot,
  74         mop_instance_set_slot,
  75         mop_instance_delete_slot,
  76         mop_instance_weaken_slot,
  77 };
  78
  79
  80 const mop_instance_vtbl*
  81 mop_get_default_instance_vtbl(pTHX){
  82     return &mop_default_instance;
  83 }
  84
  85
  86 MODULE = Class::MOP::Instance  PACKAGE = Class::MOP::Instance
  87
  88 PROTOTYPES: DISABLE
  89
  90 BOOT:
  91     INSTALL_SIMPLE_READER(Instance, associated_metaclass);
  92
  93 void*
  94 can_xs(SV* self)
  95 PREINIT:
  96     CV* const default_method  = get_cv("Class::MOP::Instance::get_slot_value", FALSE);
  97     SV* const can             = newSVpvs_flags("can", SVs_TEMP);
  98     SV* const method          = newSVpvs_flags("get_slot_value", SVs_TEMP);
  99     SV* code_ref;
 100 CODE:
 101     /* $self->can("get_slot_value") == \&Class::MOP::Instance::get_slot_value */
 102     code_ref = mop_call1(aTHX_ self, can, method);
 103     if(SvROK(code_ref) && SvRV(code_ref) == (SV*)default_method){
 104         RETVAL = (void*)&mop_default_instance;
 105     }
 106     else{
 107         RETVAL = NULL;
 108     }
 109 OUTPUT:
 110     RETVAL
 111