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