3 #define CHECK_INSTANCE(instance) STMT_START{ \
4 if(!(SvROK(instance) && SvTYPE(SvRV(instance)) == SVt_PVHV)){ \
5 croak("Invalid object"); \
7 if(SvTIED_mg(SvRV(instance), PERL_MAGIC_tied)){ \
8 croak("MOP::Instance: tied HASH is not yet supported"); \
13 mop_instance_create_instance(pTHX) {
14 return newRV_noinc((SV*)newHV());
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);
24 mop_instance_get_slot(pTHX_ SV* const instance, SV* const slot_name) {
26 CHECK_INSTANCE(instance);
27 he = hv_fetch_ent((HV*)SvRV(instance), slot_name, FALSE, 0U);
28 return he ? HeVAL(he) : NULL;
32 mop_instance_set_slot(pTHX_ SV* const instance, SV* const slot_name, SV* const value) {
35 CHECK_INSTANCE(instance);
36 he = hv_fetch_ent((HV*)SvRV(instance), slot_name, TRUE, 0U);
38 sv_setsv_mg(sv, value);
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);
49 mop_instance_weaken_slot(pTHX_ SV* const instance, SV* const slot_name) {
51 CHECK_INSTANCE(instance);
52 he = hv_fetch_ent((HV*)SvRV(instance), slot_name, FALSE, 0U);
53 sv_rvweaken(HeVAL(he));
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,
66 const mop_instance_vtbl*
67 mop_get_default_instance_vtbl(pTHX){
68 return &mop_default_instance;
72 MODULE = Class::MOP::Instance PACKAGE = Class::MOP::Instance
77 INSTALL_SIMPLE_READER(Instance, associated_metaclass);
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);
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;