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