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