#include "mouse.h"
+#define MY_CXT_KEY "Mouse::Util::_guts" XS_VERSION
+typedef struct {
+ HV* metas;
+} my_cxt_t;
+START_MY_CXT
+
#define ISA_CACHE "::LINEALIZED_ISA_CACHE::"
#ifdef no_mro_get_linear_isa
va_list args;
SV* message;
- PERL_UNUSED_ARG(data); /* for moose-compat */
-
assert(metaobject);
assert(fmt);
{
dSP;
PUSHMARK(SP);
- EXTEND(SP, 4);
+ EXTEND(SP, 6);
PUSHs(metaobject);
mPUSHs(message);
- mPUSHs(newSVpvs("depth"));
- mPUSHi(-1);
+ if(data){ /* extra arg, might be useful for debugging */
+ mPUSHs(newSVpvs("data"));
+ PUSHs(data);
+ mPUSHs(newSVpvs("depth"));
+ mPUSHi(-1);
+ }
PUTBACK;
}
}
+void
+mouse_must_defined(pTHX_ SV* const value, const char* const name) {
+ assert(value);
+ assert(name);
+
+ SvGETMAGIC(value);
+ if(!SvOK(value)){
+ croak("You must define %s", name);
+ }
+}
+
+void
+mouse_must_ref(pTHX_ SV* const value, const char* const name, svtype const t) {
+ assert(value);
+ assert(name);
+
+ SvGETMAGIC(value);
+ if(!(SvROK(value) && (t == SVt_NULL || SvTYPE(SvRV(value)) == t))) {
+ croak("You must pass %s, not %s",
+ name, SvOK(value) ? SvPV_nolen(value) : "undef");
+ }
+}
+
+
bool
mouse_is_class_loaded(pTHX_ SV * const klass){
HV *stash;
int
mouse_predicate_call(pTHX_ SV* const self, SV* const method) {
- SV* const value = mcall0(self, method);
- return SvTRUE(value);
+ return sv_true( mcall0(self, method) );
}
SV*
mouse_get_metaclass(pTHX_ SV* metaclass_name){
- CV* const get_metaclass = get_cvs("Mouse::Util::get_metaclass_by_name", TRUE);
- SV* metaclass;
- dSP;
+ dMY_CXT;
+ HE* he;
assert(metaclass_name);
+ assert(MY_CXT.metas);
+
if(IsObject(metaclass_name)){
- HV* const stash = SvSTASH(metaclass_name);
+ HV* const stash = SvSTASH(SvRV(metaclass_name));
metaclass_name = newSVpvn_share(HvNAME_get(stash), HvNAMELEN_get(stash), 0U);
sv_2mortal(metaclass_name);
}
- PUSHMARK(SP);
- XPUSHs(metaclass_name);
- PUTBACK;
+ he = hv_fetch_ent(MY_CXT.metas, metaclass_name, FALSE, 0U);
- call_sv((SV*)get_metaclass, G_SCALAR);
-
- SPAGAIN;
- metaclass = POPs;
- PUTBACK;
-
- return metaclass;
+ return he ? HeVAL(he) : &PL_sv_undef;
}
MAGIC*
}
}
+void
+mouse_install_sub(pTHX_ GV* const gv, SV* const code_ref) {
+ CV* cv;
+
+ assert(gv != NULL);
+ assert(code_ref != NULL);
+ assert(isGV(gv));
+ assert(IsCodeRef(code_ref));
+
+ if(GvCVu(gv)){ /* delete *slot{gv} to work around "redefine" warning */
+ SvREFCNT_dec(GvCV(gv));
+ GvCV(gv) = NULL;
+ }
+
+ sv_setsv_mg((SV*)gv, code_ref); /* *gv = $code_ref */
+
+ /* name the CODE ref if it's anonymous */
+ cv = (CV*)SvRV(code_ref);
+ if(CvANON(cv)
+ && CvGV(cv) /* a cv under construction has no gv */ ){
+ HV* dbsub;
+
+ /* update %DB::sub to make NYTProf happy */
+ if((PL_perldb & (PERLDBf_SUBLINE|PERLDB_NAMEANON))
+ && PL_DBsub && (dbsub = GvHV(PL_DBsub))
+ ){
+ /* see Perl_newATTRSUB() in op.c */
+ SV* const subname = sv_newmortal();
+ HE* orig;
+
+ gv_efullname3(subname, CvGV(cv), NULL);
+ orig = hv_fetch_ent(dbsub, subname, FALSE, 0U);
+ if(orig){
+ gv_efullname3(subname, gv, NULL);
+ (void)hv_store_ent(dbsub, subname, HeVAL(orig), 0U);
+ SvREFCNT_inc_simple_void_NN(HeVAL(orig));
+ }
+ }
+
+ CvGV(cv) = gv;
+ CvANON_off(cv);
+ }
+}
+
MODULE = Mouse::Util PACKAGE = Mouse::Util
PROTOTYPES: DISABLE
VERSIONCHECK: DISABLE
+BOOT:
+{
+ MY_CXT_INIT;
+ MY_CXT.metas = NULL;
+}
+
+void
+__register_metaclass_storage(HV* metas, bool cloning)
+CODE:
+{
+ if(cloning){
+ MY_CXT_CLONE;
+ MY_CXT.metas = NULL;
+ }
+ {
+ dMY_CXT;
+ if(MY_CXT.metas) croak("Cannot set metaclass storage more than once");
+ MY_CXT.metas = metas;
+ SvREFCNT_inc_simple_void_NN(metas);
+ }
+}
+
+bool
+is_valid_class_name(SV* sv)
+CODE:
+{
+ SvGETMAGIC(sv);
+ if(SvPOKp(sv) && SvCUR(sv) > 0){
+ UV i;
+ RETVAL = TRUE;
+ for(i = 0; i < SvCUR(sv); i++){
+ char const c = SvPVX(sv)[i];
+ if(!(isALNUM(c) || c == ':')){
+ RETVAL = FALSE;
+ break;
+ }
+ }
+ }
+ else{
+ RETVAL = SvNIOKp(sv) ? TRUE : FALSE;
+ }
+}
+OUTPUT:
+ RETVAL
+
bool
is_class_loaded(SV* sv)
const char* name_pv;
GV* gv;
- if(!SvOK(package)){
- croak("You must define a package name");
- }
- if(!SvOK(name)){
- croak("You must define a subroutine name");
- }
+ must_defined(package, "a package name");
+ must_defined(name, "a subroutine name");
stash = gv_stashsv(package, FALSE);
if(!stash){
RETVAL
void
-generate_isa_predicate_for(SV* klass, SV* predicate_name = NULL)
+generate_isa_predicate_for(SV* arg, SV* predicate_name = NULL)
+ALIAS:
+ generate_isa_predicate_for = 0
+ generate_can_predicate_for = 1
PPCODE:
{
const char* name_pv = NULL;
CV* xsub;
- SvGETMAGIC(klass);
-
- if(!SvOK(klass)){
- croak("You must define a class name");
- }
+ must_defined(arg, ix == 0 ? "a class_name" : "method names");
if(predicate_name){
- SvGETMAGIC(predicate_name);
- if(!SvOK(predicate_name)){
- croak("You must define a predicate_name");
- }
+ must_defined(predicate_name, "a predicate name");
name_pv = SvPV_nolen_const(predicate_name);
}
- xsub = mouse_generate_isa_predicate_for(aTHX_ klass, name_pv);
+ if(ix == 0){
+ xsub = mouse_generate_isa_predicate_for(aTHX_ arg, name_pv);
+ }
+ else{
+ xsub = mouse_generate_can_predicate_for(aTHX_ arg, name_pv);
+ }
if(predicate_name == NULL){ /* anonymous predicate */
- XPUSHs( newRV_noinc((SV*)xsub) );
+ mXPUSHs( newRV_inc((SV*)xsub) );
+ }
+}
+
+# This xsub will redefine &Mouse::Util::install_subroutines()
+void
+install_subroutines(SV* into, ...)
+CODE:
+{
+ HV* stash;
+ I32 i;
+
+ must_defined(into, "a package name");
+ stash = gv_stashsv(into, TRUE);
+
+ if( ((items-1) % 2) != 0 ){
+ croak_xs_usage(cv, "into, name => coderef [, other_name, other_coderef ...]");
+ }
+
+ for(i = 1; i < items; i += 2) {
+ SV* const name = ST(i);
+ SV* const code = ST(i+1);
+ STRLEN len;
+ const char* pv;
+ GV* gv;
+
+ must_defined(name, "a subroutine name");
+ must_ref(code, "a CODE reference", SVt_PVCV);
+
+ pv = SvPV_const(name, len);
+ gv = stash_fetch(stash, pv, len, TRUE);
+
+ mouse_install_sub(aTHX_ gv, code);
}
}
projects / gitmo/Mouse.git / blobdiff