xs/Package.xs

   1
   2 #include "mop.h"
   3
   4
   5 static void
   6 mop_deconstruct_variable_name(pTHX_ SV* const variable,
   7     const char** const var_name, STRLEN* const var_name_len,
   8     svtype* const type,
   9     const char** const type_name) {
  10
  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                 }
  23                 *var_name     = SvPV_const(*svp, len);
  24                 *var_name_len = len;
  25                 if(len < 1){
  26                         croak("You must pass a variable name");
  27                 }
  28
  29                 svp = hv_fetchs(hv, "type", FALSE);
  30                 if(!(svp && SvOK(*svp))) {
  31                         croak("You must pass a variable type");
  32                 }
  33                 pv = SvPV_nolen_const(*svp);
  34                 if(strEQ(pv, "SCALAR")){
  35                         *type = SVt_PV; /* for all the type of scalars */
  36                 }
  37                 else if(strEQ(pv, "ARRAY")){
  38                         *type = SVt_PVAV;
  39                 }
  40                 else if(strEQ(pv, "HASH")){
  41                         *type = SVt_PVHV;
  42                 }
  43                 else if(strEQ(pv, "CODE")){
  44                         *type = SVt_PVCV;
  45                 }
  46                 else if(strEQ(pv, "GLOB")){
  47                         *type = SVt_PVGV;
  48                 }
  49                 else if(strEQ(pv, "IO")){
  50                         *type = SVt_PVIO;
  51                 }
  52                 else{
  53                         croak("I do not recognize that type '%s'", pv);
  54                 }
  55                 *type_name = pv;
  56         }
  57         else {
  58                 STRLEN len;
  59                 const char* pv;
  60                 /* e.g. variable = '$foo' */
  61                 if(!SvOK(variable)) {
  62                         croak("You must pass a variable name");
  63                 }
  64                 pv = SvPV_const(variable, len);
  65                 if(len < 2){
  66                         croak("You must pass a variable name including a sigil");
  67                 }
  68
  69                 *var_name     = pv  + 1;
  70                 *var_name_len = len - 1;
  71
  72                 switch(pv[0]){
  73                 case '$':
  74                         *type      = SVt_PV; /* for all the types of scalars */
  75                         *type_name = "SCALAR";
  76                         break;
  77                 case '@':
  78                         *type      = SVt_PVAV;
  79                         *type_name = "ARRAY";
  80                         break;
  81                 case '%':
  82                         *type      = SVt_PVHV;
  83                         *type_name = "HASH";
  84                         break;
  85                 case '&':
  86                         *type      = SVt_PVCV;
  87                         *type_name = "CODE";
  88                         break;
  89                 case '*':
  90                         *type      = SVt_PVGV;
  91                         *type_name = "GLOB";
  92                         break;
  93                 default:
  94                         croak("I do not recognize that sigil '%c'", pv[0]);
  95                 }
  96         }
  97 }
  98
  99 static GV*
 100 mop_get_gv(pTHX_ SV* const self, svtype const type, const char* const var_name, I32 const var_name_len, I32 const flags){
 101         SV* package_name;
 102
 103         if(!(flags & ~GV_NOADD_MASK)){ /* for shortcut fetching */
 104                 SV* const ns = mop_call0(aTHX_ self, mop_namespace);
 105                 GV** gvp;
 106                 if(!(SvROK(ns) && SvTYPE(SvRV(ns)) == SVt_PVHV)){
 107                         croak("namespace() did not return a hash reference");
 108                 }
 109                 gvp = (GV**)hv_fetch((HV*)SvRV(ns), var_name, var_name_len, FALSE);
 110                 if(gvp && isGV_with_GP(*gvp)){
 111                         return *gvp;
 112                 }
 113         }
 114
 115         package_name = mop_call0(aTHX_ self, KEY_FOR(name));
 116
 117         if(!SvOK(package_name)){
 118                 croak("name() did not return a defined value");
 119         }
 120
 121         return gv_fetchpv(Perl_form(aTHX_ "%"SVf"::%s", package_name, var_name), flags, type);
 122 }
 123
 124 static SV*
 125 mop_gv_elem(pTHX_ GV* const gv, svtype const type, I32 const add){
 126         SV* sv;
 127
 128         if(!gv){
 129                 return NULL;
 130         }
 131
 132         assert(isGV_with_GP(gv));
 133
 134         switch(type){
 135         case SVt_PVAV:
 136                 sv = (SV*)(add ? GvAVn(gv) : GvAV(gv));
 137                 break;
 138         case SVt_PVHV:
 139                 sv = (SV*)(add ? GvHVn(gv) : GvHV(gv));
 140                 break;
 141         case SVt_PVCV:
 142                 sv = (SV*)GvCV(gv);
 143                 break;
 144         case SVt_PVIO:
 145                 sv = (SV*)(add ? GvIOn(gv) : GvIO(gv));
 146                 break;
 147         case SVt_PVGV:
 148                 sv = (SV*)gv;
 149                 break;
 150         default: /* SCALAR */
 151                 sv =       add ? GvSVn(gv) : GvSV(gv);
 152                 break;
 153         }
 154
 155         return sv;
 156 }
 157
 158
 159 MODULE = Class::MOP::Package   PACKAGE = Class::MOP::Package
 160
 161 PROTOTYPES: DISABLE
 162
 163 void
 164 get_all_package_symbols(self, filter=TYPE_FILTER_NONE)
 165     SV *self
 166     type_filter_t filter
 167     PREINIT:
 168         HV *stash = NULL;
 169         HV *symbols = NULL;
 170         register HE *he;
 171     PPCODE:
 172         if ( ! SvROK(self) ) {
 173             die("Cannot call get_all_package_symbols as a class method");
 174         }
 175
 176         if (GIMME_V == G_VOID) {
 177             XSRETURN_EMPTY;
 178         }
 179
 180         PUTBACK;
 181
 182         if ( (he = hv_fetch_ent((HV *)SvRV(self), KEY_FOR(package), 0, HASH_FOR(package))) ) {
 183             stash = gv_stashsv(HeVAL(he), 0);
 184         }
 185
 186
 187         if (!stash) {
 188             XSRETURN_UNDEF;
 189         }
 190
 191         symbols = mop_get_all_package_symbols(stash, filter);
 192         PUSHs(sv_2mortal(newRV_noinc((SV *)symbols)));
 193
 194 BOOT:
 195     INSTALL_SIMPLE_READER_WITH_KEY(Package, name, package);
 196
 197
 198 SV*
 199 add_package_symbol(SV* self, SV* variable, SV* ref = &PL_sv_undef)
 200 PREINIT:
 201         svtype type;
 202         const char* type_name;
 203         const char* var_name;
 204         STRLEN var_name_len;
 205         GV* gv;
 206 CODE:
 207         mop_deconstruct_variable_name(aTHX_ variable, &var_name, &var_name_len, &type, &type_name);
 208         gv = mop_get_gv(aTHX_ self, type, var_name, var_name_len, GV_ADDMULTI);
 209
 210         if(SvOK(ref)){ /* add_package_symbol with a value */
 211                 if(type == SVt_PV){
 212                         if(!SvROK(ref)){
 213                                 ref = newRV_noinc(newSVsv(ref));
 214                                 sv_2mortal(ref);
 215                         }
 216                 }
 217                 else if(!(SvROK(ref) && SvTYPE(SvRV(ref)) == type)){
 218                         croak("You must pass a reference of %s for the value of %s", type_name, GvNAME(CvGV(cv)));
 219                 }
 220
 221                 if(type == SVt_PVCV && GvCV(gv)){
 222                         /* XXX: clear it before redefinition */
 223                         SvREFCNT_dec(GvCV(gv));
 224                         GvCV(gv) = NULL;
 225                 }
 226                 sv_setsv_mg((SV*)gv, ref); /* magical assignment into type glob (*glob = $ref) */
 227
 228                 if(type == SVt_PVCV){ /* name a subroutine */
 229                         CV* const subr = (CV*)SvRV(ref);
 230                         if(CvANON(subr)
 231                                 && CvGV(subr)
 232                                 && isGV(CvGV(subr))
 233                                 && strEQ(GvNAME(CvGV(subr)), "__ANON__")){
 234
 235                                 CvGV(subr) = gv;
 236                                 CvANON_off(subr);
 237                         }
 238                 }
 239                 RETVAL = ref;
 240                 SvREFCNT_inc_simple_void_NN(ref);
 241         }
 242         else{
 243                 SV* const sv = mop_gv_elem(aTHX_ gv, type, GV_ADDMULTI);
 244                 RETVAL = (sv && GIMME_V != G_VOID) ? newRV_inc(sv) : &PL_sv_undef;
 245         }
 246 OUTPUT:
 247         RETVAL
 248
 249 bool
 250 has_package_symbol(SV* self, SV* variable)
 251 PREINIT:
 252         svtype type;
 253         const char* type_name;
 254         const char* var_name;
 255         STRLEN var_name_len;
 256         GV* gv;
 257 CODE:
 258         mop_deconstruct_variable_name(aTHX_ variable, &var_name, &var_name_len, &type, &type_name);
 259         gv = mop_get_gv(aTHX_ self, type, var_name, var_name_len, 0);
 260         RETVAL = mop_gv_elem(aTHX_ gv, type, FALSE) ? TRUE : FALSE;
 261 OUTPUT:
 262         RETVAL
 263
 264 SV*
 265 get_package_symbol(SV* self, SV* variable, ...)
 266 PREINIT:
 267         svtype type;
 268         const char* type_name;
 269         const char* var_name;
 270         STRLEN var_name_len;
 271         I32 flags = 0;
 272         GV* gv;
 273         SV* sv;
 274 CODE:
 275         { /* parse options */
 276                 I32 i;
 277                 if((items % 2) != 0){
 278                         croak("Odd number of arguments for get_package_symbol()");
 279                 }
 280                 for(i = 2; i < items; i += 2){
 281                         SV* const opt = ST(i);
 282                         SV* const val = ST(i+1);
 283                         if(strEQ(SvPV_nolen_const(opt), "create")){
 284                                 if(SvTRUE(val)){
 285                                         flags |= GV_ADDMULTI;
 286                                 }
 287                                 else{
 288                                         flags &= ~GV_ADDMULTI;
 289                                 }
 290                         }
 291                         else{
 292                                 warn("Unknown option \"%"SVf"\" for get_package_symbol()", opt);
 293                         }
 294                 }
 295         }
 296         mop_deconstruct_variable_name(aTHX_ variable, &var_name, &var_name_len, &type, &type_name);
 297         gv = mop_get_gv(aTHX_ self, type, var_name, var_name_len, flags);
 298         sv = mop_gv_elem(aTHX_ gv, type, FALSE);
 299
 300         RETVAL = sv ? newRV_inc(sv) : &PL_sv_undef;
 301 OUTPUT:
 302         RETVAL