xs-src/mouse_type_constraint.xs

   1 /*
   2  *   full definition of built-in type constraints (ware in Moose::Util::TypeConstraints::OptimizedConstraints)
   3  */
   4
   5 #include "mouse.h"
   6
   7 #if PERL_BCDVERSION >= 0x5008005
   8 #define LooksLikeNumber(sv) looks_like_number(sv)
   9 #else
  10 #define LooksLikeNumber(sv) ( SvPOKp(sv) ? looks_like_number(sv) : SvNIOKp(sv) )
  11 #endif
  12
  13 #ifndef SvRXOK
  14 #define SvRXOK(sv) (SvROK(sv) && SvMAGICAL(SvRV(sv)) && mg_find(SvRV(sv), PERL_MAGIC_qr))
  15 #endif
  16
  17
  18 int
  19 mouse_tc_check(pTHX_ mouse_tc const tc, SV* const sv) {
  20     switch(tc){
  21     case MOUSE_TC_ANY:        return mouse_tc_Any(aTHX_ sv);
  22     case MOUSE_TC_ITEM:       return mouse_tc_Any(aTHX_ sv);
  23     case MOUSE_TC_UNDEF:      return mouse_tc_Undef(aTHX_ sv);
  24     case MOUSE_TC_DEFINED:    return mouse_tc_Defined(aTHX_ sv);
  25     case MOUSE_TC_BOOL:       return mouse_tc_Bool(aTHX_ sv);
  26     case MOUSE_TC_VALUE:      return mouse_tc_Value(aTHX_ sv);
  27     case MOUSE_TC_REF:        return mouse_tc_Ref(aTHX_ sv);
  28     case MOUSE_TC_STR:        return mouse_tc_Str(aTHX_ sv);
  29     case MOUSE_TC_NUM:        return mouse_tc_Num(aTHX_ sv);
  30     case MOUSE_TC_INT:        return mouse_tc_Int(aTHX_ sv);
  31     case MOUSE_TC_SCALAR_REF: return mouse_tc_ScalarRef(aTHX_ sv);
  32     case MOUSE_TC_ARRAY_REF:  return mouse_tc_ArrayRef(aTHX_ sv);
  33     case MOUSE_TC_HASH_REF:   return mouse_tc_HashRef(aTHX_ sv);
  34     case MOUSE_TC_CODE_REF:   return mouse_tc_CodeRef(aTHX_ sv);
  35     case MOUSE_TC_GLOB_REF:   return mouse_tc_GlobRef(aTHX_ sv);
  36     case MOUSE_TC_FILEHANDLE: return mouse_tc_FileHandle(aTHX_ sv);
  37     case MOUSE_TC_REGEXP_REF: return mouse_tc_RegexpRef(aTHX_ sv);
  38     case MOUSE_TC_OBJECT:     return mouse_tc_Object(aTHX_ sv);
  39     case MOUSE_TC_CLASS_NAME: return mouse_tc_ClassName(aTHX_ sv);
  40     case MOUSE_TC_ROLE_NAME:  return mouse_tc_RoleName(aTHX_ sv);
  41     default:
  42         /* custom type constraints */
  43         NOOP;
  44     }
  45
  46     croak("Custom type constraint is not yet implemented");
  47     return FALSE; /* not reached */
  48 }
  49
  50
  51 /*
  52     The following type check functions return an integer, not a bool, to keep them simple,
  53     so if you assign these return value to bool variable, you must use "expr ? TRUE : FALSE".
  54 */
  55
  56 int
  57 mouse_tc_Any(pTHX_ SV* const sv PERL_UNUSED_DECL) {
  58     assert(sv);
  59     return TRUE;
  60 }
  61
  62 int
  63 mouse_tc_Bool(pTHX_ SV* const sv) {
  64     assert(sv);
  65     if(SvOK(sv)){
  66         if(SvIOKp(sv)){
  67             return SvIVX(sv) == 1 || SvIVX(sv) == 0;
  68         }
  69         else if(SvNOKp(sv)){
  70             return SvNVX(sv) == 1.0 || SvNVX(sv) == 0.0;
  71         }
  72         else if(SvPOKp(sv)){ /* "" or "1" or "0" */
  73             return SvCUR(sv) == 0
  74                 || ( SvCUR(sv) == 1 && ( SvPVX(sv)[0] == '1' || SvPVX(sv)[0] == '0' ) );
  75         }
  76         else{
  77             return FALSE;
  78         }
  79     }
  80     else{
  81         return TRUE;
  82     }
  83 }
  84
  85 int
  86 mouse_tc_Undef(pTHX_ SV* const sv) {
  87     assert(sv);
  88     return !SvOK(sv);
  89 }
  90
  91 int
  92 mouse_tc_Defined(pTHX_ SV* const sv) {
  93     assert(sv);
  94     return SvOK(sv);
  95 }
  96
  97 int
  98 mouse_tc_Value(pTHX_ SV* const sv) {
  99     assert(sv);
 100     return SvOK(sv) && !SvROK(sv);
 101 }
 102
 103 int
 104 mouse_tc_Num(pTHX_ SV* const sv) {
 105     assert(sv);
 106     return LooksLikeNumber(sv);
 107 }
 108
 109 int
 110 mouse_tc_Int(pTHX_ SV* const sv) {
 111     assert(sv);
 112     if(SvIOKp(sv)){
 113         return TRUE;
 114     }
 115     else if(SvNOKp(sv)){
 116         NV const nv = SvNVX(sv);
 117         return nv > 0 ? (nv == (NV)(UV)nv) : (nv == (NV)(IV)nv);
 118     }
 119     else if(SvPOKp(sv)){
 120         int const num_type = grok_number(SvPVX(sv), SvCUR(sv), NULL);
 121         if(num_type){
 122             return !(num_type & IS_NUMBER_NOT_INT);
 123         }
 124     }
 125     return FALSE;
 126 }
 127
 128 int
 129 mouse_tc_Str(pTHX_ SV* const sv) {
 130     assert(sv);
 131     return SvOK(sv) && !SvROK(sv) && !isGV(sv);
 132 }
 133
 134 int
 135 mouse_tc_ClassName(pTHX_ SV* const sv){
 136     assert(sv);
 137     return is_class_loaded(sv);
 138 }
 139
 140 int
 141 mouse_tc_RoleName(pTHX_ SV* const sv) {
 142     assert(sv);
 143     if(is_class_loaded(sv)){
 144         int ok;
 145         SV* meta;
 146         dSP;
 147
 148         ENTER;
 149         SAVETMPS;
 150
 151         PUSHMARK(SP);
 152         XPUSHs(sv);
 153         PUTBACK;
 154         call_pv("Mouse::Util::get_metaclass_by_name", G_SCALAR);
 155         SPAGAIN;
 156         meta = POPs;
 157         PUTBACK;
 158
 159         ok =  is_instance_of(meta, newSVpvs_flags("Mouse::Meta::Role", SVs_TEMP));
 160
 161         FREETMPS;
 162         LEAVE;
 163
 164         return ok;
 165     }
 166     return FALSE;
 167 }
 168
 169 int
 170 mouse_tc_Ref(pTHX_ SV* const sv) {
 171     assert(sv);
 172     return SvROK(sv);
 173 }
 174
 175 int
 176 mouse_tc_ScalarRef(pTHX_ SV* const sv) {
 177     assert(sv);
 178     return SvROK(sv) && !SvOBJECT(SvRV(sv)) && (SvTYPE(SvRV(sv)) <= SVt_PVLV && !isGV(SvRV(sv)));
 179 }
 180
 181 int
 182 mouse_tc_ArrayRef(pTHX_ SV* const sv) {
 183     assert(sv);
 184     return SvROK(sv) && !SvOBJECT(SvRV(sv)) && SvTYPE(SvRV(sv)) == SVt_PVAV;
 185 }
 186
 187 int
 188 mouse_tc_HashRef(pTHX_ SV* const sv) {
 189     assert(sv);
 190     return SvROK(sv) && !SvOBJECT(SvRV(sv)) && SvTYPE(SvRV(sv)) == SVt_PVHV;
 191 }
 192
 193 int
 194 mouse_tc_CodeRef(pTHX_ SV* const sv) {
 195     assert(sv);
 196     return SvROK(sv)  && !SvOBJECT(SvRV(sv))&& SvTYPE(SvRV(sv)) == SVt_PVCV;
 197 }
 198
 199 int
 200 mouse_tc_RegexpRef(pTHX_ SV* const sv) {
 201     assert(sv);
 202     return SvRXOK(sv);
 203 }
 204
 205 int
 206 mouse_tc_GlobRef(pTHX_ SV* const sv) {
 207     assert(sv);
 208     return SvROK(sv) && !SvOBJECT(SvRV(sv)) && isGV(SvRV(sv));
 209 }
 210
 211 int
 212 mouse_tc_FileHandle(pTHX_ SV* const sv) {
 213     GV* gv;
 214     assert(sv);
 215
 216     /* see pp_fileno() in pp_sys.c and Scalar::Util::openhandle() */
 217
 218     gv = (GV*)(SvROK(sv) ? SvRV(sv) : sv);
 219     if(isGV(gv) || SvTYPE(gv) == SVt_PVIO){
 220         IO* const io = isGV(gv) ? GvIO(gv) : (IO*)gv;
 221
 222         if(io && ( IoIFP(io) || SvTIED_mg((SV*)io, PERL_MAGIC_tiedscalar) )){
 223             return TRUE;
 224         }
 225     }
 226
 227     return is_instance_of(sv, newSVpvs_flags("IO::Handle", SVs_TEMP));
 228 }
 229
 230 int
 231 mouse_tc_Object(pTHX_ SV* const sv) {
 232     assert(sv);
 233     return SvROK(sv) && SvOBJECT(SvRV(sv)) && !SvRXOK(sv);
 234 }
 235