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