X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=MOP.xs;h=ae34df5d730bb9b30828c69dfa92c52fc31a067b;hb=3ecd1b253d51e4159c5dd0387cfe84bde55a3f43;hp=b7dfd03804e35076331ecbd5bf00a313dcf0d95a;hpb=15273f3c0305b96e49dd34030b995623bcd670c5;p=gitmo%2FClass-MOP.git diff --git a/MOP.xs b/MOP.xs index b7dfd03..ae34df5 100644 --- a/MOP.xs +++ b/MOP.xs @@ -3,9 +3,22 @@ #include "perl.h" #include "XSUB.h" +#define NEED_sv_2pv_flags #define NEED_sv_2pv_nolen #include "ppport.h" +SV *key_name; +U32 hash_name; + +SV *key_package; +U32 hash_package; + +SV *key_package_name; +U32 hash_package_name; + +SV *key_body; +U32 hash_body; + /* get_code_info: Pass in a coderef, returns: @@ -15,8 +28,21 @@ get_code_info: MODULE = Class::MOP PACKAGE = Class::MOP +BOOT: + key_name = newSVpvs("name"); + key_body = newSVpvs("body"); + key_package = newSVpvs("package"); + key_package_name = newSVpvs("package_name"); + + PERL_HASH(hash_name, "name", 4); + PERL_HASH(hash_body, "body", 4); + PERL_HASH(hash_package, "package", 7); + PERL_HASH(hash_package_name, "package_name", 12); + + PROTOTYPES: ENABLE + void get_code_info(coderef) SV* coderef @@ -51,13 +77,17 @@ get_code_info(coderef) MODULE = Class::MOP PACKAGE = Class::MOP::Package void -get_all_package_symbols(package, ...) - SV *package +get_all_package_symbols(self, ...) + SV *self PROTOTYPE: $;$ PREINIT: - HV *stash; + HV *stash = NULL; SV *type_filter = NULL; + register HE *he; PPCODE: + if (! SvROK(self)) { + die("Cannot call get_all_package_symbols as a class method"); + } switch ( GIMME_V ) { case G_VOID: return; break; @@ -68,38 +98,23 @@ get_all_package_symbols(package, ...) PUTBACK; - ENTER; - SAVETMPS; - PUSHMARK(SP); - XPUSHs(package); - PUTBACK; - call_method("name", 0); - SPAGAIN; - stash = gv_stashsv(POPs, 0); - FREETMPS; - LEAVE; - - PUTBACK; + if (he = hv_fetch_ent((HV *)SvRV(self), key_package, 0, hash_package)) + stash = gv_stashsv(HeVAL(he),0); if ( stash ) { - register HE *entry; (void)hv_iterinit(stash); if ( type_filter && SvPOK(type_filter) ) { const char *const type = SvPV_nolen(type_filter); - - while ((entry = hv_iternext(stash))) { - SV *const gv = hv_iterval(stash, entry); - SV *const key = hv_iterkeysv(entry); + while ((he = hv_iternext(stash))) { + SV *const gv = HeVAL(he); SV *sv; - char *package = HvNAME(stash); - STRLEN pkglen = strlen(package); - char *fq; - STRLEN fqlen; - - SPAGAIN; + char *key; + STRLEN keylen; + char *package; + SV *fq; switch( SvTYPE(gv) ) { case SVt_PVGV: @@ -115,35 +130,35 @@ get_all_package_symbols(package, ...) break; case SVt_RV: /* BAH! constants are horrible */ - fqlen = pkglen + SvCUR(key) + 3; - fq = (char *)alloca(fqlen); - snprintf(fq, fqlen, "%s::%s", package, SvPV_nolen(key)); - sv = get_cv(fq, 0); + + /* we don't really care about the length, + but that's the API */ + key = HePV(he, keylen); + package = HvNAME(stash); + fq = newSVpvf("%s::%s", package, key); + sv = sv_2mortal((SV*)get_cv(SvPV_nolen(fq), 0)); break; default: continue; } if ( sv ) { + SV *key = hv_iterkeysv(he); SPAGAIN; EXTEND(SP, 2); PUSHs(key); - PUSHs(newRV_noinc(sv)); + PUSHs(sv_2mortal(newRV_inc(sv))); PUTBACK; } } } else { EXTEND(SP, HvKEYS(stash) * 2); - while ((entry = hv_iternext(stash))) { - SV *sv; - SPAGAIN; - sv = hv_iterkeysv(entry); - SPAGAIN; - PUSHs(sv); - PUTBACK; - sv = hv_iterval(stash, entry); + while ((he = hv_iternext(stash))) { + SV *key = hv_iterkeysv(he); + SV *sv = HeVAL(he); SPAGAIN; + PUSHs(key); PUSHs(sv); PUTBACK; } @@ -151,3 +166,81 @@ get_all_package_symbols(package, ...) } +SV * +name(self) + SV *self + PREINIT: + register HE *he; + PPCODE: + if (! SvROK(self)) { + die("Cannot call name as a class method"); + } + + if (he = hv_fetch_ent((HV *)SvRV(self), key_package, 0, hash_package)) + XPUSHs(HeVAL(he)); + else + ST(0) = &PL_sv_undef; + +MODULE = Class::MOP PACKAGE = Class::MOP::Attribute + +SV * +name(self) + SV *self + PREINIT: + register HE *he; + PPCODE: + if (! SvROK(self)) { + die("Cannot call name as a class method"); + } + + if (he = hv_fetch_ent((HV *)SvRV(self), key_name, 0, hash_name)) + XPUSHs(HeVAL(he)); + else + ST(0) = &PL_sv_undef; + +MODULE = Class::MOP PACKAGE = Class::MOP::Method + +SV * +name(self) + SV *self + PREINIT: + register HE *he; + PPCODE: + if (! SvROK(self)) { + die("Cannot call name as a class method"); + } + + if (he = hv_fetch_ent((HV *)SvRV(self), key_name, 0, hash_name)) + XPUSHs(HeVAL(he)); + else + ST(0) = &PL_sv_undef; + +SV * +package_name(self) + SV *self + PREINIT: + register HE *he; + PPCODE: + if (! SvROK(self)) { + die("Cannot call package_name as a class method"); + } + + if (he = hv_fetch_ent((HV *)SvRV(self), key_package_name, 0, hash_package_name)) + XPUSHs(HeVAL(he)); + else + ST(0) = &PL_sv_undef; + +SV * +body(self) + SV *self + PREINIT: + register HE *he; + PPCODE: + if (! SvROK(self)) { + die("Cannot call body as a class method"); + } + + if (he = hv_fetch_ent((HV *)SvRV(self), key_body, 0, hash_body)) + XPUSHs(HeVAL(he)); + else + ST(0) = &PL_sv_undef;