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