xs/MethodAccessor.xs

   1 #include "mop.h"
   2
   3
   4 static MGVTBL mop_accessor_vtbl = { /* the MAGIC identity */
   5     NULL, /* get */
   6     NULL, /* set */
   7     NULL, /* len */
   8     NULL, /* clear */
   9     NULL, /* free */
  10     NULL, /* copy */
  11     NULL, /* dup */
  12 #ifdef MGf_LOCAL
  13     NULL, /* local */
  14 #endif
  15 };
  16
  17
  18 MAGIC*
  19 mop_accessor_get_mg(pTHX_ CV* const xsub){
  20     return mop_mg_find(aTHX_ (SV*)xsub, &mop_accessor_vtbl, MOPf_DIE_ON_FAIL);
  21 }
  22
  23 CV*
  24 mop_install_accessor(pTHX_ const char* const fq_name, const char* const key, I32 const keylen, XSPROTO(accessor_impl), const mop_instance_vtbl* vtbl){
  25     CV* const xsub  = newXS((char*)fq_name, accessor_impl, __FILE__);
  26     SV* const keysv = newSVpvn_share(key, keylen, 0U);
  27     MAGIC* mg;
  28
  29     if(!vtbl){
  30         vtbl = mop_get_default_instance_vtbl(aTHX);
  31     }
  32
  33     if(!fq_name){
  34         /* generated_xsub need sv_2mortal */
  35         sv_2mortal((SV*)xsub);
  36     }
  37
  38     mg = sv_magicext((SV*)xsub, keysv, PERL_MAGIC_ext, &mop_accessor_vtbl, (char*)vtbl, 0);
  39     SvREFCNT_dec(keysv); /* sv_magicext() increases refcnt in mg_obj */
  40
  41     /* NOTE:
  42      * although we use MAGIC for gc, we also store mg to CvXSUBANY slot for efficiency (gfx)
  43      */
  44     CvXSUBANY(xsub).any_ptr = (void*)mg;
  45
  46     return xsub;
  47 }
  48
  49
  50 static CV*
  51 mop_instantiate_xs_accessor(pTHX_ SV* const accessor, XSPROTO(accessor_impl), mop_instance_vtbl* const vtbl){
  52     /* $key = $accessor->associated_attribute->name */
  53     SV* const attr = mop_call0(aTHX_ accessor, mop_associated_attribute);
  54     SV* const key  = mop_call0(aTHX_ attr, mop_name);
  55     STRLEN klen;
  56     const char* const kpv = SvPV_const(key, klen);
  57
  58     return mop_install_accessor(aTHX_ NULL /* anonymous */, kpv, klen, accessor_impl, vtbl);
  59 }
  60
  61 SV*
  62 mop_accessor_get_self(pTHX_ I32 const ax, I32 const items, CV* const cv) {
  63     SV* self;
  64
  65     if(items < 1){
  66         croak("too few arguments for %s", GvNAME(CvGV(cv)));
  67     }
  68
  69     /* NOTE: If self has GETMAGIC, $self->accessor will invoke GETMAGIC
  70      *       before calling methods, so SvGETMAGIC(self) is not necessarily needed here.
  71      */
  72
  73     self = ST(0);
  74     if(!(SvROK(self) && SvOBJECT(SvRV(self)))){
  75         croak("cant call %s as a class method", GvNAME(CvGV(cv)));
  76     }
  77     return self;
  78 }
  79
  80 XS(mop_xs_simple_accessor)
  81 {
  82     dVAR; dXSARGS;
  83     dMOP_METHOD_COMMON; /* self, mg */
  84     SV* value;
  85
  86     if(items == 1){ /* reader */
  87         value = MOP_mg_get_slot(mg, self);
  88     }
  89     else if (items == 2){ /* writer */
  90         value = MOP_mg_set_slot(mg, self, ST(1));
  91     }
  92     else{
  93         croak("expected exactly one or two argument");
  94     }
  95
  96     ST(0) = value ? value : &PL_sv_undef;
  97     XSRETURN(1);
  98 }
  99
 100
 101 XS(mop_xs_simple_reader)
 102 {
 103     dVAR; dXSARGS;
 104     dMOP_METHOD_COMMON; /* self, mg */
 105     SV* value;
 106
 107     if (items != 1) {
 108         croak("expected exactly one argument");
 109     }
 110
 111     value = MOP_mg_get_slot(mg, self);
 112     ST(0) = value ? value : &PL_sv_undef;
 113     XSRETURN(1);
 114 }
 115
 116 XS(mop_xs_simple_writer)
 117 {
 118     dVAR; dXSARGS;
 119     dMOP_METHOD_COMMON; /* self, mg */
 120
 121     if (items != 2) {
 122         croak("expected exactly two argument");
 123     }
 124
 125     ST(0) = MOP_mg_set_slot(mg, self, ST(1));
 126     XSRETURN(1);
 127 }
 128
 129 XS(mop_xs_simple_clearer)
 130 {
 131     dVAR; dXSARGS;
 132     dMOP_METHOD_COMMON; /* self, mg */
 133     SV* value;
 134
 135     if (items != 1) {
 136         croak("expected exactly one argument");
 137     }
 138
 139     value = MOP_mg_delete_slot(mg, self);
 140     ST(0) = value ? value : &PL_sv_undef;
 141     XSRETURN(1);
 142 }
 143
 144
 145 XS(mop_xs_simple_predicate)
 146 {
 147     dVAR; dXSARGS;
 148     dMOP_METHOD_COMMON; /* self, mg */
 149
 150     if (items != 1) {
 151         croak("expected exactly one argument");
 152     }
 153
 154     ST(0) = boolSV( MOP_mg_has_slot(mg, self) );
 155     XSRETURN(1);
 156 }
 157
 158
 159 XS(mop_xs_simple_predicate_for_metaclass)
 160 {
 161     dVAR; dXSARGS;
 162     dMOP_METHOD_COMMON; /* self, mg */
 163     SV* value;
 164
 165     if (items != 1) {
 166         croak("expected exactly one argument");
 167     }
 168
 169     value = MOP_mg_get_slot(mg, self);
 170     ST(0) = boolSV( value && SvOK(value ));
 171     XSRETURN(1);
 172 }
 173
 174 MODULE = Class::MOP::Method::Accessor   PACKAGE = Class::MOP::Method::Accessor
 175
 176 PROTOTYPES: DISABLE
 177
 178 BOOT:
 179     INSTALL_SIMPLE_READER_WITH_KEY(Method::Accessor, associated_attribute, attribute);
 180     INSTALL_SIMPLE_READER(Method::Accessor, accessor_type);
 181
 182
 183 CV*
 184 _generate_accessor_method_xs(SV* self, void* instance_vtbl)
 185 CODE:
 186     RETVAL = mop_instantiate_xs_accessor(aTHX_ self, mop_xs_simple_accessor, instance_vtbl);
 187 OUTPUT:
 188     RETVAL
 189
 190 CV*
 191 _generate_reader_method_xs(SV* self, void* instance_vtbl)
 192 CODE:
 193     RETVAL = mop_instantiate_xs_accessor(aTHX_ self, mop_xs_simple_reader, instance_vtbl);
 194 OUTPUT:
 195     RETVAL
 196
 197 CV*
 198 _generate_writer_method_xs(SV* self, void* instance_vtbl)
 199 CODE:
 200     RETVAL = mop_instantiate_xs_accessor(aTHX_ self, mop_xs_simple_writer, instance_vtbl);
 201 OUTPUT:
 202     RETVAL
 203
 204 CV*
 205 _generate_predicate_method_xs(SV* self, void* instance_vtbl)
 206 CODE:
 207     RETVAL = mop_instantiate_xs_accessor(aTHX_ self, mop_xs_simple_predicate, instance_vtbl);
 208 OUTPUT:
 209     RETVAL
 210
 211 CV*
 212 _generate_clearer_method_xs(SV* self, void* instance_vtbl)
 213 CODE:
 214     RETVAL = mop_instantiate_xs_accessor(aTHX_ self, mop_xs_simple_clearer, instance_vtbl);
 215 OUTPUT:
 216     RETVAL
 217