Commit | Line | Data |
59017825 |
1 | #include "EXTERN.h" |
2 | #include "perl.h" |
3 | #include "XSUB.h" |
4 | |
a382a84b |
5 | typedef enum { |
6 | VAR_NONE = 0, |
7 | VAR_SCALAR, |
8 | VAR_ARRAY, |
9 | VAR_HASH, |
10 | VAR_CODE, |
11 | VAR_IO, |
12 | VAR_GLOB, /* TODO: unimplemented */ |
13 | VAR_FORMAT /* TODO: unimplemented */ |
14 | } vartype_t; |
15 | |
16 | typedef struct { |
17 | vartype_t type; |
18 | char sigil; |
19 | char *name; |
20 | } varspec_t; |
21 | |
22 | vartype_t string_to_vartype(char *vartype) |
23 | { |
24 | if (strEQ(vartype, "SCALAR")) { |
25 | return VAR_SCALAR; |
26 | } |
27 | else if (strEQ(vartype, "ARRAY")) { |
28 | return VAR_ARRAY; |
29 | } |
30 | else if (strEQ(vartype, "HASH")) { |
31 | return VAR_HASH; |
32 | } |
33 | else if (strEQ(vartype, "CODE")) { |
34 | return VAR_CODE; |
35 | } |
36 | else if (strEQ(vartype, "IO")) { |
37 | return VAR_IO; |
38 | } |
39 | else { |
40 | croak("Type must be one of 'SCALAR', 'ARRAY', 'HASH', 'CODE', or 'IO'"); |
41 | } |
42 | } |
43 | |
44 | void _deconstruct_variable_name(char *variable, varspec_t *varspec) |
45 | { |
46 | if (!variable || !variable[0]) |
47 | croak("You must pass a variable name"); |
48 | |
49 | varspec->type = VAR_NONE; |
50 | |
51 | switch (variable[0]) { |
52 | case '$': |
53 | varspec->type = VAR_SCALAR; |
54 | break; |
55 | case '@': |
56 | varspec->type = VAR_ARRAY; |
57 | break; |
58 | case '%': |
59 | varspec->type = VAR_HASH; |
60 | break; |
61 | case '&': |
62 | varspec->type = VAR_CODE; |
63 | break; |
64 | } |
65 | |
66 | if (varspec->type != VAR_NONE) { |
67 | varspec->sigil = variable[0]; |
68 | varspec->name = &variable[1]; |
69 | } |
70 | else { |
71 | varspec->type = VAR_IO; |
72 | varspec->sigil = '\0'; |
73 | varspec->name = variable; |
74 | } |
75 | } |
76 | |
77 | void _deconstruct_variable_hash(HV *variable, varspec_t *varspec) |
78 | { |
79 | SV **val; |
80 | char *type; |
81 | |
82 | val = hv_fetch(variable, "name", 4, 0); |
83 | if (!val) |
84 | croak("The 'name' key is required in variable specs"); |
85 | |
86 | varspec->name = savesvpv(*val); |
87 | |
88 | val = hv_fetch(variable, "sigil", 5, 0); |
89 | if (!val) |
90 | croak("The 'sigil' key is required in variable specs"); |
91 | |
92 | varspec->sigil = (SvPV_nolen(*val))[0]; |
93 | |
94 | val = hv_fetch(variable, "type", 4, 0); |
95 | if (!val) |
96 | croak("The 'type' key is required in variable specs"); |
97 | |
98 | varspec->type = string_to_vartype(SvPV_nolen(*val)); |
99 | } |
100 | |
101 | int _valid_for_type(SV *value, vartype_t type) |
102 | { |
103 | svtype sv_type = SvROK(value) ? SvTYPE(SvRV(value)) : SVt_NULL; |
104 | |
105 | switch (type) { |
106 | case VAR_SCALAR: |
107 | return sv_type == SVt_NULL || |
108 | sv_type == SVt_IV || |
109 | sv_type == SVt_NV || |
110 | sv_type == SVt_PV || |
111 | sv_type == SVt_RV; |
112 | case VAR_ARRAY: |
113 | return sv_type == SVt_PVAV; |
114 | case VAR_HASH: |
115 | return sv_type == SVt_PVHV; |
116 | case VAR_CODE: |
117 | return sv_type == SVt_PVCV; |
118 | case VAR_IO: |
119 | return sv_type == SVt_PVGV; |
120 | default: |
121 | return 0; |
122 | } |
123 | } |
124 | |
3fd56b4d |
125 | HV *_get_namespace(SV *self) |
126 | { |
127 | dSP; |
128 | SV *ret; |
129 | |
130 | PUSHMARK(SP); |
131 | XPUSHs(self); |
132 | PUTBACK; |
133 | |
134 | call_method("namespace", G_SCALAR); |
135 | |
136 | SPAGAIN; |
137 | ret = POPs; |
138 | PUTBACK; |
139 | |
140 | return (HV*)SvRV(ret); |
141 | } |
142 | |
59017825 |
143 | MODULE = Package::Stash PACKAGE = Package::Stash |
144 | |
be2a7e99 |
145 | PROTOTYPES: DISABLE |
146 | |
59017825 |
147 | SV* |
148 | new(class, package_name) |
149 | char *class |
150 | SV *package_name |
3496f1e8 |
151 | PREINIT: |
59017825 |
152 | HV *instance; |
153 | HV *namespace; |
154 | CODE: |
155 | if (!SvPOK(package_name)) |
156 | croak("The constructor argument must be the name of a package"); |
157 | |
158 | instance = newHV(); |
159 | |
160 | hv_store(instance, "name", 4, package_name, 0); |
161 | namespace = gv_stashpv(SvPV_nolen(package_name), GV_ADD); |
162 | hv_store(instance, "namespace", 9, newRV((SV*)namespace), 0); |
163 | |
164 | RETVAL = sv_bless(newRV((SV*)instance), gv_stashpv(class, 0)); |
165 | OUTPUT: |
166 | RETVAL |
194acf47 |
167 | |
168 | SV* |
169 | name(self) |
170 | SV *self |
3496f1e8 |
171 | PREINIT: |
194acf47 |
172 | SV **slot; |
173 | CODE: |
174 | if (!sv_isobject(self)) |
175 | croak("Can't call name as a class method"); |
176 | slot = hv_fetch((HV*)SvRV(self), "name", 4, 0); |
177 | RETVAL = slot ? SvREFCNT_inc(*slot) : &PL_sv_undef; |
178 | OUTPUT: |
179 | RETVAL |
180 | |
181 | SV* |
182 | namespace(self) |
183 | SV *self |
3496f1e8 |
184 | PREINIT: |
194acf47 |
185 | SV **slot; |
186 | CODE: |
187 | if (!sv_isobject(self)) |
188 | croak("Can't call namespace as a class method"); |
189 | slot = hv_fetch((HV*)SvRV(self), "namespace", 9, 0); |
190 | RETVAL = slot ? SvREFCNT_inc(*slot) : &PL_sv_undef; |
191 | OUTPUT: |
192 | RETVAL |
3fd56b4d |
193 | |
194 | void |
195 | remove_package_glob(self, name) |
196 | SV *self |
197 | char *name |
3fd56b4d |
198 | CODE: |
199 | hv_delete(_get_namespace(self), name, strlen(name), G_DISCARD); |
9b608466 |
200 | |
201 | void |
215f49f8 |
202 | remove_package_symbol(self, variable) |
203 | SV *self |
204 | varspec_t variable |
205 | PREINIT: |
206 | HV *namespace; |
207 | SV **entry; |
208 | CODE: |
209 | namespace = _get_namespace(self); |
210 | entry = hv_fetch(namespace, variable.name, strlen(variable.name), 0); |
211 | if (!entry) |
212 | XSRETURN_EMPTY; |
213 | |
214 | if (isGV(*entry)) { |
215 | GV *glob = (GV*)(*entry); |
216 | switch (variable.type) { |
217 | case VAR_SCALAR: |
218 | GvSV(glob) = Nullsv; |
219 | break; |
220 | case VAR_ARRAY: |
221 | GvAV(glob) = Nullav; |
222 | break; |
223 | case VAR_HASH: |
224 | GvHV(glob) = Nullhv; |
225 | break; |
226 | case VAR_CODE: |
227 | GvCV(glob) = Nullcv; |
228 | break; |
229 | case VAR_IO: |
230 | GvIOp(glob) = Null(struct io*); |
231 | break; |
232 | } |
233 | } |
234 | else { |
235 | if (variable.type == VAR_CODE) { |
236 | hv_delete(namespace, variable.name, strlen(variable.name), G_DISCARD); |
237 | } |
238 | } |
239 | |
240 | void |
9b608466 |
241 | list_all_package_symbols(self, vartype=VAR_NONE) |
242 | SV *self |
243 | vartype_t vartype |
244 | PPCODE: |
245 | if (vartype == VAR_NONE) { |
246 | HV *namespace; |
247 | HE *entry; |
248 | int keys; |
249 | |
250 | namespace = _get_namespace(self); |
251 | keys = hv_iterinit(namespace); |
252 | EXTEND(SP, keys); |
253 | while (entry = hv_iternext(namespace)) { |
254 | mPUSHs(newSVhek(HeKEY_hek(entry))); |
255 | } |
256 | } |
257 | else { |
258 | HV *namespace; |
259 | HE *entry; |
260 | SV *val; |
261 | char *key; |
262 | int len; |
263 | |
264 | namespace = _get_namespace(self); |
265 | hv_iterinit(namespace); |
266 | while (val = hv_iternextsv(namespace, &key, &len)) { |
267 | GV *gv = (GV*)val; |
268 | if (isGV(gv)) { |
269 | switch (vartype) { |
270 | case VAR_SCALAR: |
271 | if (GvSV(val)) |
272 | mXPUSHp(key, len); |
273 | break; |
274 | case VAR_ARRAY: |
275 | if (GvAV(val)) |
276 | mXPUSHp(key, len); |
277 | break; |
278 | case VAR_HASH: |
279 | if (GvHV(val)) |
280 | mXPUSHp(key, len); |
281 | break; |
282 | case VAR_CODE: |
283 | if (GvCVu(val)) |
284 | mXPUSHp(key, len); |
285 | break; |
286 | case VAR_IO: |
287 | if (GvIO(val)) |
288 | mXPUSHp(key, len); |
289 | break; |
290 | } |
291 | } |
292 | else if (vartype == VAR_CODE) { |
293 | mXPUSHp(key, len); |
294 | } |
295 | } |
296 | } |