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