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