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