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: |
42 | * although we use MAGIC for gc, we also store mg to any slot for efficiency (gfx) |
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); |
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 | |
10583d27 |
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 | |
e989c0df |
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; |
d83eddd0 |
85 | |
e989c0df |
86 | if(items == 1){ /* reader */ |
d83eddd0 |
87 | value = MOP_mg_get_slot(mg, self); |
e989c0df |
88 | } |
89 | else if (items == 2){ /* writer */ |
d83eddd0 |
90 | value = MOP_mg_set_slot(mg, self, ST(1)); |
e989c0df |
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 | |
d83eddd0 |
111 | value = MOP_mg_get_slot(mg, self); |
e989c0df |
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 | |
d83eddd0 |
125 | ST(0) = MOP_mg_set_slot(mg, self, ST(1)); |
e989c0df |
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 | |
d83eddd0 |
139 | value = MOP_mg_delete_slot(mg, self); |
e989c0df |
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 | |
d83eddd0 |
154 | ST(0) = boolSV( MOP_mg_has_slot(mg, self) ); |
e989c0df |
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 | |
d83eddd0 |
169 | value = MOP_mg_get_slot(mg, self); |
e989c0df |
170 | ST(0) = boolSV( value && SvOK(value )); |
171 | XSRETURN(1); |
206860b8 |
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* |
e989c0df |
184 | _generate_accessor_method_xs(SV* self, void* instance_vtbl) |
206860b8 |
185 | CODE: |
e989c0df |
186 | RETVAL = mop_instantiate_xs_accessor(aTHX_ self, mop_xs_simple_accessor, instance_vtbl); |
206860b8 |
187 | OUTPUT: |
188 | RETVAL |
189 | |
190 | CV* |
e989c0df |
191 | _generate_reader_method_xs(SV* self, void* instance_vtbl) |
206860b8 |
192 | CODE: |
e989c0df |
193 | RETVAL = mop_instantiate_xs_accessor(aTHX_ self, mop_xs_simple_reader, instance_vtbl); |
206860b8 |
194 | OUTPUT: |
195 | RETVAL |
196 | |
197 | CV* |
e989c0df |
198 | _generate_writer_method_xs(SV* self, void* instance_vtbl) |
206860b8 |
199 | CODE: |
e989c0df |
200 | RETVAL = mop_instantiate_xs_accessor(aTHX_ self, mop_xs_simple_writer, instance_vtbl); |
206860b8 |
201 | OUTPUT: |
202 | RETVAL |
203 | |
204 | CV* |
e989c0df |
205 | _generate_predicate_method_xs(SV* self, void* instance_vtbl) |
206860b8 |
206 | CODE: |
e989c0df |
207 | RETVAL = mop_instantiate_xs_accessor(aTHX_ self, mop_xs_simple_predicate, instance_vtbl); |
206860b8 |
208 | OUTPUT: |
209 | RETVAL |
210 | |
211 | CV* |
e989c0df |
212 | _generate_clearer_method_xs(SV* self, void* instance_vtbl) |
206860b8 |
213 | CODE: |
e989c0df |
214 | RETVAL = mop_instantiate_xs_accessor(aTHX_ self, mop_xs_simple_clearer, instance_vtbl); |
206860b8 |
215 | OUTPUT: |
216 | RETVAL |
217 | |