Commit | Line | Data |
e170f134 |
1 | #define NEED_newSVpvn_flags |
d846ade3 |
2 | #include "mop.h" |
3 | |
e170f134 |
4 | static SV* |
5 | mop_deconstruct_variable_name(pTHX_ SV* const variable, svtype* const type, const char** const type_name) { |
6 | SV* name; |
7 | |
8 | if(SvROK(variable) && SvTYPE(SvRV(variable)) == SVt_PVHV){ |
9 | /* e.g. variable = { type => "SCALAR", name => "foo" } */ |
10 | HV* const hv = (HV*)SvRV(variable); |
11 | SV** svp; |
12 | STRLEN len; |
13 | const char* pv; |
14 | |
15 | svp = hv_fetchs(hv, "name", FALSE); |
16 | if(!(svp && SvOK(*svp))){ |
17 | croak("You must pass a variable name"); |
18 | } |
19 | name = *svp; |
20 | pv = SvPV_const(name, len); |
21 | if(len < 1){ |
22 | croak("You must pass a variable name"); |
23 | } |
24 | |
25 | svp = hv_fetchs(hv, "type", FALSE); |
26 | if(!(svp && SvOK(*svp))) { |
27 | croak("You must pass a variable type"); |
28 | } |
29 | pv = SvPV_nolen_const(*svp); |
30 | if(strEQ(pv, "SCALAR")){ |
31 | *type = SVt_PV; /* for all the type of scalars */ |
32 | } |
33 | else if(strEQ(pv, "ARRAY")){ |
34 | *type = SVt_PVAV; |
35 | } |
36 | else if(strEQ(pv, "HASH")){ |
37 | *type = SVt_PVHV; |
38 | } |
39 | else if(strEQ(pv, "CODE")){ |
40 | *type = SVt_PVCV; |
41 | } |
42 | else if(strEQ(pv, "GLOB")){ |
43 | *type = SVt_PVGV; |
44 | } |
45 | else if(strEQ(pv, "IO")){ |
46 | *type = SVt_PVIO; |
47 | } |
48 | else{ |
49 | croak("I do not recognize that type '%s'", pv); |
50 | } |
51 | *type_name = pv; |
52 | } |
53 | else { |
54 | STRLEN len; |
55 | const char* pv; |
56 | /* e.g. variable = '$foo' */ |
57 | if(!SvOK(variable)) { |
58 | croak("You must pass a variable name"); |
59 | } |
60 | pv = SvPV_const(variable, len); |
61 | if(len < 2){ |
62 | croak("You must pass a variable name including a sigil"); |
63 | } |
64 | |
65 | switch(pv[0]){ |
66 | case '$': |
67 | *type = SVt_PV; /* for all the types of scalars */ |
68 | *type_name = "SCALAR"; |
69 | break; |
70 | case '@': |
71 | *type = SVt_PVAV; |
72 | *type_name = "ARRAY"; |
73 | break; |
74 | case '%': |
75 | *type = SVt_PVHV; |
76 | *type_name = "HASH"; |
77 | break; |
78 | case '&': |
79 | *type = SVt_PVCV; |
80 | *type_name = "CODE"; |
81 | break; |
82 | case '*': |
83 | *type = SVt_PVGV; |
84 | *type_name = "GLOB"; |
85 | break; |
86 | default: |
87 | croak("I do not recognize that sigil '%c'", pv[0]); |
88 | } |
89 | |
90 | name = newSVpvn_share(pv+1, len-1, 0U); |
91 | sv_2mortal(name); |
92 | } |
93 | |
94 | return name; |
95 | } |
96 | |
d846ade3 |
97 | MODULE = Class::MOP::Package PACKAGE = Class::MOP::Package |
98 | |
99 | PROTOTYPES: DISABLE |
100 | |
101 | void |
102 | get_all_package_symbols(self, filter=TYPE_FILTER_NONE) |
103 | SV *self |
104 | type_filter_t filter |
105 | PREINIT: |
106 | HV *stash = NULL; |
107 | HV *symbols = NULL; |
108 | register HE *he; |
109 | PPCODE: |
110 | if ( ! SvROK(self) ) { |
111 | die("Cannot call get_all_package_symbols as a class method"); |
112 | } |
113 | |
114 | if (GIMME_V == G_VOID) { |
115 | XSRETURN_EMPTY; |
116 | } |
117 | |
118 | PUTBACK; |
119 | |
22932438 |
120 | if ( (he = hv_fetch_ent((HV *)SvRV(self), KEY_FOR(package), 0, HASH_FOR(package))) ) { |
d846ade3 |
121 | stash = gv_stashsv(HeVAL(he), 0); |
122 | } |
123 | |
124 | |
125 | if (!stash) { |
126 | XSRETURN_UNDEF; |
127 | } |
128 | |
e1f52a8a |
129 | symbols = mop_get_all_package_symbols(stash, filter); |
d846ade3 |
130 | PUSHs(sv_2mortal(newRV_noinc((SV *)symbols))); |
131 | |
7ec7b950 |
132 | BOOT: |
133 | INSTALL_SIMPLE_READER_WITH_KEY(Package, name, package); |
e170f134 |
134 | |
135 | SV* |
136 | add_package_symbol(SV* self, SV* variable, SV* ref = &PL_sv_undef) |
137 | PREINIT: |
138 | svtype type; |
139 | const char* type_name; |
140 | SV* var_name; |
141 | SV* package_name; |
142 | SV* fq_name; |
143 | CODE: |
144 | var_name = mop_deconstruct_variable_name(aTHX_ variable, &type, &type_name); |
145 | |
146 | package_name = mop_call0(aTHX_ self, KEY_FOR(name)); |
147 | if(!SvOK(package_name)){ |
148 | croak("name() did not return a defined value"); |
149 | } |
150 | fq_name = newSVpvf("%"SVf"::%"SVf, package_name, var_name); |
151 | sv_2mortal(fq_name); |
152 | |
153 | if(SvOK(ref)){ /* set */ |
154 | GV* gv; |
155 | if(type == SVt_PV){ |
156 | if(!SvROK(ref)){ |
157 | ref = newRV_noinc(newSVsv(ref)); |
158 | sv_2mortal(ref); |
159 | } |
160 | } |
161 | else if(!(SvROK(ref) && SvTYPE(SvRV(ref)) == type)){ |
162 | croak("You must pass a reference of %s for the value of %s", type_name, GvNAME(CvGV(cv))); |
163 | } |
164 | gv = gv_fetchsv(fq_name, GV_ADDMULTI, type); |
165 | |
166 | if(type == SVt_PVCV && GvCV(gv)){ |
167 | /* XXX: should introduce an option { redefine => 1 } ? */ |
168 | SvREFCNT_dec(GvCV(gv)); |
169 | GvCV(gv) = NULL; |
170 | } |
171 | sv_setsv_mg((SV*)gv, ref); /* *glob = $ref */ |
172 | RETVAL = ref; |
173 | } |
174 | else { /* init */ |
175 | GV* const gv = gv_fetchsv(fq_name, GV_ADDMULTI, type); |
176 | SV* sv; |
177 | |
178 | switch(type){ |
179 | case SVt_PV: |
180 | sv = GvSVn(gv); |
181 | break; |
182 | case SVt_PVAV: |
183 | sv = (SV*)GvAVn(gv); |
184 | break; |
185 | case SVt_PVHV: |
186 | sv = (SV*)GvHVn(gv); |
187 | break; |
188 | case SVt_PVCV: |
189 | sv = (SV*)GvCV(gv); |
190 | break; |
191 | case SVt_PVGV: |
192 | sv = (SV*)gv; |
193 | break; |
194 | case SVt_PVIO: |
195 | sv = (SV*)GvIOn(gv); |
196 | break; |
197 | default: |
198 | croak("NOT REACHED"); |
199 | sv = NULL; /* -W */ |
200 | break; |
201 | } |
202 | |
203 | if(sv){ |
204 | RETVAL = sv_2mortal(newRV_inc(sv)); |
205 | } |
206 | else{ |
207 | RETVAL = &PL_sv_undef; |
208 | } |
209 | } |
210 | ST(0) = RETVAL; |
211 | |
212 | SV* |
213 | get_package_symbol(SV* self, SV* variable) |
214 | ALIAS: |
215 | get_package_symbol = GV_ADDMULTI |
216 | has_package_symbol = 0 |
217 | PREINIT: |
218 | svtype type; |
219 | const char* type_name; |
220 | SV* var_name; |
221 | SV* package_name; |
222 | SV* fq_name; |
223 | GV* gv; |
224 | SV* sv; |
225 | CODE: |
226 | var_name = mop_deconstruct_variable_name(aTHX_ variable, &type, &type_name); |
227 | |
228 | package_name = mop_call0(aTHX_ self, KEY_FOR(name)); |
229 | if(!SvOK(package_name)){ |
230 | croak("name() did not return a defined value"); |
231 | } |
232 | fq_name = newSVpvf("%"SVf"::%"SVf, package_name, var_name); |
233 | sv_2mortal(fq_name); |
234 | |
235 | gv = gv_fetchsv(fq_name, ix, type); |
236 | if(!gv){ /* no symbol in has_package_symbol() */ |
237 | XSRETURN_NO; |
238 | } |
239 | |
240 | switch(type){ |
241 | case SVt_PV: |
242 | sv = GvSV(gv); |
243 | break; |
244 | case SVt_PVAV: |
245 | sv = (SV*)GvAV(gv); |
246 | break; |
247 | case SVt_PVHV: |
248 | sv = (SV*)GvHV(gv); |
249 | break; |
250 | case SVt_PVCV: |
251 | sv = (SV*)GvCV(gv); |
252 | break; |
253 | case SVt_PVGV: |
254 | sv = (SV*)gv; |
255 | break; |
256 | case SVt_PVIO: |
257 | sv = (SV*)GvIO(gv); |
258 | break; |
259 | default: |
260 | croak("NOT REACHED"); |
261 | sv = NULL; /* -W */ |
262 | break; |
263 | } |
264 | |
265 | if(!ix){ /* has_package_symbol */ |
266 | RETVAL = boolSV(sv); |
267 | } |
268 | else{ |
269 | if(sv){ |
270 | RETVAL = newRV_inc(sv); |
271 | } |
272 | else{ |
273 | RETVAL = &PL_sv_undef; |
274 | } |
275 | } |
276 | OUTPUT: |
277 | RETVAL |