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