apply patch from ash on #moose
[gitmo/Class-MOP.git] / lib / Class / MOP.pm
CommitLineData
94b19069 1
2package Class::MOP;
3
4use strict;
5use warnings;
6
5a2932cf 7use 5.008;
8
3cf322a0 9use MRO::Compat;
10
4c105333 11use Carp 'confess';
b1a46f91 12use Scalar::Util 'weaken', 'reftype', 'blessed';
fc4f8f91 13
0531f510 14use Class::MOP::Class;
15use Class::MOP::Attribute;
16use Class::MOP::Method;
17
b1f5f41d 18BEGIN {
c7e28c19 19 *IS_RUNNING_ON_5_10 = ($] < 5.009_005)
11b56828 20 ? sub () { 0 }
c7e28c19 21 : sub () { 1 };
46b23b44 22
f9bd8fe2 23 sub HAVE_ISAREV () {
c7e28c19 24 Carp::cluck("Class::MOP::HAVE_ISAREV is deprecated and will be removed in a future release. It has always returned 1 anyway.");
f9bd8fe2 25 return 1;
26 }
3ecd1b25 27
28 # this is either part of core or set up appropriately by MRO::Compat
29 *check_package_cache_flag = \&mro::get_pkg_gen;
b1f5f41d 30}
e0e4674a 31
b7e04496 32our $VERSION = '0.88';
8a7085c1 33our $XS_VERSION = $VERSION;
d519662a 34$VERSION = eval $VERSION;
c7e28c19 35our $AUTHORITY = 'cpan:STEVAN';
9d655b6d 36
4bfa5ddb 37require XSLoader;
38XSLoader::load( __PACKAGE__, $XS_VERSION );
d7bda114 39
40
be7677c7 41{
42 # Metaclasses are singletons, so we cache them here.
43 # there is no need to worry about destruction though
44 # because they should die only when the program dies.
45 # After all, do package definitions even get reaped?
247d5b3c 46 # Anonymous classes manage their own destruction.
1d68af04 47 my %METAS;
48
1d68af04 49 sub get_all_metaclasses { %METAS }
50 sub get_all_metaclass_instances { values %METAS }
51 sub get_all_metaclass_names { keys %METAS }
be7677c7 52 sub get_metaclass_by_name { $METAS{$_[0]} }
1d68af04 53 sub store_metaclass_by_name { $METAS{$_[0]} = $_[1] }
54 sub weaken_metaclass { weaken($METAS{$_[0]}) }
be7677c7 55 sub does_metaclass_exist { exists $METAS{$_[0]} && defined $METAS{$_[0]} }
1d68af04 56 sub remove_metaclass_by_name { $METAS{$_[0]} = undef }
57
86866fb5 58 # This handles instances as well as class names
59 sub class_of {
82999986 60 return unless defined $_[0];
86866fb5 61 my $class = blessed($_[0]) || $_[0];
62 return $METAS{$class};
63 }
64
be7677c7 65 # NOTE:
1d68af04 66 # We only cache metaclasses, meaning instances of
67 # Class::MOP::Class. We do not cache instance of
be7677c7 68 # Class::MOP::Package or Class::MOP::Module. Mostly
1d68af04 69 # because I don't yet see a good reason to do so.
be7677c7 70}
71
44da14be 72sub _class_to_pmfile {
73 my $class = shift;
74
75 my $file = $class . '.pm';
76 $file =~ s{::}{/}g;
77
78 return $file;
79}
80
063ad0c5 81sub load_first_existing_class {
f280f05c 82 my @classes = @_
83 or return;
5a24cf8a 84
85 foreach my $class (@classes) {
86 unless ( _is_valid_class_name($class) ) {
87 my $display = defined($class) ? $class : 'undef';
88 confess "Invalid class name ($display)";
89 }
ab5e2f48 90 }
91
063ad0c5 92 my $found;
5a24cf8a 93 my %exceptions;
063ad0c5 94 for my $class (@classes) {
44da14be 95 my $pmfile = _class_to_pmfile($class);
063ad0c5 96 my $e = _try_load_one_class($class);
97
5a24cf8a 98 if ($e) {
063ad0c5 99 $exceptions{$class} = $e;
44da14be 100 last if $e !~ /^Can't locate \Q$pmfile\E in \@INC/;
5a24cf8a 101 }
102 else {
063ad0c5 103 $found = $class;
104 last;
5a24cf8a 105 }
063ad0c5 106 }
5a24cf8a 107
1d8153bd 108 return $found if $found;
07940968 109
063ad0c5 110 confess join(
111 "\n",
112 map {
113 sprintf(
fea44045 114 "Could not load class (%s) because : %s", $_,
063ad0c5 115 $exceptions{$_}
116 )
44da14be 117 }
118 grep {
119 exists $exceptions{$_}
063ad0c5 120 } @classes
f280f05c 121 );
5a24cf8a 122}
123
063ad0c5 124sub _try_load_one_class {
125 my $class = shift;
126
127 return if is_class_loaded($class);
2beec805 128
44da14be 129 my $file = _class_to_pmfile($class);
063ad0c5 130
131 return do {
132 local $@;
b3813a8c 133 local $SIG{__DIE__};
063ad0c5 134 eval { require($file) };
135 $@;
136 };
137}
138
5a24cf8a 139sub load_class {
1d8153bd 140 my $class = load_first_existing_class($_[0]);
141 return get_metaclass_by_name($class) || $class;
448b6e55 142}
143
2c0fb064 144sub _is_valid_class_name {
145 my $class = shift;
146
147 return 0 if ref($class);
148 return 0 unless defined($class);
149 return 0 unless length($class);
150
151 return 1 if $class =~ /^\w+(?:::\w+)*$/;
152
153 return 0;
154}
155
d5ed91ad 156sub subname {
157 require Sub::Name;
158 Carp::carp("Class::MOP::subname is deprecated. Please use Sub::Name directly.");
159 goto \&Sub::Name::subname;
160}
161
162sub in_global_destruction {
163 require Devel::GlobalDestruction;
164 Carp::carp("Class::MOP::in_global_destruction is deprecated. Please use Devel::GlobalDestruction directly.");
165 goto \&Devel::GlobalDestruction::in_global_destruction;
166}
167
aa448b16 168## ----------------------------------------------------------------------------
169## Setting up our environment ...
170## ----------------------------------------------------------------------------
1d68af04 171## Class::MOP needs to have a few things in the global perl environment so
aa448b16 172## that it can operate effectively. Those things are done here.
173## ----------------------------------------------------------------------------
174
3bf7644b 175# ... nothing yet actually ;)
8b978dd5 176
b51af7f9 177## ----------------------------------------------------------------------------
1d68af04 178## Bootstrapping
b51af7f9 179## ----------------------------------------------------------------------------
1d68af04 180## The code below here is to bootstrap our MOP with itself. This is also
b51af7f9 181## sometimes called "tying the knot". By doing this, we make it much easier
182## to extend the MOP through subclassing and such since now you can use the
1d68af04 183## MOP itself to extend itself.
184##
b51af7f9 185## Yes, I know, thats weird and insane, but it's a good thing, trust me :)
1d68af04 186## ----------------------------------------------------------------------------
727919c5 187
1d68af04 188# We need to add in the meta-attributes here so that
189# any subclass of Class::MOP::* will be able to
c2b256bc 190# inherit them using _construct_instance
727919c5 191
f0480c45 192## --------------------------------------------------------
6d5355c3 193## Class::MOP::Package
727919c5 194
6d5355c3 195Class::MOP::Package->meta->add_attribute(
8683db0e 196 Class::MOP::Attribute->new('package' => (
b880e0de 197 reader => {
1d68af04 198 # NOTE: we need to do this in order
199 # for the instance meta-object to
b880e0de 200 # not fall into meta-circular death
1d68af04 201 #
ce2ae40f 202 # we just alias the original method
1d68af04 203 # rather than re-produce it here
ce2ae40f 204 'name' => \&Class::MOP::Package::name
b880e0de 205 },
727919c5 206 ))
207);
208
a5e51f0b 209Class::MOP::Package->meta->add_attribute(
8683db0e 210 Class::MOP::Attribute->new('namespace' => (
a5e51f0b 211 reader => {
56dcfc1a 212 # NOTE:
ce2ae40f 213 # we just alias the original method
214 # rather than re-produce it here
215 'namespace' => \&Class::MOP::Package::namespace
a5e51f0b 216 },
2e877f58 217 init_arg => undef,
c4260b45 218 default => sub { \undef }
a5e51f0b 219 ))
220);
221
f0480c45 222## --------------------------------------------------------
223## Class::MOP::Module
224
225# NOTE:
1d68af04 226# yeah this is kind of stretching things a bit,
f0480c45 227# but truthfully the version should be an attribute
1d68af04 228# of the Module, the weirdness comes from having to
229# stick to Perl 5 convention and store it in the
230# $VERSION package variable. Basically if you just
231# squint at it, it will look how you want it to look.
f0480c45 232# Either as a package variable, or as a attribute of
233# the metaclass, isn't abstraction great :)
234
235Class::MOP::Module->meta->add_attribute(
8683db0e 236 Class::MOP::Attribute->new('version' => (
f0480c45 237 reader => {
ce2ae40f 238 # NOTE:
239 # we just alias the original method
1d68af04 240 # rather than re-produce it here
ce2ae40f 241 'version' => \&Class::MOP::Module::version
f0480c45 242 },
2e877f58 243 init_arg => undef,
c4260b45 244 default => sub { \undef }
f0480c45 245 ))
246);
247
248# NOTE:
1d68af04 249# By following the same conventions as version here,
250# we are opening up the possibility that people can
251# use the $AUTHORITY in non-Class::MOP modules as
252# well.
f0480c45 253
254Class::MOP::Module->meta->add_attribute(
8683db0e 255 Class::MOP::Attribute->new('authority' => (
f0480c45 256 reader => {
ce2ae40f 257 # NOTE:
258 # we just alias the original method
1d68af04 259 # rather than re-produce it here
ce2ae40f 260 'authority' => \&Class::MOP::Module::authority
1d68af04 261 },
2e877f58 262 init_arg => undef,
c4260b45 263 default => sub { \undef }
f0480c45 264 ))
265);
266
267## --------------------------------------------------------
6d5355c3 268## Class::MOP::Class
269
727919c5 270Class::MOP::Class->meta->add_attribute(
8683db0e 271 Class::MOP::Attribute->new('attributes' => (
f7259199 272 reader => {
1d68af04 273 # NOTE: we need to do this in order
274 # for the instance meta-object to
275 # not fall into meta-circular death
276 #
ce2ae40f 277 # we just alias the original method
1d68af04 278 # rather than re-produce it here
ce2ae40f 279 'get_attribute_map' => \&Class::MOP::Class::get_attribute_map
f7259199 280 },
727919c5 281 default => sub { {} }
282 ))
283);
284
351bd7d4 285Class::MOP::Class->meta->add_attribute(
8683db0e 286 Class::MOP::Attribute->new('methods' => (
1d68af04 287 reader => {
ce2ae40f 288 # NOTE:
289 # we just alias the original method
1d68af04 290 # rather than re-produce it here
ce2ae40f 291 'get_method_map' => \&Class::MOP::Class::get_method_map
92330ee2 292 },
7855ddba 293 default => sub { {} }
c4260b45 294 ))
295);
296
297Class::MOP::Class->meta->add_attribute(
8683db0e 298 Class::MOP::Attribute->new('superclasses' => (
c23184fc 299 accessor => {
300 # NOTE:
301 # we just alias the original method
1d68af04 302 # rather than re-produce it here
c23184fc 303 'superclasses' => \&Class::MOP::Class::superclasses
304 },
2e877f58 305 init_arg => undef,
c23184fc 306 default => sub { \undef }
307 ))
308);
309
310Class::MOP::Class->meta->add_attribute(
8683db0e 311 Class::MOP::Attribute->new('attribute_metaclass' => (
1d68af04 312 reader => {
6d2118a4 313 # NOTE:
314 # we just alias the original method
1d68af04 315 # rather than re-produce it here
6d2118a4 316 'attribute_metaclass' => \&Class::MOP::Class::attribute_metaclass
1d68af04 317 },
351bd7d4 318 default => 'Class::MOP::Attribute',
319 ))
320);
321
322Class::MOP::Class->meta->add_attribute(
8683db0e 323 Class::MOP::Attribute->new('method_metaclass' => (
1d68af04 324 reader => {
6d2118a4 325 # NOTE:
326 # we just alias the original method
1d68af04 327 # rather than re-produce it here
6d2118a4 328 'method_metaclass' => \&Class::MOP::Class::method_metaclass
329 },
1d68af04 330 default => 'Class::MOP::Method',
351bd7d4 331 ))
332);
333
2bab2be6 334Class::MOP::Class->meta->add_attribute(
77373da8 335 Class::MOP::Attribute->new('wrapped_method_metaclass' => (
336 reader => {
337 # NOTE:
338 # we just alias the original method
339 # rather than re-produce it here
340 'wrapped_method_metaclass' => \&Class::MOP::Class::wrapped_method_metaclass
341 },
342 default => 'Class::MOP::Method::Wrapped',
343 ))
344);
345
346Class::MOP::Class->meta->add_attribute(
8683db0e 347 Class::MOP::Attribute->new('instance_metaclass' => (
b880e0de 348 reader => {
1d68af04 349 # NOTE: we need to do this in order
350 # for the instance meta-object to
351 # not fall into meta-circular death
352 #
ce2ae40f 353 # we just alias the original method
1d68af04 354 # rather than re-produce it here
ce2ae40f 355 'instance_metaclass' => \&Class::MOP::Class::instance_metaclass
b880e0de 356 },
1d68af04 357 default => 'Class::MOP::Instance',
2bab2be6 358 ))
359);
360
44d6ea77 361Class::MOP::Class->meta->add_attribute(
f5d08022 362 Class::MOP::Attribute->new('immutable_trait' => (
363 reader => {
364 'immutable_trait' => \&Class::MOP::Class::immutable_trait
365 },
366 default => "Class::MOP::Class::Immutable::Trait",
367 ))
368);
369
370Class::MOP::Class->meta->add_attribute(
371 Class::MOP::Attribute->new('constructor_name' => (
44d6ea77 372 reader => {
f5d08022 373 'constructor_name' => \&Class::MOP::Class::constructor_name,
44d6ea77 374 },
f5d08022 375 default => "new",
376 ))
377);
378
379Class::MOP::Class->meta->add_attribute(
380 Class::MOP::Attribute->new('constructor_class' => (
44d6ea77 381 reader => {
f5d08022 382 'constructor_class' => \&Class::MOP::Class::constructor_class,
44d6ea77 383 },
f5d08022 384 default => "Class::MOP::Method::Constructor",
385 ))
386);
387
388
389Class::MOP::Class->meta->add_attribute(
390 Class::MOP::Attribute->new('destructor_class' => (
391 reader => {
392 'destructor_class' => \&Class::MOP::Class::destructor_class,
44d6ea77 393 },
394 ))
395);
396
9d6dce77 397# NOTE:
1d68af04 398# we don't actually need to tie the knot with
399# Class::MOP::Class here, it is actually handled
400# within Class::MOP::Class itself in the
c2b256bc 401# _construct_class_instance method.
9d6dce77 402
f0480c45 403## --------------------------------------------------------
727919c5 404## Class::MOP::Attribute
405
7b31baf4 406Class::MOP::Attribute->meta->add_attribute(
8683db0e 407 Class::MOP::Attribute->new('name' => (
c23184fc 408 reader => {
1d68af04 409 # NOTE: we need to do this in order
410 # for the instance meta-object to
411 # not fall into meta-circular death
412 #
ce2ae40f 413 # we just alias the original method
1d68af04 414 # rather than re-produce it here
ce2ae40f 415 'name' => \&Class::MOP::Attribute::name
b880e0de 416 }
7b31baf4 417 ))
418);
419
420Class::MOP::Attribute->meta->add_attribute(
8683db0e 421 Class::MOP::Attribute->new('associated_class' => (
c23184fc 422 reader => {
1d68af04 423 # NOTE: we need to do this in order
424 # for the instance meta-object to
425 # not fall into meta-circular death
426 #
ce2ae40f 427 # we just alias the original method
1d68af04 428 # rather than re-produce it here
ce2ae40f 429 'associated_class' => \&Class::MOP::Attribute::associated_class
b880e0de 430 }
7b31baf4 431 ))
432);
433
434Class::MOP::Attribute->meta->add_attribute(
8683db0e 435 Class::MOP::Attribute->new('accessor' => (
6d2118a4 436 reader => { 'accessor' => \&Class::MOP::Attribute::accessor },
437 predicate => { 'has_accessor' => \&Class::MOP::Attribute::has_accessor },
7b31baf4 438 ))
439);
440
441Class::MOP::Attribute->meta->add_attribute(
8683db0e 442 Class::MOP::Attribute->new('reader' => (
6d2118a4 443 reader => { 'reader' => \&Class::MOP::Attribute::reader },
444 predicate => { 'has_reader' => \&Class::MOP::Attribute::has_reader },
7b31baf4 445 ))
446);
447
448Class::MOP::Attribute->meta->add_attribute(
8683db0e 449 Class::MOP::Attribute->new('initializer' => (
8ee74136 450 reader => { 'initializer' => \&Class::MOP::Attribute::initializer },
451 predicate => { 'has_initializer' => \&Class::MOP::Attribute::has_initializer },
0ab65f99 452 ))
453);
454
455Class::MOP::Attribute->meta->add_attribute(
d9d99689 456 Class::MOP::Attribute->new('definition_context' => (
457 reader => { 'definition_context' => \&Class::MOP::Attribute::definition_context },
458 ))
459);
460
461Class::MOP::Attribute->meta->add_attribute(
8683db0e 462 Class::MOP::Attribute->new('writer' => (
6d2118a4 463 reader => { 'writer' => \&Class::MOP::Attribute::writer },
464 predicate => { 'has_writer' => \&Class::MOP::Attribute::has_writer },
7b31baf4 465 ))
466);
467
468Class::MOP::Attribute->meta->add_attribute(
8683db0e 469 Class::MOP::Attribute->new('predicate' => (
6d2118a4 470 reader => { 'predicate' => \&Class::MOP::Attribute::predicate },
471 predicate => { 'has_predicate' => \&Class::MOP::Attribute::has_predicate },
7b31baf4 472 ))
473);
474
475Class::MOP::Attribute->meta->add_attribute(
8683db0e 476 Class::MOP::Attribute->new('clearer' => (
6d2118a4 477 reader => { 'clearer' => \&Class::MOP::Attribute::clearer },
478 predicate => { 'has_clearer' => \&Class::MOP::Attribute::has_clearer },
7d28758b 479 ))
480);
481
482Class::MOP::Attribute->meta->add_attribute(
8683db0e 483 Class::MOP::Attribute->new('builder' => (
1d68af04 484 reader => { 'builder' => \&Class::MOP::Attribute::builder },
485 predicate => { 'has_builder' => \&Class::MOP::Attribute::has_builder },
486 ))
487);
488
489Class::MOP::Attribute->meta->add_attribute(
8683db0e 490 Class::MOP::Attribute->new('init_arg' => (
6d2118a4 491 reader => { 'init_arg' => \&Class::MOP::Attribute::init_arg },
492 predicate => { 'has_init_arg' => \&Class::MOP::Attribute::has_init_arg },
7b31baf4 493 ))
494);
495
496Class::MOP::Attribute->meta->add_attribute(
8683db0e 497 Class::MOP::Attribute->new('default' => (
7b31baf4 498 # default has a custom 'reader' method ...
1d68af04 499 predicate => { 'has_default' => \&Class::MOP::Attribute::has_default },
7b31baf4 500 ))
501);
502
3545c727 503Class::MOP::Attribute->meta->add_attribute(
8683db0e 504 Class::MOP::Attribute->new('associated_methods' => (
c23184fc 505 reader => { 'associated_methods' => \&Class::MOP::Attribute::associated_methods },
1d68af04 506 default => sub { [] }
3545c727 507 ))
508);
727919c5 509
95b67145 510Class::MOP::Attribute->meta->add_attribute(
511 Class::MOP::Attribute->new('insertion_order' => (
512 reader => { 'insertion_order' => \&Class::MOP::Attribute::insertion_order },
943cbe2d 513 writer => { '_set_insertion_order' => \&Class::MOP::Attribute::_set_insertion_order },
95b67145 514 predicate => { 'has_insertion_order' => \&Class::MOP::Attribute::has_insertion_order },
515 ))
516);
517
5659d76e 518Class::MOP::Attribute->meta->add_method('clone' => sub {
a740253a 519 my $self = shift;
1d68af04 520 $self->meta->clone_object($self, @_);
727919c5 521});
522
f0480c45 523## --------------------------------------------------------
b6164407 524## Class::MOP::Method
b6164407 525Class::MOP::Method->meta->add_attribute(
8683db0e 526 Class::MOP::Attribute->new('body' => (
c23184fc 527 reader => { 'body' => \&Class::MOP::Method::body },
b6164407 528 ))
529);
530
4c105333 531Class::MOP::Method->meta->add_attribute(
5e607260 532 Class::MOP::Attribute->new('associated_metaclass' => (
5e607260 533 reader => { 'associated_metaclass' => \&Class::MOP::Method::associated_metaclass },
534 ))
535);
536
537Class::MOP::Method->meta->add_attribute(
8683db0e 538 Class::MOP::Attribute->new('package_name' => (
4c105333 539 reader => { 'package_name' => \&Class::MOP::Method::package_name },
540 ))
541);
542
543Class::MOP::Method->meta->add_attribute(
8683db0e 544 Class::MOP::Attribute->new('name' => (
4c105333 545 reader => { 'name' => \&Class::MOP::Method::name },
546 ))
547);
548
2226a8b0 549Class::MOP::Method->meta->add_attribute(
550 Class::MOP::Attribute->new('original_method' => (
551 reader => { 'original_method' => \&Class::MOP::Method::original_method },
552 writer => { '_set_original_method' => \&Class::MOP::Method::_set_original_method },
553 ))
554);
555
4c105333 556Class::MOP::Method->meta->add_method('clone' => sub {
557 my $self = shift;
2226a8b0 558 my $clone = $self->meta->clone_object($self, @_);
559 $clone->_set_original_method($self);
560 return $clone;
4c105333 561});
562
b6164407 563## --------------------------------------------------------
564## Class::MOP::Method::Wrapped
565
566# NOTE:
1d68af04 567# the way this item is initialized, this
568# really does not follow the standard
569# practices of attributes, but we put
b6164407 570# it here for completeness
571Class::MOP::Method::Wrapped->meta->add_attribute(
8683db0e 572 Class::MOP::Attribute->new('modifier_table')
b6164407 573);
574
575## --------------------------------------------------------
565f0cbb 576## Class::MOP::Method::Generated
577
578Class::MOP::Method::Generated->meta->add_attribute(
8683db0e 579 Class::MOP::Attribute->new('is_inline' => (
565f0cbb 580 reader => { 'is_inline' => \&Class::MOP::Method::Generated::is_inline },
4c105333 581 default => 0,
1d68af04 582 ))
565f0cbb 583);
584
d9d99689 585Class::MOP::Method::Generated->meta->add_attribute(
586 Class::MOP::Attribute->new('definition_context' => (
587 reader => { 'definition_context' => \&Class::MOP::Method::Generated::definition_context },
588 ))
589);
590
29d4e92a 591
592## --------------------------------------------------------
593## Class::MOP::Method::Inlined
594
595Class::MOP::Method::Inlined->meta->add_attribute(
596 Class::MOP::Attribute->new('_expected_method_class' => (
597 reader => { '_expected_method_class' => \&Class::MOP::Method::Inlined::_expected_method_class },
598 ))
599);
600
565f0cbb 601## --------------------------------------------------------
d90b42a6 602## Class::MOP::Method::Accessor
603
604Class::MOP::Method::Accessor->meta->add_attribute(
8683db0e 605 Class::MOP::Attribute->new('attribute' => (
1d68af04 606 reader => {
607 'associated_attribute' => \&Class::MOP::Method::Accessor::associated_attribute
d90b42a6 608 },
1d68af04 609 ))
d90b42a6 610);
611
612Class::MOP::Method::Accessor->meta->add_attribute(
8683db0e 613 Class::MOP::Attribute->new('accessor_type' => (
c23184fc 614 reader => { 'accessor_type' => \&Class::MOP::Method::Accessor::accessor_type },
1d68af04 615 ))
d90b42a6 616);
617
d90b42a6 618## --------------------------------------------------------
619## Class::MOP::Method::Constructor
620
621Class::MOP::Method::Constructor->meta->add_attribute(
8683db0e 622 Class::MOP::Attribute->new('options' => (
1d68af04 623 reader => {
624 'options' => \&Class::MOP::Method::Constructor::options
d90b42a6 625 },
4c105333 626 default => sub { +{} }
1d68af04 627 ))
d90b42a6 628);
629
630Class::MOP::Method::Constructor->meta->add_attribute(
8683db0e 631 Class::MOP::Attribute->new('associated_metaclass' => (
e8a38403 632 init_arg => "metaclass", # FIXME alias and rename
1d68af04 633 reader => {
634 'associated_metaclass' => \&Class::MOP::Method::Constructor::associated_metaclass
635 },
636 ))
d90b42a6 637);
638
639## --------------------------------------------------------
86482605 640## Class::MOP::Instance
641
642# NOTE:
1d68af04 643# these don't yet do much of anything, but are just
86482605 644# included for completeness
645
646Class::MOP::Instance->meta->add_attribute(
74890687 647 Class::MOP::Attribute->new('associated_metaclass',
648 reader => { associated_metaclass => \&Class::MOP::Instance::associated_metaclass },
649 ),
86482605 650);
651
652Class::MOP::Instance->meta->add_attribute(
74890687 653 Class::MOP::Attribute->new('_class_name',
654 init_arg => undef,
655 reader => { _class_name => \&Class::MOP::Instance::_class_name },
656 #lazy => 1, # not yet supported by Class::MOP but out our version does it anyway
657 #default => sub { $_[0]->associated_metaclass->name },
658 ),
659);
660
661Class::MOP::Instance->meta->add_attribute(
662 Class::MOP::Attribute->new('attributes',
0b5d46da 663 reader => { attributes => \&Class::MOP::Instance::get_all_attributes },
74890687 664 ),
32bfc810 665);
666
667Class::MOP::Instance->meta->add_attribute(
74890687 668 Class::MOP::Attribute->new('slots',
669 reader => { slots => \&Class::MOP::Instance::slots },
670 ),
86482605 671);
672
63d08a9e 673Class::MOP::Instance->meta->add_attribute(
74890687 674 Class::MOP::Attribute->new('slot_hash',
675 reader => { slot_hash => \&Class::MOP::Instance::slot_hash },
676 ),
63d08a9e 677);
678
679
caa051fa 680# we need the meta instance of the meta instance to be created now, in order
681# for the constructor to be able to use it
682Class::MOP::Instance->meta->get_meta_instance;
683
caa051fa 684# pretend the add_method never happenned. it hasn't yet affected anything
685undef Class::MOP::Instance->meta->{_package_cache_flag};
686
86482605 687## --------------------------------------------------------
f0480c45 688## Now close all the Class::MOP::* classes
4d47b77f 689
1aa13cf4 690# NOTE: we don't need to inline the the accessors this only lengthens
691# the compile time of the MOP, and gives us no actual benefits.
0b9372a2 692
a7b17d6f 693# this is just nitpicking to ensure Class::MOP::Class->meta == ->meta->meta
e1c7a1b7 694Class::MOP::Class->meta->_immutable_metaclass;
a7b17d6f 695$Class::MOP::Class::immutable_metaclass_cache{"Class::MOP::Class"}{"Class::MOP::Class::Immutable::Trait"} = Class::MOP::Class::Immutable::Class::MOP::Class->meta;
696
0b9372a2 697$_->meta->make_immutable(
6c2f6b5c 698 inline_constructor => 1,
699 replace_constructor => 1,
700 constructor_name => "_new",
45582002 701 inline_accessors => 0,
0b9372a2 702) for qw/
1d68af04 703 Class::MOP::Package
704 Class::MOP::Module
705 Class::MOP::Class
a7b17d6f 706 Class::MOP::Class::Immutable::Class::MOP::Class
1d68af04 707
0b9372a2 708 Class::MOP::Attribute
1d68af04 709 Class::MOP::Method
710 Class::MOP::Instance
711
712 Class::MOP::Object
0b9372a2 713
565f0cbb 714 Class::MOP::Method::Generated
29d4e92a 715 Class::MOP::Method::Inlined
1d68af04 716
ba38bf08 717 Class::MOP::Method::Accessor
1d68af04 718 Class::MOP::Method::Constructor
719 Class::MOP::Method::Wrapped
0b9372a2 720/;
b6164407 721
94b19069 7221;
723
724__END__
725
726=pod
727
1d68af04 728=head1 NAME
94b19069 729
730Class::MOP - A Meta Object Protocol for Perl 5
731
5b60bf98 732=head1 DESCRIPTION
94b19069 733
127d39a7 734This module is a fully functioning meta object protocol for the
1d68af04 735Perl 5 object system. It makes no attempt to change the behavior or
736characteristics of the Perl 5 object system, only to create a
27e31eaf 737protocol for its manipulation and introspection.
94b19069 738
828ecf13 739That said, it does attempt to create the tools for building a rich set
740of extensions to the Perl 5 object system. Every attempt has been made
741to abide by the spirit of the Perl 5 object system that we all know
742and love.
94b19069 743
828ecf13 744This documentation is sparse on conceptual details. We suggest looking
745at the items listed in the L<SEE ALSO> section for more
746information. In particular the book "The Art of the Meta Object
747Protocol" was very influential in the development of this system.
40483095 748
bfe4d0fc 749=head2 What is a Meta Object Protocol?
750
1d68af04 751A meta object protocol is an API to an object system.
bfe4d0fc 752
828ecf13 753To be more specific, it abstracts the components of an object system
754(classes, object, methods, object attributes, etc.). These
755abstractions can then be used to inspect and manipulate the object
756system which they describe.
bfe4d0fc 757
1d68af04 758It can be said that there are two MOPs for any object system; the
828ecf13 759implicit MOP and the explicit MOP. The implicit MOP handles things
1d68af04 760like method dispatch or inheritance, which happen automatically as
761part of how the object system works. The explicit MOP typically
762handles the introspection/reflection features of the object system.
bfe4d0fc 763
828ecf13 764All object systems have implicit MOPs. Without one, they would not
5b60bf98 765work. Explicit MOPs are much less common, and depending on the
766language can vary from restrictive (Reflection in Java or C#) to wide
767open (CLOS is a perfect example).
e16da3e6 768
828ecf13 769=head2 Yet Another Class Builder! Why?
770
771This is B<not> a class builder so much as a I<class builder
772B<builder>>. The intent is that an end user will not use this module
773directly, but instead this module is used by module authors to build
774extensions and features onto the Perl 5 object system.
775
776This system is used by L<Moose>, which supplies a powerful class
777builder system built entirely on top of C<Class::MOP>.
e16da3e6 778
94b19069 779=head2 Who is this module for?
780
828ecf13 781This module is for anyone who has ever created or wanted to create a
782module for the Class:: namespace. The tools which this module provides
783make doing complex Perl 5 wizardry simpler, by removing such barriers
784as the need to hack symbol tables, or understand the fine details of
785method dispatch.
94b19069 786
bfe4d0fc 787=head2 What changes do I have to make to use this module?
788
828ecf13 789This module was designed to be as unintrusive as possible. Many of its
5b60bf98 790features are accessible without B<any> change to your existing
828ecf13 791code. It is meant to be a compliment to your existing code and not an
792intrusion on your code base. Unlike many other B<Class::> modules,
793this module B<does not> require you subclass it, or even that you
794C<use> it in within your module's package.
bfe4d0fc 795
1d68af04 796The only features which requires additions to your code are the
2eb717d5 797attribute handling and instance construction features, and these are
1d68af04 798both completely optional features. The only reason for this is because
799Perl 5's object system does not actually have these features built
2eb717d5 800in. More information about this feature can be found below.
bfe4d0fc 801
828ecf13 802=head2 About Performance
803
5b60bf98 804It is a common misconception that explicit MOPs are a performance hit.
828ecf13 805This is not a universal truth, it is a side-effect of some specific
806implementations. For instance, using Java reflection is slow because
807the JVM cannot take advantage of any compiler optimizations, and the
808JVM has to deal with much more runtime type information as well.
bfe4d0fc 809
828ecf13 810Reflection in C# is marginally better as it was designed into the
811language and runtime (the CLR). In contrast, CLOS (the Common Lisp
812Object System) was built to support an explicit MOP, and so
813performance is tuned for it.
1d68af04 814
828ecf13 815This library in particular does its absolute best to avoid putting
1d68af04 816B<any> drain at all upon your code's performance. In fact, by itself
828ecf13 817it does nothing to affect your existing code. So you only pay for what
818you actually use.
bfe4d0fc 819
550d56db 820=head2 About Metaclass compatibility
821
1d68af04 822This module makes sure that all metaclasses created are both upwards
823and downwards compatible. The topic of metaclass compatibility is
824highly esoteric and is something only encountered when doing deep and
825involved metaclass hacking. There are two basic kinds of metaclass
826incompatibility; upwards and downwards.
550d56db 827
1d68af04 828Upwards metaclass compatibility means that the metaclass of a
829given class is either the same as (or a subclass of) all of the
550d56db 830class's ancestors.
831
1d68af04 832Downward metaclass compatibility means that the metaclasses of a
828ecf13 833given class's ancestors are all either the same as (or a subclass
550d56db 834of) that metaclass.
835
1d68af04 836Here is a diagram showing a set of two classes (C<A> and C<B>) and
837two metaclasses (C<Meta::A> and C<Meta::B>) which have correct
550d56db 838metaclass compatibility both upwards and downwards.
839
840 +---------+ +---------+
841 | Meta::A |<----| Meta::B | <....... (instance of )
1d68af04 842 +---------+ +---------+ <------- (inherits from)
550d56db 843 ^ ^
844 : :
845 +---------+ +---------+
846 | A |<----| B |
847 +---------+ +---------+
848
1d68af04 849As I said this is a highly esoteric topic and one you will only run
828ecf13 850into if you do a lot of subclassing of L<Class::MOP::Class>. If you
851are interested in why this is an issue see the paper I<Uniform and
852safe metaclass composition> linked to in the L<SEE ALSO> section of
853this document.
550d56db 854
aa448b16 855=head2 Using custom metaclasses
856
828ecf13 857Always use the L<metaclass> pragma when using a custom metaclass, this
5b60bf98 858will ensure the proper initialization order and not accidentally
859create an incorrect type of metaclass for you. This is a very rare
860problem, and one which can only occur if you are doing deep metaclass
aa448b16 861programming. So in other words, don't worry about it.
862
828ecf13 863Note that if you're using L<Moose> we encourage you to I<not> use
864L<metaclass> pragma, and instead use L<Moose::Util::MetaRole> to apply
865roles to a class's metaclasses. This topic is covered at length in
866various L<Moose::Cookbook> recipes.
867
94b19069 868=head1 PROTOCOLS
869
828ecf13 870The meta-object protocol is divided into 4 main sub-protocols:
94b19069 871
828ecf13 872=head2 The Class protocol
94b19069 873
1d68af04 874This provides a means of manipulating and introspecting a Perl 5
828ecf13 875class. It handles symbol table hacking for you, and provides a rich
876set of methods that go beyond simple package introspection.
94b19069 877
552e3d24 878See L<Class::MOP::Class> for more details.
879
828ecf13 880=head2 The Attribute protocol
94b19069 881
828ecf13 882This provides a consistent representation for an attribute of a Perl 5
883class. Since there are so many ways to create and handle attributes in
884Perl 5 OO, the Attribute protocol provide as much of a unified
885approach as possible. Of course, you are always free to extend this
886protocol by subclassing the appropriate classes.
94b19069 887
552e3d24 888See L<Class::MOP::Attribute> for more details.
889
828ecf13 890=head2 The Method protocol
94b19069 891
828ecf13 892This provides a means of manipulating and introspecting methods in the
893Perl 5 object system. As with attributes, there are many ways to
1d68af04 894approach this topic, so we try to keep it pretty basic, while still
94b19069 895making it possible to extend the system in many ways.
896
552e3d24 897See L<Class::MOP::Method> for more details.
94b19069 898
828ecf13 899=head2 The Instance protocol
127d39a7 900
828ecf13 901This provides a layer of abstraction for creating object instances.
902Since the other layers use this protocol, it is relatively easy to
903change the type of your instances from the default hash reference to
904some other type of reference. Several examples are provided in the
905F<examples/> directory included in this distribution.
127d39a7 906
907See L<Class::MOP::Instance> for more details.
908
be7677c7 909=head1 FUNCTIONS
910
828ecf13 911Note that this module does not export any constants or functions.
912
c1d5345a 913=head2 Constants
914
915=over 4
916
828ecf13 917=item I<Class::MOP::IS_RUNNING_ON_5_10>
c1d5345a 918
828ecf13 919We set this constant depending on what version perl we are on, this
920allows us to take advantage of new 5.10 features and stay backwards
5b60bf98 921compatible.
c1d5345a 922
923=back
924
448b6e55 925=head2 Utility functions
926
bd07fbdb 927Note that these are all called as B<functions, not methods>.
081a927b 928
448b6e55 929=over 4
930
828ecf13 931=item B<Class::MOP::load_class($class_name)>
448b6e55 932
9d441c23 933This will load the specified C<$class_name>, if it is not already
934loaded (as reported by C<is_class_loaded>). This function can be used
828ecf13 935in place of tricks like C<eval "use $module"> or using C<require>
828de8f4 936unconditionally. This will return the metaclass of C<$class_name> if
937one exists, otherwise it will return C<$class_name>.
448b6e55 938
828ecf13 939=item B<Class::MOP::is_class_loaded($class_name)>
448b6e55 940
15ab5451 941Returns a boolean indicating whether or not C<$class_name> has been
942loaded.
448b6e55 943
828ecf13 944This does a basic check of the symbol table to try and determine as
945best it can if the C<$class_name> is loaded, it is probably correct
946about 99% of the time, but it can be fooled into reporting false
9d441c23 947positives. In particular, loading any of the core L<IO> modules will
948cause most of the rest of the core L<IO> modules to falsely report
949having been loaded, due to the way the base L<IO> module works.
448b6e55 950
cdac22cc 951=item B<Class::MOP::get_code_info($code)>
952
953This function returns two values, the name of the package the C<$code>
954is from and the name of the C<$code> itself. This is used by several
5b60bf98 955elements of the MOP to determine where a given C<$code> reference is
cdac22cc 956from.
957
44ba77a3 958=item B<Class::MOP::class_of($instance_or_class_name)>
959
3fa5b3f9 960This will return the metaclass of the given instance or class name. If the
961class lacks a metaclass, no metaclass will be initialized, and C<undef> will be
962returned.
44ba77a3 963
828ecf13 964=item B<Class::MOP::check_package_cache_flag($pkg)>
e0e4674a 965
bd07fbdb 966B<NOTE: DO NOT USE THIS FUNCTION, IT IS FOR INTERNAL USE ONLY!>
967
828ecf13 968This will return an integer that is managed by L<Class::MOP::Class> to
969determine if a module's symbol table has been altered.
127d39a7 970
828ecf13 971In Perl 5.10 or greater, this flag is package specific. However in
972versions prior to 5.10, this will use the C<PL_sub_generation>
973variable which is not package specific.
127d39a7 974
828ecf13 975=item B<Class::MOP::load_first_existing_class(@class_names)>
063ad0c5 976
977B<NOTE: DO NOT USE THIS FUNCTION, IT IS FOR INTERNAL USE ONLY!>
978
979Given a list of class names, this function will attempt to load each
980one in turn.
981
828ecf13 982If it finds a class it can load, it will return that class' name. If
983none of the classes can be loaded, it will throw an exception.
063ad0c5 984
448b6e55 985=back
986
987=head2 Metaclass cache functions
988
6c842677 989Class::MOP holds a cache of metaclasses. The following are functions
1d68af04 990(B<not methods>) which can be used to access that cache. It is not
6c842677 991recommended that you mess with these. Bad things could happen, but if
992you are brave and willing to risk it: go for it!
be7677c7 993
994=over 4
995
828ecf13 996=item B<Class::MOP::get_all_metaclasses>
be7677c7 997
6c842677 998This will return a hash of all the metaclass instances that have
828ecf13 999been cached by L<Class::MOP::Class>, keyed by the package name.
b9d9fc0b 1000
828ecf13 1001=item B<Class::MOP::get_all_metaclass_instances>
be7677c7 1002
6c842677 1003This will return a list of all the metaclass instances that have
828ecf13 1004been cached by L<Class::MOP::Class>.
b9d9fc0b 1005
828ecf13 1006=item B<Class::MOP::get_all_metaclass_names>
be7677c7 1007
6c842677 1008This will return a list of all the metaclass names that have
828ecf13 1009been cached by L<Class::MOP::Class>.
b9d9fc0b 1010
828ecf13 1011=item B<Class::MOP::get_metaclass_by_name($name)>
be7677c7 1012
828ecf13 1013This will return a cached L<Class::MOP::Class> instance, or nothing
6c842677 1014if no metaclass exists with that C<$name>.
127d39a7 1015
828ecf13 1016=item B<Class::MOP::store_metaclass_by_name($name, $meta)>
be7677c7 1017
127d39a7 1018This will store a metaclass in the cache at the supplied C<$key>.
1019
828ecf13 1020=item B<Class::MOP::weaken_metaclass($name)>
be7677c7 1021
6c842677 1022In rare cases (e.g. anonymous metaclasses) it is desirable to
1023store a weakened reference in the metaclass cache. This
1024function will weaken the reference to the metaclass stored
1025in C<$name>.
127d39a7 1026
828ecf13 1027=item B<Class::MOP::does_metaclass_exist($name)>
be7677c7 1028
828ecf13 1029This will return true of there exists a metaclass stored in the
6c842677 1030C<$name> key, and return false otherwise.
127d39a7 1031
828ecf13 1032=item B<Class::MOP::remove_metaclass_by_name($name)>
be7677c7 1033
6c842677 1034This will remove the metaclass stored in the C<$name> key.
127d39a7 1035
be7677c7 1036=back
1037
552e3d24 1038=head1 SEE ALSO
8b978dd5 1039
552e3d24 1040=head2 Books
8b978dd5 1041
1d68af04 1042There are very few books out on Meta Object Protocols and Metaclasses
1043because it is such an esoteric topic. The following books are really
1044the only ones I have found. If you know of any more, B<I<please>>
a2e85e6c 1045email me and let me know, I would love to hear about them.
1046
8b978dd5 1047=over 4
1048
15ab5451 1049=item I<The Art of the Meta Object Protocol>
8b978dd5 1050
15ab5451 1051=item I<Advances in Object-Oriented Metalevel Architecture and Reflection>
8b978dd5 1052
15ab5451 1053=item I<Putting MetaClasses to Work>
b51af7f9 1054
15ab5451 1055=item I<Smalltalk: The Language>
a2e85e6c 1056
94b19069 1057=back
1058
550d56db 1059=head2 Papers
1060
1061=over 4
1062
15ab5451 1063=item "Uniform and safe metaclass composition"
550d56db 1064
1d68af04 1065An excellent paper by the people who brought us the original Traits paper.
1066This paper is on how Traits can be used to do safe metaclass composition,
1067and offers an excellent introduction section which delves into the topic of
550d56db 1068metaclass compatibility.
1069
1070L<http://www.iam.unibe.ch/~scg/Archive/Papers/Duca05ySafeMetaclassTrait.pdf>
1071
15ab5451 1072=item "Safe Metaclass Programming"
550d56db 1073
1d68af04 1074This paper seems to precede the above paper, and propose a mix-in based
1075approach as opposed to the Traits based approach. Both papers have similar
1076information on the metaclass compatibility problem space.
550d56db 1077
1078L<http://citeseer.ist.psu.edu/37617.html>
1079
1080=back
1081
552e3d24 1082=head2 Prior Art
8b978dd5 1083
1084=over 4
1085
7184ca14 1086=item The Perl 6 MetaModel work in the Pugs project
8b978dd5 1087
1088=over 4
1089
552e3d24 1090=item L<http://svn.openfoundry.org/pugs/perl5/Perl6-MetaModel>
8b978dd5 1091
552e3d24 1092=item L<http://svn.openfoundry.org/pugs/perl5/Perl6-ObjectSpace>
8b978dd5 1093
1094=back
1095
94b19069 1096=back
1097
1d68af04 1098=head2 Articles
f8dfcfb7 1099
1100=over 4
1101
1d68af04 1102=item CPAN Module Review of Class::MOP
f8dfcfb7 1103
1104L<http://www.oreillynet.com/onlamp/blog/2006/06/cpan_module_review_classmop.html>
1105
1106=back
1107
a2e85e6c 1108=head1 SIMILAR MODULES
1109
1d68af04 1110As I have said above, this module is a class-builder-builder, so it is
1111not the same thing as modules like L<Class::Accessor> and
1112L<Class::MethodMaker>. That being said there are very few modules on CPAN
1113with similar goals to this module. The one I have found which is most
1114like this module is L<Class::Meta>, although it's philosophy and the MOP it
1115creates are very different from this modules.
94b19069 1116
a2e85e6c 1117=head1 BUGS
1118
1d68af04 1119All complex software has bugs lurking in it, and this module is no
53702399 1120exception.
1121
1122Please report any bugs to C<bug-class-mop@rt.cpan.org>, or through the
1123web interface at L<http://rt.cpan.org>.
1124
1125You can also discuss feature requests or possible bugs on the Moose
1126mailing list (moose@perl.org) or on IRC at
1127L<irc://irc.perl.org/#moose>.
a2e85e6c 1128
1129=head1 ACKNOWLEDGEMENTS
1130
1131=over 4
1132
b9d9fc0b 1133=item Rob Kinyon
a2e85e6c 1134
1d68af04 1135Thanks to Rob for actually getting the development of this module kick-started.
a2e85e6c 1136
1137=back
1138
1a09d9cc 1139=head1 AUTHORS
94b19069 1140
a2e85e6c 1141Stevan Little E<lt>stevan@iinteractive.comE<gt>
552e3d24 1142
9c8cda90 1143B<with contributions from:>
1144
1145Brandon (blblack) Black
1146
4f116037 1147Florian (rafl) Ragwitz
1148
9c8cda90 1149Guillermo (groditi) Roditi
1150
53702399 1151Dave (autarch) Rolsky
1152
9195ddff 1153Matt (mst) Trout
1154
9c8cda90 1155Rob (robkinyon) Kinyon
1156
1157Yuval (nothingmuch) Kogman
1a09d9cc 1158
f430cfa4 1159Scott (konobi) McWhirter
1160
20f5ccef 1161Dylan Hardison
1162
94b19069 1163=head1 COPYRIGHT AND LICENSE
1164
070bb6c9 1165Copyright 2006-2009 by Infinity Interactive, Inc.
94b19069 1166
1167L<http://www.iinteractive.com>
1168
1169This library is free software; you can redistribute it and/or modify
1d68af04 1170it under the same terms as Perl itself.
94b19069 1171
1172=cut