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     return sv_bless( newRV_noinc((SV*)newHV()), stash );
  15 }
  16
  17 static bool
  18 mop_instance_has_slot(pTHX_ SV* const instance, SV* const slot) {
  19     CHECK_INSTANCE(instance);
  20     return hv_exists_ent((HV*)SvRV(instance), slot, 0U);
  21 }
  22
  23 static SV*
  24 mop_instance_get_slot(pTHX_ SV* const instance, SV* const slot) {
  25     HE* he;
  26     CHECK_INSTANCE(instance);
  27     he = hv_fetch_ent((HV*)SvRV(instance), slot, FALSE, 0U);
  28     return he ? HeVAL(he) : NULL;
  29 }
  30
  31 static SV*
  32 mop_instance_set_slot(pTHX_ SV* const instance, SV* const slot, SV* const value) {
  33     HE* he;
  34     SV* sv;
  35     CHECK_INSTANCE(instance);
  36     he = hv_fetch_ent((HV*)SvRV(instance), slot, TRUE, 0U);
  37     sv = HeVAL(he);
  38     sv_setsv_mg(sv, value);
  39     return sv;
  40 }
  41
  42 static SV*
  43 mop_instance_delete_slot(pTHX_ SV* const instance, SV* const slot) {
  44     CHECK_INSTANCE(instance);
  45     return hv_delete_ent((HV*)SvRV(instance), slot, 0, 0U);
  46 }
  47
  48 static void
  49 mop_instance_weaken_slot(pTHX_ SV* const instance, SV* const slot) {
  50     HE* he;
  51     CHECK_INSTANCE(instance);
  52     he = hv_fetch_ent((HV*)SvRV(instance), slot, FALSE, 0U);
  53     if(he){
  54         sv_rvweaken(HeVAL(he));
  55     }
  56 }
  57
  58 static const mop_instance_vtbl mop_default_instance = {
  59         mop_instance_create_instance,
  60         mop_instance_has_slot,
  61         mop_instance_get_slot,
  62         mop_instance_set_slot,
  63         mop_instance_delete_slot,
  64         mop_instance_weaken_slot,
  65 };
  66
  67
  68 const mop_instance_vtbl*
  69 mop_get_default_instance_vtbl(pTHX){
  70     return &mop_default_instance;
  71 }
  72
  73
  74 MODULE = Class::MOP::Instance  PACKAGE = Class::MOP::Instance
  75
  76 PROTOTYPES: DISABLE
  77
  78 BOOT:
  79     INSTALL_SIMPLE_READER(Instance, associated_metaclass);
  80
  81 void*
  82 can_xs(SV* self)
  83 PREINIT:
  84     CV* const default_method  = get_cv("Class::MOP::Instance::get_slot_value", FALSE);
  85     SV* const can             = newSVpvs_flags("can", SVs_TEMP);
  86     SV* const method          = newSVpvs_flags("get_slot_value", SVs_TEMP);
  87     SV* code_ref;
  88 CODE:
  89     /* $self->can("get_slot_value") == \&Class::MOP::Instance::get_slot_value */
  90     code_ref = mop_call1(aTHX_ self, can, method);
  91     if(SvROK(code_ref) && SvRV(code_ref) == (SV*)default_method){
  92         RETVAL = (void*)&mop_default_instance;
  93     }
  94     else{
  95         RETVAL = NULL;
  96     }
  97 OUTPUT:
  98     RETVAL
  99