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