#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:
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
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;
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:
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;
}
}
+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;