#define NEED_newSVpvn_flags_GLOBAL #include "mouse.h" /* keywords for methods/keys */ SV* mouse_package; SV* mouse_namespace; SV* mouse_methods; SV* mouse_name; SV* mouse_get_attribute; SV* mouse_get_attribute_list; SV* mouse_coerce; #define MOUSE_xc_flags(a) SvUVX(MOUSE_av_at((a), MOUSE_XC_FLAGS)) #define MOUSE_xc_gen(a) MOUSE_av_at((a), MOUSE_XC_GEN) #define MOUSE_xc_stash(a) ( (HV*)MOUSE_av_at((a), MOUSE_XC_STASH) ) #define MOUSE_xc_attrall(a) ( (AV*)MOUSE_av_at((a), MOUSE_XC_ATTRALL) ) #define MOUSE_xc_buildall(a) ( (AV*)MOUSE_av_at((a), MOUSE_XC_BUILDALL) ) #define MOUSE_xc_demolishall(a) ( (AV*)MOUSE_av_at((a), MOUSE_XC_DEMOLISHALL) ) enum mouse_xc_flags_t { MOUSEf_XC_IS_IMMUTABLE = 0x0001, MOUSEf_XC_IS_ANON = 0x0002, MOUSEf_XC_HAS_BUILDARGS = 0x0004, MOUSEf_XC_mask = 0xFFFF /* not used */ }; /* Mouse XS Metaclass object */ enum mouse_xc_ix_t{ MOUSE_XC_FLAGS, MOUSE_XC_GEN, /* class generation */ MOUSE_XC_STASH, /* symbol table hash */ MOUSE_XC_ATTRALL, /* all the attributes */ MOUSE_XC_BUILDALL, /* all the BUILD methods */ MOUSE_XC_DEMOLISHALL, /* all the DEMOLISH methods */ MOUSE_XC_last }; static MGVTBL mouse_xc_vtbl; /* for identity */ static void mouse_class_push_attribute_list(pTHX_ SV* const metaclass, AV* const attrall, HV* const seen){ dSP; I32 n; /* $meta->get_attribute_list */ PUSHMARK(SP); XPUSHs(metaclass); PUTBACK; n = call_sv(mouse_get_attribute_list, G_ARRAY | G_METHOD); for(NOOP; n > 0; n--){ SV* name; SPAGAIN; name = POPs; PUTBACK; if(hv_exists_ent(seen, name, 0U)){ continue; } (void)hv_store_ent(seen, name, &PL_sv_undef, 0U); av_push(attrall, newSVsv( mcall1(metaclass, mouse_get_attribute, name) )); } } static int mouse_class_has_custom_buildargs(pTHX_ HV* const stash) { XS(XS_Mouse__Object_BUILDARGS); /* prototype */ GV* const buildargs = gv_fetchmeth_autoload(stash, "BUILDARGS", sizeof("BUILDARGS")-1, 0); return buildargs && CvXSUB(GvCV(buildargs)) != XS_Mouse__Object_BUILDARGS; } static void mouse_class_update_xc(pTHX_ SV* const metaclass PERL_UNUSED_DECL, HV* const stash, AV* const xc) { AV* const linearized_isa = mro_get_linear_isa(stash); I32 const len = AvFILLp(linearized_isa); I32 i; U32 flags = 0x00; AV* const attrall = newAV(); AV* const buildall = newAV(); AV* const demolishall = newAV(); HV* const seen = newHV(); /* for attributes */ ENTER; SAVETMPS; sv_2mortal((SV*)seen); /* old data will be delete at the end of the perl scope */ av_delete(xc, MOUSE_XC_DEMOLISHALL, 0x00); av_delete(xc, MOUSE_XC_BUILDALL, 0x00); av_delete(xc, MOUSE_XC_ATTRALL, 0x00); SvREFCNT_inc_simple_void_NN(linearized_isa); sv_2mortal((SV*)linearized_isa); /* update */ if(predicate_calls(metaclass, "is_immutable")){ flags |= MOUSEf_XC_IS_IMMUTABLE; } if(predicate_calls(metaclass, "is_anon_class")){ flags |= MOUSEf_XC_IS_ANON; } if(mouse_class_has_custom_buildargs(aTHX_ stash)){ flags |= MOUSEf_XC_HAS_BUILDARGS; } av_store(xc, MOUSE_XC_FLAGS, newSVuv(flags)); av_store(xc, MOUSE_XC_ATTRALL, (SV*)attrall); av_store(xc, MOUSE_XC_BUILDALL, (SV*)buildall); av_store(xc, MOUSE_XC_DEMOLISHALL, (SV*)demolishall); for(i = 0; i < len; i++){ SV* const klass = MOUSE_av_at(linearized_isa, i); HV* const st = gv_stashsv(klass, TRUE); SV* meta; GV* gv; gv = stash_fetchs(st, "BUILD", FALSE); if(gv && GvCVu(gv)){ av_unshift(buildall, 1); av_store(buildall, 0, newRV_inc((SV*)GvCV(gv))); } gv = stash_fetchs(st, "DEMOLISH", FALSE); if(gv && GvCVu(gv)){ av_push(demolishall, newRV_inc((SV*)GvCV(gv))); } /* ATTRIBUTES */ meta = get_metaclass(klass); if(!SvOK(meta)){ continue; /* skip non-Mouse classes */ } mouse_class_push_attribute_list(aTHX_ meta, attrall, seen); } FREETMPS; LEAVE; sv_setuv(MOUSE_xc_gen(xc), mro_get_pkg_gen(stash)); } static AV* mouse_get_xc(pTHX_ SV* const metaclass) { AV* xc; SV* gen; HV* stash; MAGIC* mg; if(!IsObject(metaclass)){ croak("Not a Mouse metaclass"); } mg = mouse_mg_find(aTHX_ SvRV(metaclass), &mouse_xc_vtbl, 0x00); if(!mg){ SV* const package = get_slot(metaclass, mouse_package); STRLEN len; const char* const pv = SvPV_const(package, len); stash = gv_stashpvn(pv, len, TRUE); xc = newAV(); mg = sv_magicext(SvRV(metaclass), (SV*)xc, PERL_MAGIC_ext, &mouse_xc_vtbl, pv, len); SvREFCNT_dec(xc); /* refcnt++ in sv_magicext */ av_extend(xc, MOUSE_XC_last - 1); av_store(xc, MOUSE_XC_GEN, newSVuv(0U)); av_store(xc, MOUSE_XC_STASH, (SV*)stash); SvREFCNT_inc_simple_void_NN(stash); } else{ xc = (AV*)MOUSE_mg_obj(mg); assert(xc); assert(SvTYPE(xc) == SVt_PVAV); } gen = MOUSE_xc_gen(xc); if(SvUVX(gen) != 0U && MOUSE_xc_flags(xc) & MOUSEf_XC_IS_IMMUTABLE){ return xc; } stash = MOUSE_xc_stash(xc); if(SvUVX(gen) != mro_get_pkg_gen(stash)){ mouse_class_update_xc(aTHX_ metaclass, stash, xc); } return xc; } static HV* mouse_buildargs(pTHX_ SV* metaclass, SV* const klass, I32 ax, I32 items) { HV* args; /* shift @_ */ ax++; items--; if(items == 1){ SV* const args_ref = ST(0); if(!IsHashRef(args_ref)){ if(!metaclass){ metaclass = get_metaclass(klass); } mouse_throw_error(metaclass, NULL, "Single parameters to new() must be a HASH ref"); } args = newHVhv((HV*)SvRV(args_ref)); sv_2mortal((SV*)args); } else{ I32 i; args = newHV_mortal(); if( (items % 2) != 0 ){ if(!metaclass){ metaclass = get_metaclass(klass); } mouse_throw_error(metaclass, NULL, "Odd number of parameters to new()"); } for(i = 0; i < items; i += 2){ (void)hv_store_ent(args, ST(i), newSVsv(ST(i+1)), 0U); } } return args; } static void mouse_class_initialize_object(pTHX_ SV* const meta, SV* const object, HV* const args, bool const ignore_triggers) { AV* const xc = mouse_get_xc(aTHX_ meta); AV* const attrs = MOUSE_xc_attrall(xc); I32 len = AvFILLp(attrs) + 1; I32 i; AV* triggers_queue = NULL; assert(meta || object); assert(args); assert(SvTYPE(args) == SVt_PVHV); if(mg_find((SV*)args, PERL_MAGIC_tied)){ croak("You cannot use tied HASH reference as initializing arguments"); } if(!ignore_triggers){ triggers_queue = newAV_mortal(); } for(i = 0; i < len; i++){ SV* const attr = MOUSE_av_at(attrs, i); AV* const xa = mouse_get_xa(aTHX_ attr); SV* const slot = MOUSE_xa_slot(xa); U16 const flags = (U16)MOUSE_xa_flags(xa); SV* const init_arg = MOUSE_xa_init_arg(xa); HE* he; if(SvOK(init_arg) && ( he = hv_fetch_ent(args, init_arg, FALSE, 0U) ) ){ SV* value = HeVAL(he); if(flags & MOUSEf_ATTR_HAS_TC){ value = mouse_xa_apply_type_constraint(aTHX_ xa, value, flags); } value = set_slot(object, slot, value); if(SvROK(value) && flags & MOUSEf_ATTR_IS_WEAK_REF){ weaken_slot(object, slot); } if(flags & MOUSEf_ATTR_HAS_TRIGGER && triggers_queue){ AV* const pair = newAV(); av_push(pair, newSVsv( mcall0s(attr, "trigger") )); av_push(pair, newSVsv(value)); av_push(triggers_queue, (SV*)pair); } } else { /* no init arg */ if(flags & (MOUSEf_ATTR_HAS_DEFAULT | MOUSEf_ATTR_HAS_BUILDER)){ if(!(flags & MOUSEf_ATTR_IS_LAZY)){ mouse_xa_set_default(aTHX_ xa, object); } } else if(flags & MOUSEf_ATTR_IS_REQUIRED) { mouse_throw_error(attr, NULL, "Attribute (%"SVf") is required", slot); } } } /* for each attributes */ if(triggers_queue){ len = AvFILLp(triggers_queue) + 1; for(i = 0; i < len; i++){ AV* const pair = (AV*)AvARRAY(triggers_queue)[i]; SV* const trigger = AvARRAY(pair)[0]; SV* const value = AvARRAY(pair)[1]; mcall1(object, trigger, value); } } if(MOUSE_xc_flags(xc) & MOUSEf_XC_IS_ANON){ (void)set_slot(object, newSVpvs_flags("__METACLASS__", SVs_TEMP), meta); } } static SV* mouse_initialize_metaclass(pTHX_ SV* const klass) { SV* meta = get_metaclass(klass); if(!SvOK(meta)){ dSP; PUSHMARK(SP); EXTEND(SP, 2); mPUSHp("Mouse::Meta::Class", sizeof("Mouse::Meta::Class")-1); PUSHs(klass); PUTBACK; call_method("initialize", G_SCALAR); SPAGAIN; meta = POPs; PUTBACK; } return meta; } static void mouse_buildall(pTHX_ AV* const xc, SV* const object, SV* const args) { AV* const buildall = MOUSE_xc_buildall(xc); I32 const len = AvFILLp(buildall) + 1; I32 i; for(i = 0; i < len; i++){ dSP; PUSHMARK(SP); EXTEND(SP, 2); PUSHs(object); PUSHs(args); PUTBACK; call_sv(AvARRAY(buildall)[i], G_VOID); /* discard a scalar which G_VOID returns */ SPAGAIN; (void)POPs; PUTBACK; } } MODULE = Mouse PACKAGE = Mouse PROTOTYPES: DISABLE BOOT: mouse_package = newSVpvs_share("package"); mouse_namespace = newSVpvs_share("namespace"); mouse_methods = newSVpvs_share("methods"); mouse_name = newSVpvs_share("name"); mouse_coerce = newSVpvs_share("coerce"); mouse_get_attribute = newSVpvs_share("get_attribute"); mouse_get_attribute_list = newSVpvs_share("get_attribute_list"); MOUSE_CALL_BOOT(Mouse__Util); MOUSE_CALL_BOOT(Mouse__Util__TypeConstraints); MOUSE_CALL_BOOT(Mouse__Meta__Method__Accessor__XS); MOUSE_CALL_BOOT(Mouse__Meta__Attribute); MODULE = Mouse PACKAGE = Mouse::Meta::Module BOOT: INSTALL_SIMPLE_READER_WITH_KEY(Module, name, package); INSTALL_SIMPLE_READER_WITH_KEY(Module, _method_map, methods); INSTALL_SIMPLE_READER_WITH_KEY(Module, _attribute_map, attributes); HV* namespace(SV* self) CODE: { SV* const package = get_slot(self, mouse_package); if(!(package && SvOK(package))){ croak("No package name defined"); } RETVAL = gv_stashsv(package, GV_ADDMULTI); } OUTPUT: RETVAL # ignore extra arguments for extensibility void add_method(SV* self, SV* name, SV* code, ...) CODE: { SV* const package = get_slot(self, mouse_package); /* $self->{package} */ SV* const methods = get_slot(self, mouse_methods); /* $self->{methods} */ GV* gv; SV* code_ref; if(!(package && SvOK(package))){ croak("No package name defined"); } SvGETMAGIC(name); SvGETMAGIC(code); if(!SvOK(name)){ mouse_throw_error(self, NULL, "You must define a method name"); } if(!SvROK(code)){ mouse_throw_error(self, NULL, "You must define a CODE reference"); } code_ref = code; if(SvTYPE(SvRV(code_ref)) != SVt_PVCV){ SV* sv = code_ref; /* used in tryAMAGICunDEREF */ SV** sp = &sv; /* used in tryAMAGICunDEREF */ tryAMAGICunDEREF(to_cv); /* try \&{$code} */ if(!(SvROK(sv) && SvTYPE(SvRV(sv)) == SVt_PVCV)){ mouse_throw_error(self, NULL, "You must pass a CODE reference to add_method"); } code_ref = sv; } /* *{$package . '::' . $name} -> *gv */ gv = gv_fetchpv(form("%"SVf"::%"SVf, package, name), GV_ADDMULTI, SVt_PVCV); 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 */ (void)set_slot(methods, name, code); /* $self->{methods}{$name} = $code */ /* name the CODE ref if it's anonymous */ { CV* const code_entity = (CV*)SvRV(code_ref); if(CvANON(code_entity) && CvGV(code_entity) /* 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(code_entity), 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(code_entity) = gv; CvANON_off(code_entity); } } } MODULE = Mouse PACKAGE = Mouse::Meta::Class BOOT: INSTALL_SIMPLE_READER(Class, roles); INSTALL_SIMPLE_PREDICATE_WITH_KEY(Class, is_anon_class, anon_serial_id); INSTALL_SIMPLE_READER(Class, is_immutable); INSTALL_CLASS_HOLDER(Class, method_metaclass, "Mouse::Meta::Method"); INSTALL_CLASS_HOLDER(Class, attribute_metaclass, "Mouse::Meta::Attribute"); INSTALL_CLASS_HOLDER(Class, constructor_class, "Mouse::Meta::Method::Constructor::XS"); INSTALL_CLASS_HOLDER(Class, destructor_class, "Mouse::Meta::Method::Destructor::XS"); newCONSTSUB(gv_stashpvs("Mouse::Meta::Method::Constructor::XS", TRUE), "_generate_constructor", newRV_inc((SV*)get_cvs("Mouse::Object::new", TRUE))); newCONSTSUB(gv_stashpvs("Mouse::Meta::Method::Destructor::XS", TRUE), "_generate_destructor", newRV_inc((SV*)get_cvs("Mouse::Object::DESTROY", TRUE))); void linearized_isa(SV* self) PPCODE: { SV* const stash_ref = mcall0(self, mouse_namespace); /* $self->namespace */ AV* linearized_isa; I32 len; I32 i; if(!(SvROK(stash_ref) && SvTYPE(SvRV(stash_ref)) == SVt_PVHV)){ croak("namespace() didn't return a HASH reference"); } linearized_isa = mro_get_linear_isa((HV*)SvRV(stash_ref)); len = AvFILLp(linearized_isa) + 1; EXTEND(SP, len); for(i = 0; i < len; i++){ PUSHs(AvARRAY(linearized_isa)[i]); } } void get_all_attributes(SV* self) PPCODE: { AV* const xc = mouse_get_xc(aTHX_ self); AV* const all_attrs = MOUSE_xc_attrall(xc); I32 const len = AvFILLp(all_attrs) + 1; I32 i; EXTEND(SP, len); for(i = 0; i < len; i++){ PUSHs( MOUSE_av_at(all_attrs, i) ); } } SV* new_object(SV* meta, ...) CODE: { AV* const xc = mouse_get_xc(aTHX_ meta); HV* const args = mouse_buildargs(aTHX_ meta, NULL, ax, items); RETVAL = mouse_instance_create(aTHX_ MOUSE_xc_stash(xc)); mouse_class_initialize_object(aTHX_ meta, RETVAL, args, FALSE); } OUTPUT: RETVAL void _initialize_object(SV* meta, SV* object, HV* args, bool ignore_triggers = FALSE) CODE: { mouse_class_initialize_object(aTHX_ meta, object, args, ignore_triggers); } MODULE = Mouse PACKAGE = Mouse::Meta::Role BOOT: INSTALL_SIMPLE_READER_WITH_KEY(Role, get_roles, roles); INSTALL_SIMPLE_PREDICATE_WITH_KEY(Role, is_anon_role, anon_serial_id); INSTALL_CLASS_HOLDER(Role, method_metaclass, "Mouse::Meta::Role::Method"); MODULE = Mouse PACKAGE = Mouse::Object SV* new(SV* klass, ...) CODE: { SV* const meta = mouse_initialize_metaclass(aTHX_ klass); AV* const xc = mouse_get_xc(aTHX_ meta); UV const flags = MOUSE_xc_flags(xc); SV* args; /* BUILDARGS */ if(flags & MOUSEf_XC_HAS_BUILDARGS){ I32 i; SPAGAIN; PUSHMARK(SP); EXTEND(SP, items); for(i = 0; i < items; i++){ PUSHs(ST(i)); } //SP += items; PUTBACK; call_method("BUILDARGS", G_SCALAR); SPAGAIN; args = POPs; PUTBACK; if(!IsHashRef(args)){ croak("BUILDARGS did not return a HASH reference"); } } else{ args = newRV_inc((SV*)mouse_buildargs(aTHX_ meta, klass, ax, items)); sv_2mortal(args); } /* new_object */ RETVAL = mouse_instance_create(aTHX_ MOUSE_xc_stash(xc)); mouse_class_initialize_object(aTHX_ meta, RETVAL, (HV*)SvRV(args), FALSE); mouse_buildall(aTHX_ xc, RETVAL, args); } OUTPUT: RETVAL void DESTROY(SV* object) ALIAS: DESTROY = 0 DEMOLISHALL = 1 CODE: { SV* const meta = get_metaclass(object); AV* demolishall; I32 len, i; if(!IsObject(object)){ croak("You must not call %s as a class method", ix == 0 ? "DESTROY" : "DEMOLISHALL"); } if(SvOK(meta)){ AV* const xc = mouse_get_xc(aTHX_ meta); demolishall = MOUSE_xc_demolishall(xc); } else { /* The metaclass is already destroyed */ AV* const linearized_isa = mro_get_linear_isa(SvSTASH(SvRV(object))); len = AvFILLp(linearized_isa) + 1; demolishall = newAV_mortal(); for(i = 0; i < len; i++){ SV* const klass = MOUSE_av_at(linearized_isa, i); HV* const st = gv_stashsv(klass, TRUE); GV* const gv = stash_fetchs(st, "DEMOLISH", FALSE); if(gv && GvCVu(gv)){ av_push(demolishall, newRV_inc((SV*)GvCV(gv))); } } } len = AvFILLp(demolishall) + 1; if(len > 0){ GV* const statusvalue = gv_fetchpvs("?", 0, SVt_PV); SAVESPTR(GvSV(statusvalue)); /* local $? */ SAVESPTR(ERRSV); /* local $@ */ GvSV(statusvalue) = sv_newmortal(); ERRSV = newSVpvs_flags("", SVs_TEMP); for(i = 0; i < len; i++){ SPAGAIN; PUSHMARK(SP); XPUSHs(object); XPUSHs(boolSV(PL_dirty)); PUTBACK; call_sv(AvARRAY(demolishall)[i], G_VOID | G_EVAL); /* discard a scalar which G_VOID returns */ SPAGAIN; (void)POPs; PUTBACK; if(sv_true(ERRSV)){ SV* const e = newSVsv(ERRSV); FREETMPS; LEAVE; sv_setsv(ERRSV, e); SvREFCNT_dec(e); croak(NULL); /* rethrow */ } } } } HV* BUILDARGS(SV* klass, ...) CODE: { RETVAL = mouse_buildargs(aTHX_ NULL, klass, ax, items); } OUTPUT: RETVAL void BUILDALL(SV* self, SV* args) CODE: { SV* const meta = get_metaclass(self); AV* const xc = mouse_get_xc(aTHX_ meta); if(!IsHashRef(args)){ croak("You must pass a HASH reference to BUILDALL"); } mouse_buildall(aTHX_ xc, self, args); }