Commit | Line | Data |
a69b9501 |
1 | #include "mop.h" |
2 | |
353c6152 |
3 | |
4 | static MGVTBL mop_accessor_vtbl; /* the MAGIC identity */ |
5 | |
6 | MAGIC* |
7 | mop_accessor_get_mg(pTHX_ CV* const xsub){ |
8 | return mop_mg_find(aTHX_ (SV*)xsub, &mop_accessor_vtbl, MOPf_DIE_ON_FAIL); |
9 | } |
10 | |
11 | CV* |
12 | mop_install_accessor(pTHX_ const char* const fq_name, const char* const key, I32 const keylen, XSPROTO(accessor_impl), const mop_instance_vtbl* vtbl){ |
13 | CV* const xsub = newXS((char*)fq_name, accessor_impl, __FILE__); |
14 | SV* const keysv = newSVpvn_share(key, keylen, 0U); |
15 | AV* const meta = newAV(); |
16 | |
17 | if(!vtbl){ |
18 | vtbl = mop_get_default_instance_vtbl(aTHX); |
19 | } |
20 | |
21 | sv_magicext((SV*)xsub, (SV*)meta, PERL_MAGIC_ext, &mop_accessor_vtbl, (char*)vtbl, 0); |
22 | SvREFCNT_dec(meta); /* sv_magicext() increases refcnt in mg_obj */ |
23 | |
24 | av_store(meta, 0, keysv); |
25 | |
26 | return xsub; |
27 | } |
28 | |
29 | |
a69b9501 |
30 | static CV* |
353c6152 |
31 | mop_instantiate_xs_accessor(pTHX_ SV* const accessor, XSPROTO(accessor_impl), mop_instance_vtbl* const vtbl){ |
ffec3ec3 |
32 | /* $key = $accessor->associated_attribute->name */ |
33 | SV* const attr = mop_call0(aTHX_ accessor, mop_associated_attribute); |
34 | SV* const key = mop_call0(aTHX_ attr, mop_name); |
353c6152 |
35 | STRLEN klen; |
36 | const char* const kpv = SvPV_const(key, klen); |
37 | |
38 | return mop_install_accessor(aTHX_ NULL /* anonymous */, kpv, klen, accessor_impl, vtbl); |
39 | } |
40 | |
41 | SV* |
42 | mop_accessor_get_self(pTHX_ I32 const ax, I32 const items, CV* const cv) { |
43 | SV* self; |
44 | |
45 | if(items < 1){ |
46 | croak("too few arguments for %s", GvNAME(CvGV(cv))); |
47 | } |
48 | |
49 | self = ST(0); |
50 | if(!(SvROK(self) && SvOBJECT(SvRV(self)))){ |
51 | croak("cant call %s as a class method", GvNAME(CvGV(cv))); |
52 | } |
53 | return self; |
54 | } |
55 | |
56 | XS(mop_xs_simple_accessor) |
57 | { |
58 | dVAR; dXSARGS; |
59 | dMOP_METHOD_COMMON; /* self, mg */ |
60 | SV* value; |
61 | if(items == 1){ /* reader */ |
62 | value = MOP_mg_vtbl(mg)->get_slot(aTHX_ self, MOP_mg_key(mg)); |
63 | } |
64 | else if (items == 2){ /* writer */ |
65 | value = MOP_mg_vtbl(mg)->set_slot(aTHX_ self, MOP_mg_key(mg), ST(1)); |
66 | } |
67 | else{ |
68 | croak("expected exactly one or two argument"); |
69 | } |
70 | |
71 | ST(0) = value ? value : &PL_sv_undef; |
72 | XSRETURN(1); |
73 | } |
74 | |
75 | |
76 | XS(mop_xs_simple_reader) |
77 | { |
78 | dVAR; dXSARGS; |
79 | dMOP_METHOD_COMMON; /* self, mg */ |
80 | SV* value; |
81 | |
82 | if (items != 1) { |
83 | croak("expected exactly one argument"); |
84 | } |
85 | |
86 | value = MOP_mg_vtbl(mg)->get_slot(aTHX_ self, MOP_mg_key(mg)); |
87 | ST(0) = value ? value : &PL_sv_undef; |
88 | XSRETURN(1); |
89 | } |
90 | |
91 | XS(mop_xs_simple_writer) |
92 | { |
93 | dVAR; dXSARGS; |
94 | dMOP_METHOD_COMMON; /* self, mg */ |
95 | |
96 | if (items != 2) { |
97 | croak("expected exactly two argument"); |
98 | } |
99 | |
100 | ST(0) = MOP_mg_vtbl(mg)->set_slot(aTHX_ self, MOP_mg_key(mg), ST(1)); |
101 | XSRETURN(1); |
102 | } |
103 | |
104 | XS(mop_xs_simple_clearer) |
105 | { |
106 | dVAR; dXSARGS; |
107 | dMOP_METHOD_COMMON; /* self, mg */ |
108 | SV* value; |
109 | |
110 | if (items != 1) { |
111 | croak("expected exactly one argument"); |
112 | } |
113 | |
114 | value = MOP_mg_vtbl(mg)->delete_slot(aTHX_ self, MOP_mg_key(mg)); |
115 | ST(0) = value ? value : &PL_sv_undef; |
116 | XSRETURN(1); |
117 | } |
118 | |
119 | |
120 | XS(mop_xs_simple_predicate) |
121 | { |
122 | dVAR; dXSARGS; |
123 | dMOP_METHOD_COMMON; /* self, mg */ |
124 | |
125 | if (items != 1) { |
126 | croak("expected exactly one argument"); |
127 | } |
128 | |
129 | ST(0) = boolSV( MOP_mg_vtbl(mg)->has_slot(aTHX_ self, MOP_mg_key(mg)) ); |
130 | XSRETURN(1); |
131 | } |
132 | |
133 | |
134 | XS(mop_xs_simple_predicate_for_metaclass) |
135 | { |
136 | dVAR; dXSARGS; |
137 | dMOP_METHOD_COMMON; /* self, mg */ |
138 | SV* value; |
139 | |
140 | if (items != 1) { |
141 | croak("expected exactly one argument"); |
142 | } |
143 | |
144 | value = MOP_mg_vtbl(mg)->get_slot(aTHX_ self, MOP_mg_key(mg)); |
145 | ST(0) = boolSV( value && SvOK(value )); |
146 | XSRETURN(1); |
a69b9501 |
147 | } |
148 | |
149 | MODULE = Class::MOP::Method::Accessor PACKAGE = Class::MOP::Method::Accessor |
150 | |
151 | PROTOTYPES: DISABLE |
152 | |
153 | BOOT: |
154 | INSTALL_SIMPLE_READER_WITH_KEY(Method::Accessor, associated_attribute, attribute); |
155 | INSTALL_SIMPLE_READER(Method::Accessor, accessor_type); |
156 | |
157 | |
158 | CV* |
353c6152 |
159 | _generate_accessor_method_xs(SV* self, void* instance_vtbl) |
a69b9501 |
160 | CODE: |
353c6152 |
161 | RETVAL = mop_instantiate_xs_accessor(aTHX_ self, mop_xs_simple_accessor, instance_vtbl); |
a69b9501 |
162 | OUTPUT: |
163 | RETVAL |
164 | |
165 | CV* |
353c6152 |
166 | _generate_reader_method_xs(SV* self, void* instance_vtbl) |
a69b9501 |
167 | CODE: |
353c6152 |
168 | RETVAL = mop_instantiate_xs_accessor(aTHX_ self, mop_xs_simple_reader, instance_vtbl); |
a69b9501 |
169 | OUTPUT: |
170 | RETVAL |
171 | |
172 | CV* |
353c6152 |
173 | _generate_writer_method_xs(SV* self, void* instance_vtbl) |
a69b9501 |
174 | CODE: |
353c6152 |
175 | RETVAL = mop_instantiate_xs_accessor(aTHX_ self, mop_xs_simple_writer, instance_vtbl); |
a69b9501 |
176 | OUTPUT: |
177 | RETVAL |
178 | |
179 | CV* |
353c6152 |
180 | _generate_predicate_method_xs(SV* self, void* instance_vtbl) |
a69b9501 |
181 | CODE: |
353c6152 |
182 | RETVAL = mop_instantiate_xs_accessor(aTHX_ self, mop_xs_simple_predicate, instance_vtbl); |
a69b9501 |
183 | OUTPUT: |
184 | RETVAL |
185 | |
186 | CV* |
353c6152 |
187 | _generate_clearer_method_xs(SV* self, void* instance_vtbl) |
a69b9501 |
188 | CODE: |
353c6152 |
189 | RETVAL = mop_instantiate_xs_accessor(aTHX_ self, mop_xs_simple_clearer, instance_vtbl); |
a69b9501 |
190 | OUTPUT: |
191 | RETVAL |
192 | |