4 #define GLOB_CREATE 0x01
5 #define VARIABLE_CREATE 0x02
9 mop_deconstruct_variable_name(pTHX_ SV* const variable,
10 const char** const var_name, STRLEN* const var_name_len,
12 const char** const type_name,
16 if(SvROK(variable) && SvTYPE(SvRV(variable)) == SVt_PVHV){
17 /* e.g. variable = { type => "SCALAR", name => "foo" } */
18 HV* const hv = (HV*)SvRV(variable);
23 svp = hv_fetchs(hv, "name", FALSE);
24 if(!(svp && SvOK(*svp))){
25 croak("You must pass a variable name");
27 *var_name = SvPV_const(*svp, len);
30 croak("You must pass a variable name");
33 svp = hv_fetchs(hv, "type", FALSE);
34 if(!(svp && SvOK(*svp))) {
35 croak("You must pass a variable type");
37 pv = SvPV_nolen_const(*svp);
38 if(strEQ(pv, "SCALAR")){
39 *type = SVt_PV; /* for all the type of scalars */
41 else if(strEQ(pv, "ARRAY")){
44 else if(strEQ(pv, "HASH")){
47 else if(strEQ(pv, "CODE")){
50 else if(strEQ(pv, "GLOB")){
53 else if(strEQ(pv, "IO")){
57 croak("I do not recognize that type '%s'", pv);
61 svp = hv_fetchs(hv, "create", FALSE);
62 if(svp && SvTRUE(*svp)){
63 *flags = VARIABLE_CREATE | GLOB_CREATE;
69 /* e.g. variable = '$foo' */
71 croak("You must pass a variable name");
73 pv = SvPV_const(variable, len);
75 croak("You must pass a variable name including a sigil");
79 *var_name_len = len - 1;
83 *type = SVt_PV; /* for all the types of scalars */
84 *type_name = "SCALAR";
103 croak("I do not recognize that sigil '%c'", pv[0]);
108 MODULE = Class::MOP::Package PACKAGE = Class::MOP::Package
113 get_all_package_symbols(self, filter=TYPE_FILTER_NONE)
121 if ( ! SvROK(self) ) {
122 die("Cannot call get_all_package_symbols as a class method");
125 if (GIMME_V == G_VOID) {
131 if ( (he = hv_fetch_ent((HV *)SvRV(self), KEY_FOR(package), 0, HASH_FOR(package))) ) {
132 stash = gv_stashsv(HeVAL(he), 0);
140 symbols = mop_get_all_package_symbols(stash, filter);
141 PUSHs(sv_2mortal(newRV_noinc((SV *)symbols)));
144 INSTALL_SIMPLE_READER_WITH_KEY(Package, name, package);
146 #define S_HAS GV_NOADD_NOINIT
148 #define S_ADD GV_ADDMULTI
152 add_package_symbol(SV* self, SV* variable, SV* ref = &PL_sv_undef)
154 has_package_symbol = S_HAS
155 get_package_symbol = S_GET
156 add_package_symbol = S_ADD
159 const char* type_name;
160 const char* var_name;
166 if(items == 3 && ix != S_ADD){
167 croak("Too many arguments for %s", GvNAME(CvGV(cv)));
170 mop_deconstruct_variable_name(aTHX_ variable, &var_name, &var_name_len, &type, &type_name, &flags);
173 if(ix != S_ADD){ /* for shortcut fetching */
174 SV* const ns = mop_call0(aTHX_ self, mop_namespace);
176 if(!(SvROK(ns) && SvTYPE(SvRV(ns)) == SVt_PVHV)){
177 croak("namespace() did not return a hash reference");
179 stash = (HV*)SvRV(ns);
180 gvp = (GV**)hv_fetch(stash, var_name, var_name_len, FALSE);
186 if(gvp && isGV(*gvp)){
190 SV* const package_name = mop_call0(aTHX_ self, KEY_FOR(name));
193 if(!SvOK(package_name)){
194 croak("name() did not return a defined value");
196 fq_name = Perl_form(aTHX_ "%"SVf"::%s", package_name, var_name);
198 gv = gv_fetchpv(fq_name, ix | (flags & GLOB_CREATE ? GV_ADDMULTI : 0), type);
200 assert(isGV_with_GP(gv));
203 if(SvOK(ref)){ /* add_package_symbol with a value */
206 ref = newRV_noinc(newSVsv(ref));
210 else if(!(SvROK(ref) && SvTYPE(SvRV(ref)) == type)){
211 croak("You must pass a reference of %s for the value of %s", type_name, GvNAME(CvGV(cv)));
214 if(type == SVt_PVCV && GvCV(gv)){
215 /* XXX: should introduce an option { redefine => 1 } ? */
216 SvREFCNT_dec(GvCV(gv));
219 sv_setsv_mg((SV*)gv, ref); /* *glob = $ref */
221 if(type == SVt_PVCV){
222 CV* const subr = (CV*)SvRV(ref);
226 && strEQ(GvNAME(CvGV(subr)), "__ANON__")){
233 else { /* no values */
245 if(!isGV(gv)){ /* In has_package_symbol, the stash entry is a stub or constant */
247 if(type == SVt_PVCV){
257 sv = (SV*)((flags & VARIABLE_CREATE) ? GvAVn(gv) : GvAV(gv));
260 sv = (SV*)((flags & VARIABLE_CREATE) ? GvHVn(gv) : GvHV(gv));
266 sv = (SV*)((flags & VARIABLE_CREATE) ? GvIOn(gv) : GvIO(gv));
271 default: /* SCALAR */
272 sv = (flags & VARIABLE_CREATE) ? GvSVn(gv) : GvSV(gv);
281 RETVAL = sv_2mortal(newRV_inc(sv));
284 RETVAL = &PL_sv_undef;