bump the version so I can make svn Moose require this version
[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
28fa06b5 34our $VERSION = '0.78';
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(
77373da8 391 Class::MOP::Attribute->new('wrapped_method_metaclass' => (
392 reader => {
393 # NOTE:
394 # we just alias the original method
395 # rather than re-produce it here
396 'wrapped_method_metaclass' => \&Class::MOP::Class::wrapped_method_metaclass
397 },
398 default => 'Class::MOP::Method::Wrapped',
399 ))
400);
401
402Class::MOP::Class->meta->add_attribute(
8683db0e 403 Class::MOP::Attribute->new('instance_metaclass' => (
b880e0de 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 'instance_metaclass' => \&Class::MOP::Class::instance_metaclass
b880e0de 412 },
1d68af04 413 default => 'Class::MOP::Instance',
2bab2be6 414 ))
415);
416
9d6dce77 417# NOTE:
1d68af04 418# we don't actually need to tie the knot with
419# Class::MOP::Class here, it is actually handled
420# within Class::MOP::Class itself in the
421# construct_class_instance method.
9d6dce77 422
f0480c45 423## --------------------------------------------------------
727919c5 424## Class::MOP::Attribute
425
7b31baf4 426Class::MOP::Attribute->meta->add_attribute(
8683db0e 427 Class::MOP::Attribute->new('name' => (
c23184fc 428 reader => {
1d68af04 429 # NOTE: we need to do this in order
430 # for the instance meta-object to
431 # not fall into meta-circular death
432 #
ce2ae40f 433 # we just alias the original method
1d68af04 434 # rather than re-produce it here
ce2ae40f 435 'name' => \&Class::MOP::Attribute::name
b880e0de 436 }
7b31baf4 437 ))
438);
439
440Class::MOP::Attribute->meta->add_attribute(
8683db0e 441 Class::MOP::Attribute->new('associated_class' => (
c23184fc 442 reader => {
1d68af04 443 # NOTE: we need to do this in order
444 # for the instance meta-object to
445 # not fall into meta-circular death
446 #
ce2ae40f 447 # we just alias the original method
1d68af04 448 # rather than re-produce it here
ce2ae40f 449 'associated_class' => \&Class::MOP::Attribute::associated_class
b880e0de 450 }
7b31baf4 451 ))
452);
453
454Class::MOP::Attribute->meta->add_attribute(
8683db0e 455 Class::MOP::Attribute->new('accessor' => (
6d2118a4 456 reader => { 'accessor' => \&Class::MOP::Attribute::accessor },
457 predicate => { 'has_accessor' => \&Class::MOP::Attribute::has_accessor },
7b31baf4 458 ))
459);
460
461Class::MOP::Attribute->meta->add_attribute(
8683db0e 462 Class::MOP::Attribute->new('reader' => (
6d2118a4 463 reader => { 'reader' => \&Class::MOP::Attribute::reader },
464 predicate => { 'has_reader' => \&Class::MOP::Attribute::has_reader },
7b31baf4 465 ))
466);
467
468Class::MOP::Attribute->meta->add_attribute(
8683db0e 469 Class::MOP::Attribute->new('initializer' => (
8ee74136 470 reader => { 'initializer' => \&Class::MOP::Attribute::initializer },
471 predicate => { 'has_initializer' => \&Class::MOP::Attribute::has_initializer },
0ab65f99 472 ))
473);
474
475Class::MOP::Attribute->meta->add_attribute(
d9d99689 476 Class::MOP::Attribute->new('definition_context' => (
477 reader => { 'definition_context' => \&Class::MOP::Attribute::definition_context },
478 ))
479);
480
481Class::MOP::Attribute->meta->add_attribute(
8683db0e 482 Class::MOP::Attribute->new('writer' => (
6d2118a4 483 reader => { 'writer' => \&Class::MOP::Attribute::writer },
484 predicate => { 'has_writer' => \&Class::MOP::Attribute::has_writer },
7b31baf4 485 ))
486);
487
488Class::MOP::Attribute->meta->add_attribute(
8683db0e 489 Class::MOP::Attribute->new('predicate' => (
6d2118a4 490 reader => { 'predicate' => \&Class::MOP::Attribute::predicate },
491 predicate => { 'has_predicate' => \&Class::MOP::Attribute::has_predicate },
7b31baf4 492 ))
493);
494
495Class::MOP::Attribute->meta->add_attribute(
8683db0e 496 Class::MOP::Attribute->new('clearer' => (
6d2118a4 497 reader => { 'clearer' => \&Class::MOP::Attribute::clearer },
498 predicate => { 'has_clearer' => \&Class::MOP::Attribute::has_clearer },
7d28758b 499 ))
500);
501
502Class::MOP::Attribute->meta->add_attribute(
8683db0e 503 Class::MOP::Attribute->new('builder' => (
1d68af04 504 reader => { 'builder' => \&Class::MOP::Attribute::builder },
505 predicate => { 'has_builder' => \&Class::MOP::Attribute::has_builder },
506 ))
507);
508
509Class::MOP::Attribute->meta->add_attribute(
8683db0e 510 Class::MOP::Attribute->new('init_arg' => (
6d2118a4 511 reader => { 'init_arg' => \&Class::MOP::Attribute::init_arg },
512 predicate => { 'has_init_arg' => \&Class::MOP::Attribute::has_init_arg },
7b31baf4 513 ))
514);
515
516Class::MOP::Attribute->meta->add_attribute(
8683db0e 517 Class::MOP::Attribute->new('default' => (
7b31baf4 518 # default has a custom 'reader' method ...
1d68af04 519 predicate => { 'has_default' => \&Class::MOP::Attribute::has_default },
7b31baf4 520 ))
521);
522
3545c727 523Class::MOP::Attribute->meta->add_attribute(
8683db0e 524 Class::MOP::Attribute->new('associated_methods' => (
c23184fc 525 reader => { 'associated_methods' => \&Class::MOP::Attribute::associated_methods },
1d68af04 526 default => sub { [] }
3545c727 527 ))
528);
727919c5 529
5659d76e 530Class::MOP::Attribute->meta->add_method('clone' => sub {
a740253a 531 my $self = shift;
1d68af04 532 $self->meta->clone_object($self, @_);
727919c5 533});
534
f0480c45 535## --------------------------------------------------------
b6164407 536## Class::MOP::Method
b6164407 537Class::MOP::Method->meta->add_attribute(
8683db0e 538 Class::MOP::Attribute->new('body' => (
c23184fc 539 reader => { 'body' => \&Class::MOP::Method::body },
b6164407 540 ))
541);
542
4c105333 543Class::MOP::Method->meta->add_attribute(
5e607260 544 Class::MOP::Attribute->new('associated_metaclass' => (
5e607260 545 reader => { 'associated_metaclass' => \&Class::MOP::Method::associated_metaclass },
546 ))
547);
548
549Class::MOP::Method->meta->add_attribute(
8683db0e 550 Class::MOP::Attribute->new('package_name' => (
4c105333 551 reader => { 'package_name' => \&Class::MOP::Method::package_name },
552 ))
553);
554
555Class::MOP::Method->meta->add_attribute(
8683db0e 556 Class::MOP::Attribute->new('name' => (
4c105333 557 reader => { 'name' => \&Class::MOP::Method::name },
558 ))
559);
560
2226a8b0 561Class::MOP::Method->meta->add_attribute(
562 Class::MOP::Attribute->new('original_method' => (
563 reader => { 'original_method' => \&Class::MOP::Method::original_method },
564 writer => { '_set_original_method' => \&Class::MOP::Method::_set_original_method },
565 ))
566);
567
4c105333 568Class::MOP::Method->meta->add_method('clone' => sub {
569 my $self = shift;
2226a8b0 570 my $clone = $self->meta->clone_object($self, @_);
571 $clone->_set_original_method($self);
572 return $clone;
4c105333 573});
574
b6164407 575## --------------------------------------------------------
576## Class::MOP::Method::Wrapped
577
578# NOTE:
1d68af04 579# the way this item is initialized, this
580# really does not follow the standard
581# practices of attributes, but we put
b6164407 582# it here for completeness
583Class::MOP::Method::Wrapped->meta->add_attribute(
8683db0e 584 Class::MOP::Attribute->new('modifier_table')
b6164407 585);
586
587## --------------------------------------------------------
565f0cbb 588## Class::MOP::Method::Generated
589
590Class::MOP::Method::Generated->meta->add_attribute(
8683db0e 591 Class::MOP::Attribute->new('is_inline' => (
565f0cbb 592 reader => { 'is_inline' => \&Class::MOP::Method::Generated::is_inline },
4c105333 593 default => 0,
1d68af04 594 ))
565f0cbb 595);
596
d9d99689 597Class::MOP::Method::Generated->meta->add_attribute(
598 Class::MOP::Attribute->new('definition_context' => (
599 reader => { 'definition_context' => \&Class::MOP::Method::Generated::definition_context },
600 ))
601);
602
565f0cbb 603## --------------------------------------------------------
d90b42a6 604## Class::MOP::Method::Accessor
605
606Class::MOP::Method::Accessor->meta->add_attribute(
8683db0e 607 Class::MOP::Attribute->new('attribute' => (
1d68af04 608 reader => {
609 'associated_attribute' => \&Class::MOP::Method::Accessor::associated_attribute
d90b42a6 610 },
1d68af04 611 ))
d90b42a6 612);
613
614Class::MOP::Method::Accessor->meta->add_attribute(
8683db0e 615 Class::MOP::Attribute->new('accessor_type' => (
c23184fc 616 reader => { 'accessor_type' => \&Class::MOP::Method::Accessor::accessor_type },
1d68af04 617 ))
d90b42a6 618);
619
d90b42a6 620## --------------------------------------------------------
621## Class::MOP::Method::Constructor
622
623Class::MOP::Method::Constructor->meta->add_attribute(
8683db0e 624 Class::MOP::Attribute->new('options' => (
1d68af04 625 reader => {
626 'options' => \&Class::MOP::Method::Constructor::options
d90b42a6 627 },
4c105333 628 default => sub { +{} }
1d68af04 629 ))
d90b42a6 630);
631
632Class::MOP::Method::Constructor->meta->add_attribute(
8683db0e 633 Class::MOP::Attribute->new('associated_metaclass' => (
e8a38403 634 init_arg => "metaclass", # FIXME alias and rename
1d68af04 635 reader => {
636 'associated_metaclass' => \&Class::MOP::Method::Constructor::associated_metaclass
637 },
638 ))
d90b42a6 639);
640
641## --------------------------------------------------------
86482605 642## Class::MOP::Instance
643
644# NOTE:
1d68af04 645# these don't yet do much of anything, but are just
86482605 646# included for completeness
647
648Class::MOP::Instance->meta->add_attribute(
74890687 649 Class::MOP::Attribute->new('associated_metaclass',
650 reader => { associated_metaclass => \&Class::MOP::Instance::associated_metaclass },
651 ),
86482605 652);
653
654Class::MOP::Instance->meta->add_attribute(
74890687 655 Class::MOP::Attribute->new('_class_name',
656 init_arg => undef,
657 reader => { _class_name => \&Class::MOP::Instance::_class_name },
658 #lazy => 1, # not yet supported by Class::MOP but out our version does it anyway
659 #default => sub { $_[0]->associated_metaclass->name },
660 ),
661);
662
663Class::MOP::Instance->meta->add_attribute(
664 Class::MOP::Attribute->new('attributes',
0b5d46da 665 reader => { attributes => \&Class::MOP::Instance::get_all_attributes },
74890687 666 ),
32bfc810 667);
668
669Class::MOP::Instance->meta->add_attribute(
74890687 670 Class::MOP::Attribute->new('slots',
671 reader => { slots => \&Class::MOP::Instance::slots },
672 ),
86482605 673);
674
63d08a9e 675Class::MOP::Instance->meta->add_attribute(
74890687 676 Class::MOP::Attribute->new('slot_hash',
677 reader => { slot_hash => \&Class::MOP::Instance::slot_hash },
678 ),
63d08a9e 679);
680
681
caa051fa 682# we need the meta instance of the meta instance to be created now, in order
683# for the constructor to be able to use it
684Class::MOP::Instance->meta->get_meta_instance;
685
caa051fa 686# pretend the add_method never happenned. it hasn't yet affected anything
687undef Class::MOP::Instance->meta->{_package_cache_flag};
688
86482605 689## --------------------------------------------------------
f0480c45 690## Now close all the Class::MOP::* classes
4d47b77f 691
1aa13cf4 692# NOTE: we don't need to inline the the accessors this only lengthens
693# the compile time of the MOP, and gives us no actual benefits.
0b9372a2 694
695$_->meta->make_immutable(
6c2f6b5c 696 inline_constructor => 1,
697 replace_constructor => 1,
698 constructor_name => "_new",
45582002 699 inline_accessors => 0,
0b9372a2 700) for qw/
1d68af04 701 Class::MOP::Package
702 Class::MOP::Module
703 Class::MOP::Class
704
0b9372a2 705 Class::MOP::Attribute
1d68af04 706 Class::MOP::Method
707 Class::MOP::Instance
708
709 Class::MOP::Object
0b9372a2 710
565f0cbb 711 Class::MOP::Method::Generated
1d68af04 712
ba38bf08 713 Class::MOP::Method::Accessor
1d68af04 714 Class::MOP::Method::Constructor
715 Class::MOP::Method::Wrapped
0b9372a2 716/;
b6164407 717
94b19069 7181;
719
720__END__
721
722=pod
723
1d68af04 724=head1 NAME
94b19069 725
726Class::MOP - A Meta Object Protocol for Perl 5
727
94b19069 728=head1 DESCRIPTON
729
127d39a7 730This module is a fully functioning meta object protocol for the
1d68af04 731Perl 5 object system. It makes no attempt to change the behavior or
732characteristics of the Perl 5 object system, only to create a
27e31eaf 733protocol for its manipulation and introspection.
94b19069 734
1d68af04 735That said, it does attempt to create the tools for building a rich
736set of extensions to the Perl 5 object system. Every attempt has been
737made for these tools to keep to the spirit of the Perl 5 object
94b19069 738system that we all know and love.
739
1d68af04 740This documentation is admittedly sparse on details, as time permits
741I will try to improve them. For now, I suggest looking at the items
742listed in the L<SEE ALSO> section for more information. In particular
743the book "The Art of the Meta Object Protocol" was very influential
40483095 744in the development of this system.
745
bfe4d0fc 746=head2 What is a Meta Object Protocol?
747
1d68af04 748A meta object protocol is an API to an object system.
bfe4d0fc 749
1d68af04 750To be more specific, it is a set of abstractions of the components of
751an object system (typically things like; classes, object, methods,
752object attributes, etc.). These abstractions can then be used to both
bfe4d0fc 753inspect and manipulate the object system which they describe.
754
1d68af04 755It can be said that there are two MOPs for any object system; the
756implicit MOP, and the explicit MOP. The implicit MOP handles things
757like method dispatch or inheritance, which happen automatically as
758part of how the object system works. The explicit MOP typically
759handles the introspection/reflection features of the object system.
760All object systems have implicit MOPs, without one, they would not
761work. Explict MOPs however as less common, and depending on the
762language can vary from restrictive (Reflection in Java or C#) to
763wide open (CLOS is a perfect example).
bfe4d0fc 764
e16da3e6 765=head2 Yet Another Class Builder!! Why?
766
1d68af04 767This is B<not> a class builder so much as it is a I<class builder
768B<builder>>. My intent is that an end user does not use this module
769directly, but instead this module is used by module authors to
770build extensions and features onto the Perl 5 object system.
e16da3e6 771
94b19069 772=head2 Who is this module for?
773
1d68af04 774This module is specifically for anyone who has ever created or
775wanted to create a module for the Class:: namespace. The tools which
776this module will provide will hopefully make it easier to do more
777complex things with Perl 5 classes by removing such barriers as
778the need to hack the symbol tables, or understand the fine details
779of method dispatch.
94b19069 780
bfe4d0fc 781=head2 What changes do I have to make to use this module?
782
1d68af04 783This module was designed to be as unintrusive as possible. Many of
784its features are accessible without B<any> change to your existsing
785code at all. It is meant to be a compliment to your existing code and
786not an intrusion on your code base. Unlike many other B<Class::>
787modules, this module B<does not> require you subclass it, or even that
788you C<use> it in within your module's package.
bfe4d0fc 789
1d68af04 790The only features which requires additions to your code are the
2eb717d5 791attribute handling and instance construction features, and these are
1d68af04 792both completely optional features. The only reason for this is because
793Perl 5's object system does not actually have these features built
2eb717d5 794in. More information about this feature can be found below.
bfe4d0fc 795
796=head2 A Note about Performance?
797
1d68af04 798It is a common misconception that explict MOPs are performance drains.
799But this is not a universal truth at all, it is an side-effect of
800specific implementations. For instance, using Java reflection is much
801slower because the JVM cannot take advantage of any compiler
802optimizations, and the JVM has to deal with much more runtime type
803information as well. Reflection in C# is marginally better as it was
804designed into the language and runtime (the CLR). In contrast, CLOS
805(the Common Lisp Object System) was built to support an explicit MOP,
806and so performance is tuned for it.
807
808This library in particular does it's absolute best to avoid putting
809B<any> drain at all upon your code's performance. In fact, by itself
810it does nothing to affect your existing code. So you only pay for
2eb717d5 811what you actually use.
bfe4d0fc 812
550d56db 813=head2 About Metaclass compatibility
814
1d68af04 815This module makes sure that all metaclasses created are both upwards
816and downwards compatible. The topic of metaclass compatibility is
817highly esoteric and is something only encountered when doing deep and
818involved metaclass hacking. There are two basic kinds of metaclass
819incompatibility; upwards and downwards.
550d56db 820
1d68af04 821Upwards metaclass compatibility means that the metaclass of a
822given class is either the same as (or a subclass of) all of the
550d56db 823class's ancestors.
824
1d68af04 825Downward metaclass compatibility means that the metaclasses of a
826given class's anscestors are all either the same as (or a subclass
550d56db 827of) that metaclass.
828
1d68af04 829Here is a diagram showing a set of two classes (C<A> and C<B>) and
830two metaclasses (C<Meta::A> and C<Meta::B>) which have correct
550d56db 831metaclass compatibility both upwards and downwards.
832
833 +---------+ +---------+
834 | Meta::A |<----| Meta::B | <....... (instance of )
1d68af04 835 +---------+ +---------+ <------- (inherits from)
550d56db 836 ^ ^
837 : :
838 +---------+ +---------+
839 | A |<----| B |
840 +---------+ +---------+
841
1d68af04 842As I said this is a highly esoteric topic and one you will only run
843into if you do a lot of subclassing of B<Class::MOP::Class>. If you
844are interested in why this is an issue see the paper
845I<Uniform and safe metaclass composition> linked to in the
550d56db 846L<SEE ALSO> section of this document.
847
aa448b16 848=head2 Using custom metaclasses
849
1d68af04 850Always use the metaclass pragma when using a custom metaclass, this
851will ensure the proper initialization order and not accidentely
852create an incorrect type of metaclass for you. This is a very rare
853problem, and one which can only occur if you are doing deep metaclass
aa448b16 854programming. So in other words, don't worry about it.
855
94b19069 856=head1 PROTOCOLS
857
127d39a7 858The protocol is divided into 4 main sub-protocols:
94b19069 859
860=over 4
861
862=item The Class protocol
863
1d68af04 864This provides a means of manipulating and introspecting a Perl 5
865class. It handles all of symbol table hacking for you, and provides
94b19069 866a rich set of methods that go beyond simple package introspection.
867
552e3d24 868See L<Class::MOP::Class> for more details.
869
94b19069 870=item The Attribute protocol
871
1d68af04 872This provides a consistent represenation for an attribute of a
873Perl 5 class. Since there are so many ways to create and handle
127d39a7 874attributes in Perl 5 OO, this attempts to provide as much of a
1d68af04 875unified approach as possible, while giving the freedom and
94b19069 876flexibility to subclass for specialization.
877
552e3d24 878See L<Class::MOP::Attribute> for more details.
879
94b19069 880=item The Method protocol
881
1d68af04 882This provides a means of manipulating and introspecting methods in
883the Perl 5 object system. As with attributes, there are many ways to
884approach this topic, so we try to keep it pretty basic, while still
94b19069 885making it possible to extend the system in many ways.
886
552e3d24 887See L<Class::MOP::Method> for more details.
94b19069 888
127d39a7 889=item The Instance protocol
890
891This provides a layer of abstraction for creating object instances.
892Since the other layers use this protocol, it is relatively easy to
893change the type of your instances from the default HASH ref to other
894types of references. Several examples are provided in the F<examples/>
895directory included in this distribution.
896
897See L<Class::MOP::Instance> for more details.
898
94b19069 899=back
900
be7677c7 901=head1 FUNCTIONS
902
c1d5345a 903=head2 Constants
904
905=over 4
906
907=item I<IS_RUNNING_ON_5_10>
908
909We set this constant depending on what version perl we are on, this
910allows us to take advantage of new 5.10 features and stay backwards
911compat.
912
9efe16ca 913=item I<HAVE_ISAREV>
914
915Whether or not C<mro> provides C<get_isarev>, a much faster way to get all the
916subclasses of a certain class.
917
1f6240bf 918=item I<USING_XS>
919
920Whether or not the running C<Class::MOP> is using its XS version.
921
c1d5345a 922=back
923
448b6e55 924=head2 Utility functions
925
bd07fbdb 926Note that these are all called as B<functions, not methods>.
081a927b 927
448b6e55 928=over 4
929
930=item B<load_class ($class_name)>
931
1d68af04 932This will load a given C<$class_name> and if it does not have an
448b6e55 933already initialized metaclass, then it will intialize one for it.
127d39a7 934This function can be used in place of tricks like
935C<eval "use $module"> or using C<require>.
448b6e55 936
937=item B<is_class_loaded ($class_name)>
938
1d68af04 939This will return a boolean depending on if the C<$class_name> has
940been loaded.
448b6e55 941
1d68af04 942NOTE: This does a basic check of the symbol table to try and
448b6e55 943determine as best it can if the C<$class_name> is loaded, it
1d68af04 944is probably correct about 99% of the time.
448b6e55 945
b1f5f41d 946=item B<check_package_cache_flag ($pkg)>
e0e4674a 947
bd07fbdb 948B<NOTE: DO NOT USE THIS FUNCTION, IT IS FOR INTERNAL USE ONLY!>
949
127d39a7 950This will return an integer that is managed by C<Class::MOP::Class>
951to determine if a module's symbol table has been altered.
952
953In Perl 5.10 or greater, this flag is package specific. However in
954versions prior to 5.10, this will use the C<PL_sub_generation> variable
955which is not package specific.
956
e0e4674a 957=item B<get_code_info ($code)>
958
bd07fbdb 959B<NOTE: DO NOT USE THIS FUNCTION, IT IS FOR INTERNAL USE ONLY!>
960
127d39a7 961This function returns two values, the name of the package the C<$code>
962is from and the name of the C<$code> itself. This is used by several
963elements of the MOP to detemine where a given C<$code> reference is from.
964
4c105333 965=item B<subname ($name, $code)>
966
967B<NOTE: DO NOT USE THIS FUNCTION, IT IS FOR INTERNAL USE ONLY!>
968
969If possible, we will load the L<Sub::Name> module and this will function
970as C<Sub::Name::subname> does, otherwise it will just return the C<$code>
971argument.
972
6f49cf3f 973=item B<in_global_destruction>
974
bd07fbdb 975B<NOTE: DO NOT USE THIS FUNCTION, IT IS FOR INTERNAL USE ONLY!>
976
6f49cf3f 977If L<Devel::GlobalDestruction> is available, this returns true under global
978destruction.
979
980Otherwise it's a constant returning false.
981
063ad0c5 982=item B<load_first_existing_class ($class_name, [$class_name, ...])>
983
984B<NOTE: DO NOT USE THIS FUNCTION, IT IS FOR INTERNAL USE ONLY!>
985
986Given a list of class names, this function will attempt to load each
987one in turn.
988
1d8153bd 989If it finds a class it can load, it will return that class' name.
990If none of the classes can be loaded, it will throw an exception.
063ad0c5 991
448b6e55 992=back
993
994=head2 Metaclass cache functions
995
6c842677 996Class::MOP holds a cache of metaclasses. The following are functions
1d68af04 997(B<not methods>) which can be used to access that cache. It is not
6c842677 998recommended that you mess with these. Bad things could happen, but if
999you are brave and willing to risk it: go for it!
be7677c7 1000
1001=over 4
1002
1003=item B<get_all_metaclasses>
1004
6c842677 1005This will return a hash of all the metaclass instances that have
1006been cached by B<Class::MOP::Class>, keyed by the package name.
b9d9fc0b 1007
be7677c7 1008=item B<get_all_metaclass_instances>
1009
6c842677 1010This will return a list of all the metaclass instances that have
b9d9fc0b 1011been cached by B<Class::MOP::Class>.
1012
be7677c7 1013=item B<get_all_metaclass_names>
1014
6c842677 1015This will return a list of all the metaclass names that have
b9d9fc0b 1016been cached by B<Class::MOP::Class>.
1017
be7677c7 1018=item B<get_metaclass_by_name ($name)>
1019
e5ca9cbb 1020This will return a cached B<Class::MOP::Class> instance, or nothing
6c842677 1021if no metaclass exists with that C<$name>.
127d39a7 1022
be7677c7 1023=item B<store_metaclass_by_name ($name, $meta)>
1024
127d39a7 1025This will store a metaclass in the cache at the supplied C<$key>.
1026
be7677c7 1027=item B<weaken_metaclass ($name)>
1028
6c842677 1029In rare cases (e.g. anonymous metaclasses) it is desirable to
1030store a weakened reference in the metaclass cache. This
1031function will weaken the reference to the metaclass stored
1032in C<$name>.
127d39a7 1033
be7677c7 1034=item B<does_metaclass_exist ($name)>
1035
127d39a7 1036This will return true of there exists a metaclass stored in the
6c842677 1037C<$name> key, and return false otherwise.
127d39a7 1038
be7677c7 1039=item B<remove_metaclass_by_name ($name)>
1040
6c842677 1041This will remove the metaclass stored in the C<$name> key.
127d39a7 1042
be7677c7 1043=back
1044
552e3d24 1045=head1 SEE ALSO
8b978dd5 1046
552e3d24 1047=head2 Books
8b978dd5 1048
1d68af04 1049There are very few books out on Meta Object Protocols and Metaclasses
1050because it is such an esoteric topic. The following books are really
1051the only ones I have found. If you know of any more, B<I<please>>
a2e85e6c 1052email me and let me know, I would love to hear about them.
1053
8b978dd5 1054=over 4
1055
552e3d24 1056=item "The Art of the Meta Object Protocol"
8b978dd5 1057
552e3d24 1058=item "Advances in Object-Oriented Metalevel Architecture and Reflection"
8b978dd5 1059
b51af7f9 1060=item "Putting MetaClasses to Work"
1061
a2e85e6c 1062=item "Smalltalk: The Language"
1063
94b19069 1064=back
1065
550d56db 1066=head2 Papers
1067
1068=over 4
1069
1070=item Uniform and safe metaclass composition
1071
1d68af04 1072An excellent paper by the people who brought us the original Traits paper.
1073This paper is on how Traits can be used to do safe metaclass composition,
1074and offers an excellent introduction section which delves into the topic of
550d56db 1075metaclass compatibility.
1076
1077L<http://www.iam.unibe.ch/~scg/Archive/Papers/Duca05ySafeMetaclassTrait.pdf>
1078
1079=item Safe Metaclass Programming
1080
1d68af04 1081This paper seems to precede the above paper, and propose a mix-in based
1082approach as opposed to the Traits based approach. Both papers have similar
1083information on the metaclass compatibility problem space.
550d56db 1084
1085L<http://citeseer.ist.psu.edu/37617.html>
1086
1087=back
1088
552e3d24 1089=head2 Prior Art
8b978dd5 1090
1091=over 4
1092
7184ca14 1093=item The Perl 6 MetaModel work in the Pugs project
8b978dd5 1094
1095=over 4
1096
552e3d24 1097=item L<http://svn.openfoundry.org/pugs/perl5/Perl6-MetaModel>
8b978dd5 1098
552e3d24 1099=item L<http://svn.openfoundry.org/pugs/perl5/Perl6-ObjectSpace>
8b978dd5 1100
1101=back
1102
94b19069 1103=back
1104
1d68af04 1105=head2 Articles
f8dfcfb7 1106
1107=over 4
1108
1d68af04 1109=item CPAN Module Review of Class::MOP
f8dfcfb7 1110
1111L<http://www.oreillynet.com/onlamp/blog/2006/06/cpan_module_review_classmop.html>
1112
1113=back
1114
a2e85e6c 1115=head1 SIMILAR MODULES
1116
1d68af04 1117As I have said above, this module is a class-builder-builder, so it is
1118not the same thing as modules like L<Class::Accessor> and
1119L<Class::MethodMaker>. That being said there are very few modules on CPAN
1120with similar goals to this module. The one I have found which is most
1121like this module is L<Class::Meta>, although it's philosophy and the MOP it
1122creates are very different from this modules.
94b19069 1123
a2e85e6c 1124=head1 BUGS
1125
1d68af04 1126All complex software has bugs lurking in it, and this module is no
a2e85e6c 1127exception. If you find a bug please either email me, or add the bug
1128to cpan-RT.
1129
1130=head1 ACKNOWLEDGEMENTS
1131
1132=over 4
1133
b9d9fc0b 1134=item Rob Kinyon
a2e85e6c 1135
1d68af04 1136Thanks to Rob for actually getting the development of this module kick-started.
a2e85e6c 1137
1138=back
1139
1a09d9cc 1140=head1 AUTHORS
94b19069 1141
a2e85e6c 1142Stevan Little E<lt>stevan@iinteractive.comE<gt>
552e3d24 1143
9c8cda90 1144B<with contributions from:>
1145
1146Brandon (blblack) Black
1147
4f116037 1148Florian (rafl) Ragwitz
1149
9c8cda90 1150Guillermo (groditi) Roditi
1151
9195ddff 1152Matt (mst) Trout
1153
9c8cda90 1154Rob (robkinyon) Kinyon
1155
1156Yuval (nothingmuch) Kogman
1a09d9cc 1157
f430cfa4 1158Scott (konobi) McWhirter
1159
94b19069 1160=head1 COPYRIGHT AND LICENSE
1161
69e3ab0a 1162Copyright 2006-2008 by Infinity Interactive, Inc.
94b19069 1163
1164L<http://www.iinteractive.com>
1165
1166This library is free software; you can redistribute it and/or modify
1d68af04 1167it under the same terms as Perl itself.
94b19069 1168
1169=cut