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