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