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