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