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