package Mouse::Meta::Module;
-use Mouse::Util qw/:meta get_code_package load_class not_supported/; # enables strict and warnings
+use Mouse::Util qw/:meta get_code_package get_code_ref load_class not_supported/; # enables strict and warnings
use Carp ();
use Scalar::Util qw/blessed weaken/;
return 1 if $self->{methods}{$method_name};
- my $code = $self->_get_code_ref($method_name);
+ my $code = get_code_ref($self->{package}, $method_name);
return $code && $self->_code_is_mine($code);
}
or $self->throw_error('You must define a method name');
return $self->{methods}{$method_name} ||= do{
- my $code = $self->_get_code_ref($method_name);
+ my $code = get_code_ref($self->{package}, $method_name);
($code && $self->_code_is_mine($code)) ? $code : undef;
};
}
return $gv->STASH->NAME;
}
+sub get_code_ref{
+ my($package, $name) = @_;
+ no strict 'refs';
+ no warnings 'once';
+ use warnings FATAL => 'uninitialized';
+ return *{$package . '::' . $name}{CODE};
+}
+
+package
+ Mouse::Util::TypeConstraints;
+
+sub Any { 1 }
+sub Item { 1 }
+sub Maybe { 1 }
+
+sub Bool { $_[0] ? $_[0] eq '1' : 1 }
+sub Undef { !defined($_[0]) }
+sub Defined { defined($_[0]) }
+sub Value { defined($_[0]) && !ref($_[0]) }
+sub Num { !ref($_[0]) && looks_like_number($_[0]) }
+sub Int { defined($_[0]) && !ref($_[0]) && $_[0] =~ /^-?[0-9]+$/ }
+sub Str { defined($_[0]) && !ref($_[0]) }
+
+sub Ref { ref($_[0]) }
+sub ScalarRef { ref($_[0]) eq 'SCALAR' }
+sub ArrayRef { ref($_[0]) eq 'ARRAY' }
+sub HashRef { ref($_[0]) eq 'HASH' }
+sub CodeRef { ref($_[0]) eq 'CODE' }
+sub RegexpRef { ref($_[0]) eq 'Regexp' }
+sub GlobRef { ref($_[0]) eq 'GLOB' }
+
+sub FileHandle {
+ openhandle($_[0]) || (blessed($_[0]) && $_[0]->isa("IO::Handle"))
+}
+
+sub Object { blessed($_[0]) && blessed($_[0]) ne 'Regexp' }
+
+sub ClassName { Mouse::Util::is_class_loaded($_[0]) }
+sub RoleName { (Mouse::Util::class_of($_[0]) || return 0)->isa('Mouse::Meta::Role') }
+
+
package
Mouse::Meta::Module;
get_code_info
get_code_package
+ get_code_ref
not_supported
Item => undef, # null check
Maybe => undef, # null check
- Bool => sub { $_[0] ? $_[0] eq '1' : 1 },
- Undef => sub { !defined($_[0]) },
- Defined => sub { defined($_[0]) },
- Value => sub { defined($_[0]) && !ref($_[0]) },
- Num => sub { !ref($_[0]) && looks_like_number($_[0]) },
- Int => sub { defined($_[0]) && !ref($_[0]) && $_[0] =~ /^-?[0-9]+$/ },
- Str => sub { defined($_[0]) && !ref($_[0]) },
- Ref => sub { ref($_[0]) },
-
- ScalarRef => sub { ref($_[0]) eq 'SCALAR' },
- ArrayRef => sub { ref($_[0]) eq 'ARRAY' },
- HashRef => sub { ref($_[0]) eq 'HASH' },
- CodeRef => sub { ref($_[0]) eq 'CODE' },
- RegexpRef => sub { ref($_[0]) eq 'Regexp' },
- GlobRef => sub { ref($_[0]) eq 'GLOB' },
-
- FileHandle => sub {
- ref($_[0]) eq 'GLOB' && openhandle($_[0])
- or
- blessed($_[0]) && $_[0]->isa("IO::Handle")
- },
-
- Object => sub { blessed($_[0]) && blessed($_[0]) ne 'Regexp' },
-
- ClassName => sub { Mouse::Util::is_class_loaded($_[0]) },
- RoleName => sub { (Mouse::Util::find_meta($_[0]) || return 0)->isa('Mouse::Meta::Role') },
+ Bool => \&Bool,
+ Undef => \&Undef,
+ Defined => \&Defined,
+ Value => \&Value,
+ Num => \&Num,
+ Int => \&Int,
+ Str => \&Str,
+ Ref => \&Ref,
+
+ ScalarRef => \&ScalarRef,
+ ArrayRef => \&ArrayRef,
+ HashRef => \&HashRef,
+ CodeRef => \&CodeRef,
+ RegexpRef => \&RegexpRef,
+ GlobRef => \&GlobRef,
+
+ FileHandle => \&FileHandle,
+
+ Object => \&Object,
+
+ ClassName => \&ClassName,
+ RoleName => \&RoleName,
);
while (my ($name, $code) = each %builtins) {
XS(mouse_xs_simple_writer);
XS(mouse_xs_simple_predicate);
+typedef enum mouse_tc{
+ MOUSE_TC_ANY,
+ MOUSE_TC_ITEM,
+ MOUSE_TC_UNDEF,
+ MOUSE_TC_DEFINED,
+ MOUSE_TC_BOOL,
+ MOUSE_TC_VALUE,
+ MOUSE_TC_REF,
+ MOUSE_TC_STR,
+ MOUSE_TC_NUM,
+ MOUSE_TC_INT,
+ MOUSE_TC_SCALAR_REF,
+ MOUSE_TC_ARRAY_REF,
+ MOUSE_TC_HASH_REF,
+ MOUSE_TC_CODE_REF,
+ MOUSE_TC_GLOB_REF,
+ MOUSE_TC_FILEHANDLE,
+ MOUSE_TC_REGEXP_REF,
+ MOUSE_TC_OBJECT,
+ MOUSE_TC_CLASS_NAME,
+ MOUSE_TC_ROLE_NAME,
+
+ MOUSE_TC_last
+} mouse_tc;
+
+/* type constraints */
+
+int mouse_tc_check(pTHX_ mouse_tc const tc, SV* sv);
+
+int mouse_tc_Any (pTHX_ SV* const sv);
+int mouse_tc_Bool (pTHX_ SV* const sv);
+int mouse_tc_Undef (pTHX_ SV* const sv);
+int mouse_tc_Defined (pTHX_ SV* const sv);
+int mouse_tc_Value (pTHX_ SV* const sv);
+int mouse_tc_Num (pTHX_ SV* const sv);
+int mouse_tc_Int (pTHX_ SV* const sv);
+int mouse_tc_Str (pTHX_ SV* const sv);
+int mouse_tc_ClassName (pTHX_ SV* const sv);
+int mouse_tc_RoleName (pTHX_ SV* const sv);
+int mouse_tc_Ref (pTHX_ SV* const sv);
+int mouse_tc_ScalarRef (pTHX_ SV* const sv);
+int mouse_tc_ArrayRef (pTHX_ SV* const sv);
+int mouse_tc_HashRef (pTHX_ SV* const sv);
+int mouse_tc_CodeRef (pTHX_ SV* const sv);
+int mouse_tc_RegexpRef (pTHX_ SV* const sv);
+int mouse_tc_GlobRef (pTHX_ SV* const sv);
+int mouse_tc_FileHandle(pTHX_ SV* const sv);
+int mouse_tc_Object (pTHX_ SV* const sv);
+
+
#endif /* !MOUSE_H */
OUTPUT:
RETVAL
-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 = mouse_instance_get_slot(self, mouse_package);
- if(!(package && SvOK(package))){
- croak("No package name");
- }
- RETVAL = gv_stashsv(package, GV_ADDMULTI);
-}
-OUTPUT:
- RETVAL
-
CV*
-_get_code_ref(SV* self, SV* name)
+get_code_ref(SV* package, 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");
+
+ if(!SvOK(package)){
+ croak("You must define a package name");
+ }
+ if(!SvOK(name)){
+ croak("You must define a subroutine name");
+ }
+
+ stash = gv_stashsv(package, FALSE);
+ if(!stash){
+ XSRETURN_UNDEF;
}
- 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 */
+ if(!isGV(gv)){ /* 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);
}
+ RETVAL = GvCVu(gv);
}
else{
RETVAL = NULL;
RETVAL
+MODULE = Mouse PACKAGE = Mouse::Util::TypeConstraints
+
+void
+Item(SV* sv = &PL_sv_undef)
+ALIAS:
+ Any = MOUSE_TC_ANY
+ Item = MOUSE_TC_ITEM
+ Undef = MOUSE_TC_UNDEF
+ Defined = MOUSE_TC_DEFINED
+ Bool = MOUSE_TC_BOOL
+ Value = MOUSE_TC_VALUE
+ Ref = MOUSE_TC_REF
+ Str = MOUSE_TC_STR
+ Num = MOUSE_TC_NUM
+ Int = MOUSE_TC_INT
+ ScalarRef = MOUSE_TC_SCALAR_REF
+ ArrayRef = MOUSE_TC_ARRAY_REF
+ HashRef = MOUSE_TC_HASH_REF
+ CodeRef = MOUSE_TC_CODE_REF
+ GlobRef = MOUSE_TC_GLOB_REF
+ FileHandle = MOUSE_TC_FILEHANDLE
+ RegexpRef = MOUSE_TC_REGEXP_REF
+ Object = MOUSE_TC_OBJECT
+ ClassName = MOUSE_TC_CLASS_NAME
+ RoleName = MOUSE_TC_ROLE_NAME
+CODE:
+ SvGETMAGIC(sv);
+ ST(0) = boolSV( mouse_tc_check(aTHX_ ix, sv) );
+ XSRETURN(1);
+
+
+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 = mouse_instance_get_slot(self, mouse_package);
+ if(!(package && SvOK(package))){
+ croak("No package name");
+ }
+ RETVAL = gv_stashsv(package, GV_ADDMULTI);
+}
+OUTPUT:
+ RETVAL
+
MODULE = Mouse PACKAGE = Mouse::Meta::Class
BOOT:
INSTALL_SIMPLE_READER(TypeConstraint, _compiled_type_coercion); /* Mouse specific */
INSTALL_SIMPLE_PREDICATE_WITH_KEY(TypeConstraint, has_coercion, _compiled_type_coercion);
-
--- /dev/null
+/*
+ * full definition of built-in type constraints (ware in Moose::Util::TypeConstraints::OptimizedConstraints)
+ */
+
+#include "mouse.h"
+
+#if PERL_BCDVERSION >= 0x5008005
+#define LooksLikeNumber(sv) looks_like_number(sv)
+#else
+#define LooksLikeNumber(sv) ( SvPOKp(sv) ? looks_like_number(sv) : SvNIOKp(sv) )
+#endif
+
+#ifndef SvRXOK
+#define SvRXOK(sv) (SvROK(sv) && SvMAGICAL(SvRV(sv)) && mg_find(SvRV(sv), PERL_MAGIC_qr))
+#endif
+
+
+int
+mouse_tc_check(pTHX_ mouse_tc const tc, SV* const sv) {
+ switch(tc){
+ case MOUSE_TC_ANY: return mouse_tc_Any(aTHX_ sv);
+ case MOUSE_TC_ITEM: return mouse_tc_Any(aTHX_ sv);
+ case MOUSE_TC_UNDEF: return mouse_tc_Undef(aTHX_ sv);
+ case MOUSE_TC_DEFINED: return mouse_tc_Defined(aTHX_ sv);
+ case MOUSE_TC_BOOL: return mouse_tc_Bool(aTHX_ sv);
+ case MOUSE_TC_VALUE: return mouse_tc_Value(aTHX_ sv);
+ case MOUSE_TC_REF: return mouse_tc_Ref(aTHX_ sv);
+ case MOUSE_TC_STR: return mouse_tc_Str(aTHX_ sv);
+ case MOUSE_TC_NUM: return mouse_tc_Num(aTHX_ sv);
+ case MOUSE_TC_INT: return mouse_tc_Int(aTHX_ sv);
+ case MOUSE_TC_SCALAR_REF: return mouse_tc_ScalarRef(aTHX_ sv);
+ case MOUSE_TC_ARRAY_REF: return mouse_tc_ArrayRef(aTHX_ sv);
+ case MOUSE_TC_HASH_REF: return mouse_tc_HashRef(aTHX_ sv);
+ case MOUSE_TC_CODE_REF: return mouse_tc_CodeRef(aTHX_ sv);
+ case MOUSE_TC_GLOB_REF: return mouse_tc_GlobRef(aTHX_ sv);
+ case MOUSE_TC_FILEHANDLE: return mouse_tc_FileHandle(aTHX_ sv);
+ case MOUSE_TC_REGEXP_REF: return mouse_tc_RegexpRef(aTHX_ sv);
+ case MOUSE_TC_OBJECT: return mouse_tc_Object(aTHX_ sv);
+ case MOUSE_TC_CLASS_NAME: return mouse_tc_ClassName(aTHX_ sv);
+ case MOUSE_TC_ROLE_NAME: return mouse_tc_RoleName(aTHX_ sv);
+ default:
+ /* custom type constraints */
+ NOOP;
+ }
+
+ croak("Custom type constraint is not yet implemented");
+ return FALSE; /* not reached */
+}
+
+
+/*
+ The following type check functions return an integer, not a bool, to keep them simple,
+ so if you assign these return value to bool variable, you must use "expr ? TRUE : FALSE".
+*/
+
+int
+mouse_tc_Any(pTHX_ SV* const sv PERL_UNUSED_DECL) {
+ assert(sv);
+ return TRUE;
+}
+
+int
+mouse_tc_Bool(pTHX_ SV* const sv) {
+ assert(sv);
+ if(SvOK(sv)){
+ if(SvIOKp(sv)){
+ return SvIVX(sv) == 1 || SvIVX(sv) == 0;
+ }
+ else if(SvNOKp(sv)){
+ return SvNVX(sv) == 1.0 || SvNVX(sv) == 0.0;
+ }
+ else if(SvPOKp(sv)){ /* "" or "1" or "0" */
+ return SvCUR(sv) == 0
+ || ( SvCUR(sv) == 1 && ( SvPVX(sv)[0] == '1' || SvPVX(sv)[0] == '0' ) );
+ }
+ else{
+ return FALSE;
+ }
+ }
+ else{
+ return TRUE;
+ }
+}
+
+int
+mouse_tc_Undef(pTHX_ SV* const sv) {
+ assert(sv);
+ return !SvOK(sv);
+}
+
+int
+mouse_tc_Defined(pTHX_ SV* const sv) {
+ assert(sv);
+ return SvOK(sv);
+}
+
+int
+mouse_tc_Value(pTHX_ SV* const sv) {
+ assert(sv);
+ return SvOK(sv) && !SvROK(sv);
+}
+
+int
+mouse_tc_Num(pTHX_ SV* const sv) {
+ assert(sv);
+ return LooksLikeNumber(sv);
+}
+
+int
+mouse_tc_Int(pTHX_ SV* const sv) {
+ assert(sv);
+ if(SvIOKp(sv)){
+ return TRUE;
+ }
+ else if(SvNOKp(sv)){
+ NV const nv = SvNVX(sv);
+ return nv > 0 ? (nv == (NV)(UV)nv) : (nv == (NV)(IV)nv);
+ }
+ else if(SvPOKp(sv)){
+ int const num_type = grok_number(SvPVX(sv), SvCUR(sv), NULL);
+ if(num_type){
+ return !(num_type & IS_NUMBER_NOT_INT);
+ }
+ }
+ return FALSE;
+}
+
+int
+mouse_tc_Str(pTHX_ SV* const sv) {
+ assert(sv);
+ return SvOK(sv) && !SvROK(sv) && !isGV(sv);
+}
+
+int
+mouse_tc_ClassName(pTHX_ SV* const sv){
+ assert(sv);
+ return is_class_loaded(sv);
+}
+
+int
+mouse_tc_RoleName(pTHX_ SV* const sv) {
+ assert(sv);
+ if(is_class_loaded(sv)){
+ int ok;
+ SV* meta;
+ dSP;
+
+ ENTER;
+ SAVETMPS;
+
+ PUSHMARK(SP);
+ XPUSHs(sv);
+ PUTBACK;
+ call_pv("Mouse::Util::get_metaclass_by_name", G_SCALAR);
+ SPAGAIN;
+ meta = POPs;
+ PUTBACK;
+
+ ok = is_instance_of(meta, newSVpvs_flags("Mouse::Meta::Role", SVs_TEMP));
+
+ FREETMPS;
+ LEAVE;
+
+ return ok;
+ }
+ return FALSE;
+}
+
+int
+mouse_tc_Ref(pTHX_ SV* const sv) {
+ assert(sv);
+ return SvROK(sv);
+}
+
+int
+mouse_tc_ScalarRef(pTHX_ SV* const sv) {
+ assert(sv);
+ return SvROK(sv) && !SvOBJECT(SvRV(sv)) && (SvTYPE(SvRV(sv)) <= SVt_PVLV && !isGV(SvRV(sv)));
+}
+
+int
+mouse_tc_ArrayRef(pTHX_ SV* const sv) {
+ assert(sv);
+ return SvROK(sv) && !SvOBJECT(SvRV(sv)) && SvTYPE(SvRV(sv)) == SVt_PVAV;
+}
+
+int
+mouse_tc_HashRef(pTHX_ SV* const sv) {
+ assert(sv);
+ return SvROK(sv) && !SvOBJECT(SvRV(sv)) && SvTYPE(SvRV(sv)) == SVt_PVHV;
+}
+
+int
+mouse_tc_CodeRef(pTHX_ SV* const sv) {
+ assert(sv);
+ return SvROK(sv) && !SvOBJECT(SvRV(sv))&& SvTYPE(SvRV(sv)) == SVt_PVCV;
+}
+
+int
+mouse_tc_RegexpRef(pTHX_ SV* const sv) {
+ assert(sv);
+ return SvRXOK(sv);
+}
+
+int
+mouse_tc_GlobRef(pTHX_ SV* const sv) {
+ assert(sv);
+ return SvROK(sv) && !SvOBJECT(SvRV(sv)) && isGV(SvRV(sv));
+}
+
+int
+mouse_tc_FileHandle(pTHX_ SV* const sv) {
+ GV* gv;
+ assert(sv);
+
+ /* see pp_fileno() in pp_sys.c and Scalar::Util::openhandle() */
+
+ gv = (GV*)(SvROK(sv) ? SvRV(sv) : sv);
+ if(isGV(gv) || SvTYPE(gv) == SVt_PVIO){
+ IO* const io = isGV(gv) ? GvIO(gv) : (IO*)gv;
+
+ if(io && ( IoIFP(io) || SvTIED_mg((SV*)io, PERL_MAGIC_tiedscalar) )){
+ return TRUE;
+ }
+ }
+
+ return is_instance_of(sv, newSVpvs_flags("IO::Handle", SVs_TEMP));
+}
+
+int
+mouse_tc_Object(pTHX_ SV* const sv) {
+ assert(sv);
+ return SvROK(sv) && SvOBJECT(SvRV(sv)) && !SvRXOK(sv);
+}
+