From: gfx Date: Sat, 24 Oct 2009 08:59:15 +0000 (+0900) Subject: _get_code_ref() and get_linear_isa() in XS X-Git-Tag: 0.40_01~27 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=cccb83dea141cc50ab03aedefda36c5822a7b98f;p=gitmo%2FMouse.git _get_code_ref() and get_linear_isa() in XS --- diff --git a/lib/Mouse/Meta/Class.pm b/lib/Mouse/Meta/Class.pm index 46cfd31..9b43135 100644 --- a/lib/Mouse/Meta/Class.pm +++ b/lib/Mouse/Meta/Class.pm @@ -171,7 +171,7 @@ sub get_all_attributes { return @attr; } -sub linearized_isa { @{ get_linear_isa($_[0]->name) } } +sub linearized_isa; sub new_object { my $self = shift; diff --git a/lib/Mouse/Meta/Module.pm b/lib/Mouse/Meta/Module.pm index 383f51d..44e990d 100755 --- a/lib/Mouse/Meta/Module.pm +++ b/lib/Mouse/Meta/Module.pm @@ -110,11 +110,7 @@ sub has_method { return 1 if $self->{methods}{$method_name}; - my $code = do{ - no strict 'refs'; - no warnings 'once'; - *{ $self->{package} . '::' . $method_name }{CODE}; - }; + my $code = $self->_get_code_ref($method_name); return $code && $self->_code_is_mine($code); } @@ -126,12 +122,7 @@ sub get_method_body{ or $self->throw_error('You must define a method name'); return $self->{methods}{$method_name} ||= do{ - my $code = do{ - no strict 'refs'; - no warnings 'once'; - *{$self->{package} . '::' . $method_name}{CODE}; - }; - + my $code = $self->_get_code_ref($method_name); ($code && $self->_code_is_mine($code)) ? $code : undef; }; } diff --git a/lib/Mouse/PurePerl.pm b/lib/Mouse/PurePerl.pm index ea59be6..07b4520 100644 --- a/lib/Mouse/PurePerl.pm +++ b/lib/Mouse/PurePerl.pm @@ -86,6 +86,8 @@ sub is_anon_class{ sub roles { $_[0]->{roles} } +sub linearized_isa { @{ get_linear_isa($_[0]->{package}) } } + package Mouse::Meta::Role; diff --git a/mouse.h b/mouse.h index 2f4312e..781d149 100644 --- a/mouse.h +++ b/mouse.h @@ -8,12 +8,32 @@ #include "ppport.h" +#ifndef newSVpvs_share +#define newSVpvs_share(s) Perl_newSVpvn_share(aTHX_ s, sizeof(s)-1, 0U) +#endif + +#ifndef mro_get_linear_isa +#define no_mro_get_linear_isa +#define mro_get_linear_isa(stash) mouse_mro_get_linear_isa(aTHX_ stash) +AV* mouse_mro_get_linear_isa(pTHX_ HV* const stash) +#endif /* !mro_get_linear_isa */ + +#ifndef mro_get_pkg_gen +#ifdef no_mro_get_linear_isa +#define mro_get_pkg_gen(stash) ((void)stash, PL_sub_generation) +#else +#define mro_get_pkg_gen(stash) (HvAUX(stash)->xhv_mro_meta ? HvAUX(stash)->xhv_mro_meta->pkg_gen : (U32)0) +#endif /* !no_mro_get_linear_isa */ +#endif /* mro_get_package_gen */ + #define MOUSE_CALL_BOOT(name) STMT_START { \ EXTERN_C XS(CAT2(boot_, name)); \ PUSHMARK(SP); \ CALL_FPTR(CAT2(boot_, name))(aTHX_ cv); \ } STMT_END +extern SV* mouse_package; +extern SV* mouse_namespace; #define is_class_loaded(sv) mouse_is_class_loaded(aTHX_ sv) bool mouse_is_class_loaded(pTHX_ SV*); diff --git a/xs-src/Mouse.xs b/xs-src/Mouse.xs index 4a00765..5a6c844 100644 --- a/xs-src/Mouse.xs +++ b/xs-src/Mouse.xs @@ -1,9 +1,17 @@ #include "mouse.h" +SV* mouse_package; +SV* mouse_namespace; + MODULE = Mouse PACKAGE = Mouse::Util PROTOTYPES: DISABLE +BOOT: + mouse_package = newSVpvs_share("package"); + mouse_namespace = newSVpvs_share("namespace"); + + bool is_class_loaded(SV* sv = &PL_sv_undef) @@ -41,31 +49,85 @@ BOOT: INSTALL_SIMPLE_READER_WITH_KEY(Module, _attribute_map, attributes); HV* -namespace(HV* self) +namespace(SV* self) CODE: { - SV** svp = hv_fetchs(self, "package", FALSE); - if(!(svp && SvOK(*svp))){ + SV* const package = mouse_instance_get_slot(self, mouse_package); + if(!(package && SvOK(package))){ croak("No package name"); } - RETVAL = gv_stashsv(*svp, GV_ADDMULTI); + RETVAL = gv_stashsv(package, GV_ADDMULTI); +} +OUTPUT: + RETVAL + +CV* +_get_code_ref(SV* self, SV* name) +CODE: +{ + SV* const stash_ref = mcall0(self, mouse_namespace); /* $self->namespace */ + HV* stash; + HE* he; + if(!(SvROK(stash_ref) && SvTYPE(SvRV(stash_ref)) == SVt_PVHV)){ + croak("namespace() didn't return a HASH reference"); + } + stash = (HV*)SvRV(stash_ref); + he = hv_fetch_ent(stash, name, FALSE, 0U); + if(he){ + GV* const gv = (GV*)hv_iterval(stash, he); + if(isGV(gv)){ + RETVAL = GvCVu(gv); + } + else{ /* special constant or stub */ + STRLEN len; + const char* const pv = SvPV_const(name, len); + gv_init(gv, stash, pv, len, GV_ADDMULTI); + RETVAL = GvCVu(gv); + } + } + else{ + RETVAL = NULL; + } + + if(!RETVAL){ + XSRETURN_UNDEF; + } } OUTPUT: RETVAL + MODULE = Mouse PACKAGE = Mouse::Meta::Class BOOT: INSTALL_SIMPLE_READER(Class, roles); INSTALL_SIMPLE_PREDICATE_WITH_KEY(Class, is_anon_class, anon_serial_id); +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]); + } +} + 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); - MODULE = Mouse PACKAGE = Mouse::Meta::Attribute BOOT: diff --git a/xs-src/mouse_util.xs b/xs-src/mouse_util.xs index 5da4071..9df1f65 100644 --- a/xs-src/mouse_util.xs +++ b/xs-src/mouse_util.xs @@ -1,5 +1,75 @@ #include "mouse.h" +#define ISA_CACHE "::LINEALIZED_ISA_CACHE::" + +#ifndef no_mro_get_linear_isa +AV* +mouse_mro_get_linear_isa(pTHX_ HV* const stash){ + GV* const cachegv = *(GV**)hv_fetchs(stash, ISA_CACHE, TRUE); + AV* isa; + SV* gen; + CV* get_linear_isa; + + if(!isGV(cachegv)) + gv_init(cachegv, stash, ISA_CACHE, sizeof(ISA_CACHE)-1, TRUE); + + isa = GvAVn(cachegv); + gen = GvSVn(cachegv); + + + if(SvIOK(gen) && SvIVX(gen) == (IV)mro_get_pkg_gen(stash)){ + return isa; /* returns the cache if available */ + } + else{ + SvREADONLY_off(isa); + av_clear(isa); + } + + get_linear_isa = get_cv("Mouse::Util::get_linear_isa", TRUE); + + { + SV* avref; + dSP; + + ENTER; + SAVETMPS; + + PUSHMARK(SP); + mXPUSHp(HvNAME_get(stash), HvNAMELEN_get(stash)); + PUTBACK; + + call_sv((SV*)get_linear_isa, G_SCALAR); + + SPAGAIN; + avref = POPs; + PUTBACK; + + if(SvROK(avref) && SvTYPE(SvRV(avref)) == SVt_PVAV){ + AV* const av = (AV*)SvRV(avref); + I32 const len = AvFILLp(av) + 1; + I32 i; + + for(i = 0; i < len; i++){ + HV* const stash = gv_stashsv(AvARRAY(av)[i], FALSE); + if(stash) + av_push(isa, newSVpv(HvNAME(stash), 0)); + } + SvREADONLY_on(isa); + } + else{ + Perl_croak(aTHX_ "Mouse:Util::get_linear_isa() didn't return an ARRAY reference"); + } + + FREETMPS; + LEAVE; + } + + sv_setiv(gen, (IV)mro_get_pkg_gen(stash)); + return GvAV(cachegv); +} +#endif /* !no_mor_get_linear_isa */ + + /* equivalent to "blessed($x) && $x->isa($klass)" */ bool mouse_is_instance_of(pTHX_ SV* const sv, SV* const klass){