xs-src/Mouse.xs

   1 #define  NEED_newSVpvn_flags_GLOBAL
   2 #include "mouse.h"
   3
   4 /* keywords for methods/keys */
   5 SV* mouse_package;
   6 SV* mouse_namespace;
   7 SV* mouse_methods;
   8 SV* mouse_name;
   9 SV* mouse_get_attribute;
  10 SV* mouse_get_attribute_list;
  11 SV* mouse_coerce;
  12
  13 #define MOUSE_xc_flags(a)       SvUVX(MOUSE_av_at((a), MOUSE_XC_FLAGS))
  14 #define MOUSE_xc_gen(a)         MOUSE_av_at((a), MOUSE_XC_GEN)
  15 #define MOUSE_xc_stash(a)       ( (HV*)MOUSE_av_at((a), MOUSE_XC_STASH) )
  16 #define MOUSE_xc_attrall(a)     ( (AV*)MOUSE_av_at((a), MOUSE_XC_ATTRALL) )
  17 #define MOUSE_xc_buildall(a)    ( (AV*)MOUSE_av_at((a), MOUSE_XC_BUILDALL) )
  18 #define MOUSE_xc_demolishall(a) ( (AV*)MOUSE_av_at((a), MOUSE_XC_DEMOLISHALL) )
  19
  20 enum mouse_xc_flags_t {
  21     MOUSEf_XC_IS_IMMUTABLE   = 0x0001,
  22     MOUSEf_XC_IS_ANON        = 0x0002,
  23     MOUSEf_XC_HAS_BUILDARGS  = 0x0004,
  24     MOUSEf_XC_CONSTRUCTOR_IS_STRICT
  25                              = 0x0008,
  26
  27     MOUSEf_XC_mask           = 0xFFFF /* not used */
  28 };
  29
  30 /* Mouse XS Metaclass object */
  31 enum mouse_xc_ix_t{
  32     MOUSE_XC_FLAGS,
  33
  34     MOUSE_XC_GEN,          /* class generation */
  35     MOUSE_XC_STASH,        /* symbol table hash */
  36
  37     MOUSE_XC_ATTRALL,      /* all the attributes */
  38     MOUSE_XC_BUILDALL,     /* all the BUILD methods */
  39     MOUSE_XC_DEMOLISHALL,  /* all the DEMOLISH methods */
  40
  41     MOUSE_XC_last
  42 };
  43
  44 enum mouse_modifier_t {
  45     MOUSE_M_BEFORE,
  46     MOUSE_M_AROUND,
  47     MOUSE_M_AFTER,
  48 };
  49
  50 static MGVTBL mouse_xc_vtbl; /* for identity */
  51
  52 HV*
  53 mouse_get_namespace(pTHX_ SV* const meta) {
  54     SV* const package = get_slot(meta, mouse_package);
  55     if(!(package && SvOK(package))){
  56         croak("No package name defined for metaclass");
  57     }
  58     return gv_stashsv(package, GV_ADDMULTI);
  59 }
  60
  61 static AV*
  62 mouse_calculate_all_attributes(pTHX_ SV* const metaclass) {
  63     SV* const avref = mcall0s(metaclass, "_calculate_all_attributes");
  64     if(!(SvROK(avref) && SvTYPE(SvRV(avref)) == SVt_PVAV)) {
  65         croak("$meta->_calculate_all_attributes did not return an ARRAY reference");
  66     }
  67     return (AV*)SvRV(avref);
  68 }
  69
  70 XS(XS_Mouse__Object_BUILDARGS); /* prototype */
  71
  72 static int
  73 mouse_class_has_custom_buildargs(pTHX_ HV* const stash) {
  74     GV* const buildargs = gv_fetchmeth_autoload(stash, "BUILDARGS", sizeof("BUILDARGS")-1, 0);
  75
  76     return buildargs && CvXSUB(GvCV(buildargs)) != XS_Mouse__Object_BUILDARGS;
  77 }
  78
  79 static AV*
  80 mouse_class_update_xc(pTHX_ SV* const metaclass PERL_UNUSED_DECL, AV* const xc) {
  81     HV* const stash          = MOUSE_xc_stash(xc);
  82     AV* const linearized_isa = mro_get_linear_isa(stash);
  83     I32 const len            = AvFILLp(linearized_isa) + 1;
  84     I32 i;
  85     U32 flags             = 0x00;
  86     AV* const buildall    = newAV();
  87     AV* const demolishall = newAV();
  88     AV* attrall;
  89
  90     ENTER;
  91     SAVETMPS;
  92
  93      /* old data will be delete at the end of the perl scope */
  94     av_delete(xc, MOUSE_XC_DEMOLISHALL, 0x00);
  95     av_delete(xc, MOUSE_XC_BUILDALL,    0x00);
  96     av_delete(xc, MOUSE_XC_ATTRALL,     0x00);
  97
  98     SvREFCNT_inc_simple_void_NN(linearized_isa);
  99     sv_2mortal((SV*)linearized_isa);
 100
 101     /* update */
 102
 103     av_store(xc, MOUSE_XC_BUILDALL,    (SV*)buildall);
 104     av_store(xc, MOUSE_XC_DEMOLISHALL, (SV*)demolishall);
 105
 106     attrall = mouse_calculate_all_attributes(aTHX_ metaclass);
 107     SvREFCNT_inc_simple_void_NN(attrall);
 108     av_store(xc, MOUSE_XC_ATTRALL,     (SV*)attrall);
 109
 110     if(predicate_calls(metaclass, "is_immutable")){
 111         flags |= MOUSEf_XC_IS_IMMUTABLE;
 112     }
 113
 114     if(predicate_calls(metaclass, "is_anon_class")){
 115         flags |= MOUSEf_XC_IS_ANON;
 116     }
 117
 118     if(mouse_class_has_custom_buildargs(aTHX_ stash)){
 119         flags |= MOUSEf_XC_HAS_BUILDARGS;
 120     }
 121
 122     if(predicate_calls(metaclass, "strict_constructor")){
 123         flags |= MOUSEf_XC_CONSTRUCTOR_IS_STRICT;
 124     }
 125
 126     av_store(xc, MOUSE_XC_FLAGS,       newSVuv(flags));
 127
 128     for(i = 0; i < len; i++){
 129         SV* const klass = MOUSE_av_at(linearized_isa, i);
 130         HV* const st    = gv_stashsv(klass, TRUE);
 131         GV* gv;
 132
 133         gv = stash_fetchs(st, "BUILD", FALSE);
 134         if(gv && GvCVu(gv)){
 135             av_unshift(buildall, 1);
 136             av_store(buildall, 0, newRV_inc((SV*)GvCV(gv)));
 137         }
 138
 139         gv = stash_fetchs(st, "DEMOLISH", FALSE);
 140         if(gv && GvCVu(gv)){
 141             av_push(demolishall, newRV_inc((SV*)GvCV(gv)));
 142         }
 143     }
 144
 145     FREETMPS;
 146     LEAVE;
 147
 148     sv_setuv(MOUSE_xc_gen(xc), mro_get_pkg_gen(stash));
 149     return xc;
 150 }
 151
 152 static AV*
 153 mouse_get_xc_wo_check(pTHX_ SV* const metaclass) {
 154     AV* xc;
 155     MAGIC* mg;
 156
 157     if(!IsObject(metaclass)){
 158         croak("Not a Mouse metaclass");
 159     }
 160
 161     mg = mouse_mg_find(aTHX_ SvRV(metaclass), &mouse_xc_vtbl, 0x00);
 162     if(!mg){
 163         /* cache stash for performance */
 164         HV* const stash = mouse_get_namespace(aTHX_ metaclass);
 165         xc    = newAV();
 166
 167         mg = sv_magicext(SvRV(metaclass), (SV*)xc, PERL_MAGIC_ext,
 168             &mouse_xc_vtbl, NULL, 0);
 169         SvREFCNT_dec(xc); /* refcnt++ in sv_magicext */
 170
 171         av_extend(xc, MOUSE_XC_last - 1);
 172
 173         av_store(xc, MOUSE_XC_GEN, newSVuv(0U));
 174         av_store(xc, MOUSE_XC_STASH, (SV*)stash);
 175         SvREFCNT_inc_simple_void_NN(stash);
 176     }
 177     else{
 178         xc    = (AV*)MOUSE_mg_obj(mg);
 179
 180         assert(xc);
 181         assert(SvTYPE(xc) == SVt_PVAV);
 182     }
 183     return xc;
 184 }
 185
 186 static int
 187 mouse_xc_is_fresh(pTHX_ AV* const xc) {
 188     HV* const stash = MOUSE_xc_stash(xc);
 189     SV* const gen   = MOUSE_xc_gen(xc);
 190     if(SvUVX(gen) != 0U && MOUSE_xc_flags(xc) & MOUSEf_XC_IS_IMMUTABLE) {
 191         return TRUE;
 192     }
 193     return SvUVX(gen) == mro_get_pkg_gen(stash);
 194 }
 195
 196 STATIC_INLINE AV*
 197 mouse_get_xc(pTHX_ SV* const metaclass) {
 198     AV* const xc = mouse_get_xc_wo_check(aTHX_ metaclass);
 199     return mouse_xc_is_fresh(aTHX_ xc)
 200         ? xc
 201         : mouse_class_update_xc(aTHX_ metaclass, xc);
 202 }
 203
 204 static AV*
 205 mouse_get_xc_if_fresh(pTHX_ SV* const metaclass) {
 206     AV* const xc = mouse_get_xc_wo_check(aTHX_ metaclass);
 207     return mouse_xc_is_fresh(aTHX_ xc)
 208         ? xc
 209         : NULL;
 210 }
 211
 212 static HV*
 213 mouse_buildargs(pTHX_ SV* metaclass, SV* const klass, I32 ax, I32 items) {
 214     HV* args;
 215
 216     /* shift @_ */
 217     ax++;
 218     items--;
 219
 220     if(items == 1){
 221         SV* const args_ref = ST(0);
 222         if(!IsHashRef(args_ref)){
 223             if(!metaclass){ metaclass = get_metaclass(klass); }
 224             mouse_throw_error(metaclass, NULL, "Single parameters to new() must be a HASH ref");
 225         }
 226         args = newHVhv((HV*)SvRV(args_ref));
 227         sv_2mortal((SV*)args);
 228     }
 229     else{
 230         I32 i;
 231
 232         if( (items % 2) != 0 ){
 233             if(!metaclass){ metaclass = get_metaclass(klass); }
 234             mouse_throw_error(metaclass, NULL, "Odd number of parameters to new()");
 235         }
 236
 237         args = newHV_mortal();
 238         for(i = 0; i < items; i += 2){
 239             (void)hv_store_ent(args, ST(i), newSVsv(ST(i+1)), 0U);
 240         }
 241
 242     }
 243     return args;
 244 }
 245
 246 static void
 247 mouse_report_unknown_args(pTHX_ SV* const meta, AV* const attrs, HV* const args) {
 248     HV* const attr_map = newHV_mortal();
 249     SV* const unknown  = newSVpvs_flags("", SVs_TEMP);
 250     I32 const len      = AvFILLp(attrs) + 1;
 251     I32 i;
 252     HE* he;
 253
 254     for(i = 0; i < len; i++){
 255         SV* const attr = MOUSE_av_at(attrs, i);
 256         AV* const xa   = mouse_get_xa(aTHX_ attr);
 257         SV* const init_arg = MOUSE_xa_init_arg(xa);
 258         if(SvOK(init_arg)){
 259             (void)hv_store_ent(attr_map, init_arg, &PL_sv_undef, 0U);
 260         }
 261     }
 262
 263     hv_iterinit(args);
 264     while((he = hv_iternext(args))){
 265         SV* const key = hv_iterkeysv(he);
 266         if(!hv_exists_ent(attr_map, key, 0U)){
 267             sv_catpvf(unknown, "%"SVf", ", key);
 268         }
 269     }
 270
 271     if(SvCUR(unknown) > 0){
 272         SvCUR(unknown) -= 2; /* chop "," */
 273     }
 274     else{
 275         sv_setpvs(unknown, "(unknown)");
 276     }
 277
 278     mouse_throw_error(meta, NULL,
 279         "Unknown attribute passed to the constructor of %"SVf": %"SVf,
 280         mcall0(meta, mouse_name), unknown);
 281 }
 282
 283
 284
 285 static void
 286 mouse_class_initialize_object(pTHX_ SV* const meta, SV* const object, HV* const args, bool const is_cloning) {
 287     AV* const xc    = mouse_get_xc(aTHX_ meta);
 288     AV* const attrs = MOUSE_xc_attrall(xc);
 289     I32 const len   = AvFILLp(attrs) + 1;
 290     I32 i;
 291     AV* triggers_queue = NULL;
 292     I32 used = 0;
 293
 294     assert(meta || object);
 295     assert(args);
 296     assert(SvTYPE(args) == SVt_PVHV);
 297
 298     if(mg_find((SV*)args, PERL_MAGIC_tied)){
 299         croak("You cannot use tied HASH reference as initializing arguments");
 300     }
 301
 302     /* for each attribute */
 303     for(i = 0; i < len; i++){
 304         SV* const attr = MOUSE_av_at(attrs, i);
 305         AV* const xa   = mouse_get_xa(aTHX_ attr);
 306
 307         SV* const slot     = MOUSE_xa_slot(xa);
 308         U16 const flags    = (U16)MOUSE_xa_flags(xa);
 309         SV* const init_arg = MOUSE_xa_init_arg(xa);
 310         HE* he;
 311
 312         if(SvOK(init_arg) && ( he = hv_fetch_ent(args, init_arg, FALSE, 0U) ) ){
 313             SV* value = HeVAL(he);
 314             if(flags & MOUSEf_ATTR_HAS_TC){
 315                 value = mouse_xa_apply_type_constraint(aTHX_ xa, value, flags);
 316             }
 317             value = set_slot(object, slot, value);
 318             if(SvROK(value) && flags & MOUSEf_ATTR_IS_WEAK_REF){
 319                 weaken_slot(object, slot);
 320             }
 321             if(flags & MOUSEf_ATTR_HAS_TRIGGER){
 322                 AV* const pair = newAV();
 323                 av_push(pair, newSVsv( mcall0s(attr, "trigger") ));
 324                 av_push(pair, newSVsv(value));
 325
 326                 if(!triggers_queue) {
 327                     triggers_queue = newAV_mortal();
 328                 }
 329                 av_push(triggers_queue, (SV*)pair);
 330             }
 331             used++;
 332         }
 333         else { /* no init arg */
 334             if(flags & (MOUSEf_ATTR_HAS_DEFAULT | MOUSEf_ATTR_HAS_BUILDER)){
 335                 /* skip if the object has the slot (it occurs on cloning/reblessing) */
 336                 if(!(flags & MOUSEf_ATTR_IS_LAZY) && !has_slot(object, slot)){
 337                     mouse_xa_set_default(aTHX_ xa, object);
 338                 }
 339             }
 340             /* don't check while cloning (or reblesseing) */
 341             else if(!is_cloning && flags & MOUSEf_ATTR_IS_REQUIRED) {
 342                 mouse_throw_error(attr, NULL, "Attribute (%"SVf") is required", slot);
 343             }
 344         }
 345     } /* for each attribute */
 346
 347     if(MOUSE_xc_flags(xc) & MOUSEf_XC_CONSTRUCTOR_IS_STRICT
 348             && used < (I32)HvUSEDKEYS(args)){
 349         mouse_report_unknown_args(aTHX_ meta, attrs, args);
 350     }
 351
 352     if(triggers_queue){
 353         I32 const len = AvFILLp(triggers_queue) + 1;
 354         for(i = 0; i < len; i++){
 355             AV* const pair    = (AV*)AvARRAY(triggers_queue)[i];
 356             SV* const trigger = AvARRAY(pair)[0];
 357             SV* const value   = AvARRAY(pair)[1];
 358
 359             mcall1(object, trigger, value);
 360         }
 361     }
 362
 363     if(MOUSE_xc_flags(xc) & MOUSEf_XC_IS_ANON){
 364         (void)set_slot(object, newSVpvs_flags("__METACLASS__", SVs_TEMP), meta);
 365     }
 366 }
 367
 368 STATIC_INLINE SV*
 369 mouse_initialize_metaclass(pTHX_ SV* const klass) {
 370     SV* const meta = get_metaclass(klass);
 371     if(LIKELY(SvOK(meta))){
 372         return meta;
 373     }
 374     return mcall1s(newSVpvs_flags("Mouse::Meta::Class", SVs_TEMP),
 375             "initialize", klass);
 376 }
 377
 378 static void
 379 mouse_buildall(pTHX_ AV* const xc, SV* const object, SV* const args) {
 380     AV* const buildall = MOUSE_xc_buildall(xc);
 381     I32 const len      = AvFILLp(buildall) + 1;
 382     I32 i;
 383     for(i = 0; i < len; i++){
 384         dSP;
 385
 386         PUSHMARK(SP);
 387         EXTEND(SP, 2);
 388         PUSHs(object);
 389         PUSHs(args);
 390         PUTBACK;
 391
 392         call_sv_safe(AvARRAY(buildall)[i], G_VOID);
 393
 394         /* discard a scalar which G_VOID returns */
 395         SPAGAIN;
 396         (void)POPs;
 397         PUTBACK;
 398     }
 399 }
 400
 401 static AV*
 402 mouse_get_modifier_storage(pTHX_
 403         SV* const meta,
 404         enum mouse_modifier_t const m, SV* const name) {
 405     static const char* const keys[] = {
 406         "before",
 407         "around",
 408         "after",
 409     };
 410     SV* const key = sv_2mortal(Perl_newSVpvf(aTHX_ "%s_method_modifiers", keys[m]));
 411     SV* table;
 412     SV* storage_ref;
 413
 414     must_defined(name, "a method name");
 415
 416     table = get_slot(meta, key);
 417
 418     if(!table){
 419         /* $meta->{$key} = {} */
 420         table = sv_2mortal(newRV_noinc((SV*)newHV()));
 421         set_slot(meta, key, table);
 422     }
 423
 424     storage_ref = get_slot(table, name);
 425
 426     if(!storage_ref){
 427         storage_ref = sv_2mortal(newRV_noinc((SV*)newAV()));
 428         set_slot(table, name, storage_ref);
 429     }
 430     else{
 431         if(!IsArrayRef(storage_ref)){
 432             croak("Modifier strorage for '%s' is not an ARRAY reference", keys[m]);
 433         }
 434     }
 435
 436     return (AV*)SvRV(storage_ref);
 437 }
 438
 439 static void
 440 XS_Mouse_value_holder(pTHX_ CV* const cv PERL_UNUSED_DECL) {
 441     dVAR; dXSARGS;
 442     SV* const value = (SV*)XSANY.any_ptr;
 443     assert(value);
 444     PERL_UNUSED_VAR(items);
 445     ST(0) = value;
 446     XSRETURN(1);
 447 }
 448
 449 DECL_BOOT(Mouse__Util);
 450 DECL_BOOT(Mouse__Util__TypeConstraints);
 451 DECL_BOOT(Mouse__Meta__Method__Accessor__XS);
 452 DECL_BOOT(Mouse__Meta__Attribute);
 453
 454 MODULE = Mouse  PACKAGE = Mouse
 455
 456 PROTOTYPES: DISABLE
 457
 458 BOOT:
 459 {
 460     mouse_package   = newSVpvs_share("package");
 461     mouse_namespace = newSVpvs_share("namespace");
 462     mouse_methods   = newSVpvs_share("methods");
 463     mouse_name      = newSVpvs_share("name");
 464     mouse_coerce    = newSVpvs_share("coerce");
 465
 466     mouse_get_attribute      = newSVpvs_share("get_attribute");
 467     mouse_get_attribute_list = newSVpvs_share("get_attribute_list");
 468
 469     CALL_BOOT(Mouse__Util);
 470     CALL_BOOT(Mouse__Util__TypeConstraints);
 471     CALL_BOOT(Mouse__Meta__Method__Accessor__XS);
 472     CALL_BOOT(Mouse__Meta__Attribute);
 473 }
 474
 475 MODULE = Mouse  PACKAGE = Mouse::Meta::Module
 476
 477 BOOT:
 478     INSTALL_SIMPLE_READER_WITH_KEY(Module, name, package);
 479     INSTALL_SIMPLE_READER_WITH_KEY(Module, _method_map, methods);
 480     INSTALL_SIMPLE_READER_WITH_KEY(Module, _attribute_map, attributes);
 481
 482 HV*
 483 namespace(SV* self)
 484 CODE:
 485 {
 486     RETVAL = mouse_get_namespace(aTHX_ self);
 487 }
 488 OUTPUT:
 489     RETVAL
 490
 491 # ignore extra arguments for extensibility
 492 void
 493 add_method(SV* self, SV* name, SV* code, ...)
 494 CODE:
 495 {
 496     SV* const package = get_slot(self, mouse_package); /* $self->{package} */
 497     SV* const methods = get_slot(self, mouse_methods); /* $self->{methods} */
 498     GV* gv;
 499     SV* code_ref;
 500
 501     if(!(package && SvOK(package))){
 502         croak("No package name defined");
 503     }
 504
 505     must_defined(name, "a method name");
 506     must_ref    (code, "a CODE reference", SVt_NULL); /* any reftype is OK */
 507
 508     code_ref = code;
 509     if(SvTYPE(SvRV(code_ref)) != SVt_PVCV){
 510         SV*  sv = code_ref;  /* used in tryAMAGICunDEREF */
 511         SV** sp = &sv;       /* used in tryAMAGICunDEREF */
 512         tryAMAGICunDEREF(to_cv); /* try \&{$code} */
 513         must_ref(code, "a CODE reference", SVt_PVCV);
 514         code_ref = sv;
 515     }
 516
 517     /*  *{$package . '::' . $name} -> *gv */
 518     gv = gv_fetchpv(form("%"SVf"::%"SVf, package, name), GV_ADDMULTI, SVt_PVCV);
 519     mouse_install_sub(aTHX_ gv, code_ref);
 520     //CvMETHOD_on((CV*)SvRV(code_ref));
 521     (void)set_slot(methods, name, code); /* $self->{methods}{$name} = $code */
 522 }
 523
 524 MODULE = Mouse  PACKAGE = Mouse::Meta::Class
 525
 526 BOOT:
 527 {
 528     CV* xsub;
 529
 530     INSTALL_SIMPLE_READER(Class, roles);
 531     INSTALL_SIMPLE_PREDICATE_WITH_KEY(Class, is_anon_class, anon_serial_id);
 532     INSTALL_SIMPLE_READER(Class, is_immutable);
 533
 534     INSTALL_INHERITABLE_CLASS_ACCESSOR(strict_constructor);
 535
 536     INSTALL_CLASS_HOLDER(Class, method_metaclass,     "Mouse::Meta::Method");
 537     INSTALL_CLASS_HOLDER(Class, attribute_metaclass,  "Mouse::Meta::Attribute");
 538     INSTALL_CLASS_HOLDER(Class, constructor_class,    "Mouse::Meta::Method::Constructor::XS");
 539     INSTALL_CLASS_HOLDER(Class, destructor_class,     "Mouse::Meta::Method::Destructor::XS");
 540
 541     xsub = newXS("Mouse::Meta::Method::Constructor::XS::_generate_constructor",
 542         XS_Mouse_value_holder, file);
 543     CvXSUBANY(xsub).any_ptr
 544         = newRV_inc((SV*)get_cvs("Mouse::Object::new", GV_ADD));
 545
 546     xsub = newXS("Mouse::Meta::Method::Destructor::XS::_generate_destructor",
 547         XS_Mouse_value_holder, file);
 548     CvXSUBANY(xsub).any_ptr
 549         = newRV_inc((SV*)get_cvs("Mouse::Object::DESTROY", GV_ADD));
 550 }
 551
 552
 553 void
 554 linearized_isa(SV* self)
 555 PPCODE:
 556 {
 557     /* MOUSE_xc_stash() is not available because the xc system depends on
 558        linearized_isa() */
 559     HV* const stash          = mouse_get_namespace(aTHX_ self);
 560     AV* const linearized_isa = mro_get_linear_isa(stash);
 561     I32 len;
 562     I32 i;
 563     len = AvFILLp(linearized_isa) + 1;
 564     EXTEND(SP, len);
 565     for(i = 0; i < len; i++){
 566         PUSHs(AvARRAY(linearized_isa)[i]);
 567     }
 568 }
 569
 570 void
 571 get_all_attributes(SV* self)
 572 PPCODE:
 573 {
 574     AV* const xc        = mouse_get_xc(aTHX_ self);
 575     AV* const all_attrs = MOUSE_xc_attrall(xc);
 576     I32 const len       = AvFILLp(all_attrs) + 1;
 577     I32 i;
 578
 579     EXTEND(SP, len);
 580     for(i = 0; i < len; i++){
 581         PUSHs( MOUSE_av_at(all_attrs, i) );
 582     }
 583 }
 584
 585 void
 586 new_object(SV* meta, ...)
 587 CODE:
 588 {
 589     AV* const xc   = mouse_get_xc(aTHX_ meta);
 590     HV* const args = mouse_buildargs(aTHX_ meta, NULL, ax, items);
 591     SV* object;
 592
 593     object = mouse_instance_create(aTHX_ MOUSE_xc_stash(xc));
 594     mouse_class_initialize_object(aTHX_ meta, object, args, FALSE);
 595     mouse_buildall(aTHX_ xc, object, sv_2mortal(newRV_inc((SV*)args))); /* BUILDALL */
 596     ST(0) = object; /* because object is mortal, we should return it as is */
 597     XSRETURN(1);
 598 }
 599
 600 void
 601 clone_object(SV* meta, SV* object, ...)
 602 CODE:
 603 {
 604     AV* const xc   = mouse_get_xc(aTHX_ meta);
 605     HV* const args = mouse_buildargs(aTHX_ meta, NULL, ax + 1, items - 1);
 606     SV* proto;
 607
 608     if(!mouse_is_an_instance_of(aTHX_ MOUSE_xc_stash(xc), object)) {
 609         mouse_throw_error(meta, object,
 610             "You must pass an instance of the metaclass (%"SVf"), not (%"SVf")",
 611             mcall0(meta, mouse_name), object);
 612     }
 613
 614     proto = mouse_instance_clone(aTHX_ object);
 615     mouse_class_initialize_object(aTHX_ meta, proto, args, TRUE);
 616     ST(0) = proto; /* because object is mortal, we should return it as is */
 617     XSRETURN(1);
 618 }
 619
 620 void
 621 _initialize_object(SV* meta, SV* object, HV* args, bool is_cloning = FALSE)
 622 CODE:
 623 {
 624     mouse_class_initialize_object(aTHX_ meta, object, args, is_cloning);
 625 }
 626
 627 void
 628 _invalidate_metaclass_cache(SV* meta)
 629 CODE:
 630 {
 631     AV* const xc = mouse_get_xc_if_fresh(aTHX_ meta);
 632     if(xc) {
 633         SV* const gen = MOUSE_xc_gen(xc);
 634         sv_setuv(gen, 0U);
 635     }
 636     delete_slot(meta, newSVpvs_flags("_mouse_cache_", SVs_TEMP));
 637 }
 638
 639
 640 MODULE = Mouse  PACKAGE = Mouse::Meta::Role
 641
 642 BOOT:
 643     INSTALL_SIMPLE_READER_WITH_KEY(Role, get_roles, roles);
 644     INSTALL_SIMPLE_PREDICATE_WITH_KEY(Role, is_anon_role, anon_serial_id);
 645
 646     INSTALL_CLASS_HOLDER(Role, method_metaclass,  "Mouse::Meta::Role::Method");
 647
 648 void
 649 add_before_modifier(SV* self, SV* name, SV* modifier)
 650 CODE:
 651 {
 652     av_push(mouse_get_modifier_storage(aTHX_ self, (enum mouse_modifier_t)ix, name), newSVsv(modifier));
 653 }
 654 ALIAS:
 655     add_before_method_modifier = MOUSE_M_BEFORE
 656     add_around_method_modifier = MOUSE_M_AROUND
 657     add_after_method_modifier  = MOUSE_M_AFTER
 658
 659 void
 660 get_before_modifiers(SV* self, SV* name)
 661 ALIAS:
 662     get_before_method_modifiers = MOUSE_M_BEFORE
 663     get_around_method_modifiers = MOUSE_M_AROUND
 664     get_after_method_modifiers  = MOUSE_M_AFTER
 665 PPCODE:
 666 {
 667     AV* const storage = mouse_get_modifier_storage(aTHX_ self, (enum mouse_modifier_t)ix, name);
 668     I32 const len     = av_len(storage) + 1;
 669     if(GIMME_V == G_ARRAY) {
 670         I32 i;
 671         EXTEND(SP, len);
 672         for(i = 0; i < len; i++){
 673             PUSHs(*av_fetch(storage, i, TRUE));
 674         }
 675     }
 676     else{
 677         mPUSHi(len);
 678     }
 679 }
 680
 681 void
 682 add_metaclass_accessor(SV* self, SV* name)
 683 CODE:
 684 {
 685     SV* const klass = mcall0(self, mouse_name);
 686     const char* fq_name = form("%"SVf"::%"SVf, klass, name);
 687     STRLEN keylen;
 688     const char* const key = SvPV_const(name, keylen);
 689     mouse_simple_accessor_generate(aTHX_ fq_name, key, keylen,
 690         XS_Mouse_inheritable_class_accessor, NULL, 0);
 691 }
 692
 693 MODULE = Mouse  PACKAGE = Mouse::Object
 694
 695 void
 696 new(SV* klass, ...)
 697 CODE:
 698 {
 699     SV* const meta = mouse_initialize_metaclass(aTHX_ klass);
 700     AV* const xc   = mouse_get_xc(aTHX_ meta);
 701     UV const flags = MOUSE_xc_flags(xc);
 702     SV* args;
 703     SV* object;
 704
 705     /* BUILDARGS */
 706     if(flags & MOUSEf_XC_HAS_BUILDARGS){
 707         I32 i;
 708         SPAGAIN;
 709
 710         PUSHMARK(SP);
 711         EXTEND(SP, items);
 712         for(i = 0; i < items; i++){
 713             PUSHs(ST(i));
 714         }
 715
 716         PUTBACK;
 717         call_method_safes("BUILDARGS", G_SCALAR);
 718
 719         SPAGAIN;
 720         args = POPs;
 721         PUTBACK;
 722
 723         if(!IsHashRef(args)){
 724             croak("BUILDARGS did not return a HASH reference");
 725         }
 726     }
 727     else{
 728         args = newRV_inc((SV*)mouse_buildargs(aTHX_ meta, klass, ax, items));
 729         sv_2mortal(args);
 730     }
 731
 732     /* new_object */
 733     object = mouse_instance_create(aTHX_ MOUSE_xc_stash(xc));
 734     mouse_class_initialize_object(aTHX_ meta, object, (HV*)SvRV(args), FALSE);
 735     mouse_buildall(aTHX_ xc, object, args); /* BUILDALL */
 736     ST(0) = object; /* because object is mortal, we should return it as is */
 737     XSRETURN(1);
 738 }
 739
 740 void
 741 DESTROY(SV* object)
 742 ALIAS:
 743     DESTROY     = 0
 744     DEMOLISHALL = 1
 745 CODE:
 746 {
 747     SV* const meta = get_metaclass(object);
 748     AV* xc;
 749     AV* demolishall;
 750     I32 len;
 751     I32 i;
 752
 753     if(!IsObject(object)){
 754         croak("You must not call %s as a class method",
 755             ix == 0 ? "DESTROY" : "DEMOLISHALL");
 756     }
 757
 758     if(SvOK(meta) && (xc = mouse_get_xc_if_fresh(aTHX_ meta))) {
 759         demolishall = MOUSE_xc_demolishall(xc);
 760     }
 761     else { /* The metaclass is already destroyed */
 762         AV* const linearized_isa = mro_get_linear_isa(SvSTASH(SvRV(object)));
 763
 764         len = AvFILLp(linearized_isa) + 1;
 765
 766         demolishall = newAV_mortal();
 767         for(i = 0; i < len; i++){
 768             SV* const klass = MOUSE_av_at(linearized_isa, i);
 769             HV* const st    = gv_stashsv(klass, TRUE);
 770             GV* const gv    = stash_fetchs(st, "DEMOLISH", FALSE);
 771             if(gv && GvCVu(gv)){
 772                 av_push(demolishall, newRV_inc((SV*)GvCV(gv)));
 773             }
 774         }
 775     }
 776
 777     len  = AvFILLp(demolishall) + 1;
 778     if(len > 0){
 779         SV* const in_global_destruction = boolSV(PL_dirty);
 780         SAVEI32(PL_statusvalue); /* local $? */
 781         PL_statusvalue = 0;
 782
 783         SAVESPTR(ERRSV); /* local $@ */
 784         ERRSV = sv_newmortal();
 785
 786         EXTEND(SP, 2);
 787
 788         for(i = 0; i < len; i++){
 789             SPAGAIN;
 790
 791             PUSHMARK(SP);
 792             PUSHs(object);
 793             PUSHs(in_global_destruction);
 794             PUTBACK;
 795
 796             call_sv(AvARRAY(demolishall)[i], G_VOID | G_EVAL);
 797
 798             /* discard a scalar which G_VOID returns */
 799             SPAGAIN;
 800             (void)POPs;
 801             PUTBACK;
 802
 803             if(sv_true(ERRSV)){
 804                 SV* const e = newSVsv(ERRSV);
 805
 806                 FREETMPS;
 807                 LEAVE;
 808
 809                 sv_setsv(ERRSV, e);
 810                 SvREFCNT_dec(e);
 811                 croak(NULL); /* rethrow */
 812             }
 813         }
 814     }
 815 }
 816
 817 HV*
 818 BUILDARGS(SV* klass, ...)
 819 CODE:
 820 {
 821     RETVAL = mouse_buildargs(aTHX_ NULL, klass, ax, items);
 822 }
 823 OUTPUT:
 824     RETVAL
 825
 826
 827 void
 828 BUILDALL(SV* self, SV* args)
 829 CODE:
 830 {
 831     SV* const meta = get_metaclass(self);
 832     AV* const xc   = mouse_get_xc(aTHX_ meta);
 833
 834     must_ref(args, "a HASH reference to BUILDALL", SVt_PVHV);
 835     mouse_buildall(aTHX_ xc, self, args);
 836 }