8 use Scalar::Util 'weaken';
10 use Class::MOP::Class;
11 use Class::MOP::Attribute;
12 use Class::MOP::Method;
14 use Class::MOP::Immutable;
16 our $VERSION = '0.43';
17 our $AUTHORITY = 'cpan:STEVAN';
20 # Metaclasses are singletons, so we cache them here.
21 # there is no need to worry about destruction though
22 # because they should die only when the program dies.
23 # After all, do package definitions even get reaped?
26 # means of accessing all the metaclasses that have
27 # been initialized thus far (for mugwumps obj browser)
28 sub get_all_metaclasses { %METAS }
29 sub get_all_metaclass_instances { values %METAS }
30 sub get_all_metaclass_names { keys %METAS }
31 sub get_metaclass_by_name { $METAS{$_[0]} }
32 sub store_metaclass_by_name { $METAS{$_[0]} = $_[1] }
33 sub weaken_metaclass { weaken($METAS{$_[0]}) }
34 sub does_metaclass_exist { exists $METAS{$_[0]} && defined $METAS{$_[0]} }
35 sub remove_metaclass_by_name { $METAS{$_[0]} = undef }
38 # We only cache metaclasses, meaning instances of
39 # Class::MOP::Class. We do not cache instance of
40 # Class::MOP::Package or Class::MOP::Module. Mostly
41 # because I don't yet see a good reason to do so.
46 # see if this is already
47 # loaded in the symbol table
48 return 1 if is_class_loaded($class);
49 # otherwise require it ...
50 my $file = $class . '.pm';
52 eval { CORE::require($file) };
53 confess "Could not load class ($class) because : $@" if $@;
54 unless (does_metaclass_exist($class)) {
55 eval { Class::MOP::Class->initialize($class) };
56 confess "Could not initialize class ($class) because : $@" if $@;
58 1; # return true if it worked
64 return 1 if defined ${"${class}::VERSION"} || defined @{"${class}::ISA"};
65 foreach (keys %{"${class}::"}) {
66 next if substr($_, -2, 2) eq '::';
67 return 1 if defined &{"${class}::$_"};
73 ## ----------------------------------------------------------------------------
74 ## Setting up our environment ...
75 ## ----------------------------------------------------------------------------
76 ## Class::MOP needs to have a few things in the global perl environment so
77 ## that it can operate effectively. Those things are done here.
78 ## ----------------------------------------------------------------------------
80 # ... nothing yet actually ;)
82 ## ----------------------------------------------------------------------------
84 ## ----------------------------------------------------------------------------
85 ## The code below here is to bootstrap our MOP with itself. This is also
86 ## sometimes called "tying the knot". By doing this, we make it much easier
87 ## to extend the MOP through subclassing and such since now you can use the
88 ## MOP itself to extend itself.
90 ## Yes, I know, thats weird and insane, but it's a good thing, trust me :)
91 ## ----------------------------------------------------------------------------
93 # We need to add in the meta-attributes here so that
94 # any subclass of Class::MOP::* will be able to
95 # inherit them using &construct_instance
97 ## --------------------------------------------------------
98 ## Class::MOP::Package
100 Class::MOP::Package->meta->add_attribute(
101 Class::MOP::Attribute->new('$!package' => (
103 # NOTE: we need to do this in order
104 # for the instance meta-object to
105 # not fall into meta-circular death
107 # we just alias the original method
108 # rather than re-produce it here
109 'name' => \&Class::MOP::Package::name
111 init_arg => 'package',
115 Class::MOP::Package->meta->add_attribute(
116 Class::MOP::Attribute->new('%!namespace' => (
119 # we just alias the original method
120 # rather than re-produce it here
121 'namespace' => \&Class::MOP::Package::namespace
124 # protect this from silliness
125 init_arg => '!............( DO NOT DO THIS )............!',
126 default => sub { \undef }
131 # use the metaclass to construct the meta-package
132 # which is a superclass of the metaclass itself :P
133 Class::MOP::Package->meta->add_method('initialize' => sub {
135 my $package_name = shift;
136 $class->meta->new_object('package' => $package_name, @_);
139 ## --------------------------------------------------------
140 ## Class::MOP::Module
143 # yeah this is kind of stretching things a bit,
144 # but truthfully the version should be an attribute
145 # of the Module, the weirdness comes from having to
146 # stick to Perl 5 convention and store it in the
147 # $VERSION package variable. Basically if you just
148 # squint at it, it will look how you want it to look.
149 # Either as a package variable, or as a attribute of
150 # the metaclass, isn't abstraction great :)
152 Class::MOP::Module->meta->add_attribute(
153 Class::MOP::Attribute->new('$!version' => (
156 # we just alias the original method
157 # rather than re-produce it here
158 'version' => \&Class::MOP::Module::version
161 # protect this from silliness
162 init_arg => '!............( DO NOT DO THIS )............!',
163 default => sub { \undef }
168 # By following the same conventions as version here,
169 # we are opening up the possibility that people can
170 # use the $AUTHORITY in non-Class::MOP modules as
173 Class::MOP::Module->meta->add_attribute(
174 Class::MOP::Attribute->new('$!authority' => (
177 # we just alias the original method
178 # rather than re-produce it here
179 'authority' => \&Class::MOP::Module::authority
182 # protect this from silliness
183 init_arg => '!............( DO NOT DO THIS )............!',
184 default => sub { \undef }
188 ## --------------------------------------------------------
191 Class::MOP::Class->meta->add_attribute(
192 Class::MOP::Attribute->new('%!attributes' => (
194 # NOTE: we need to do this in order
195 # for the instance meta-object to
196 # not fall into meta-circular death
198 # we just alias the original method
199 # rather than re-produce it here
200 'get_attribute_map' => \&Class::MOP::Class::get_attribute_map
202 init_arg => 'attributes',
203 default => sub { {} }
207 Class::MOP::Class->meta->add_attribute(
208 Class::MOP::Attribute->new('%!methods' => (
209 init_arg => 'methods',
212 # we just alias the original method
213 # rather than re-produce it here
214 'get_method_map' => \&Class::MOP::Class::get_method_map
216 default => sub { {} }
220 Class::MOP::Class->meta->add_attribute(
221 Class::MOP::Attribute->new('@!superclasses' => (
224 # we just alias the original method
225 # rather than re-produce it here
226 'superclasses' => \&Class::MOP::Class::superclasses
229 # protect this from silliness
230 init_arg => '!............( DO NOT DO THIS )............!',
231 default => sub { \undef }
235 Class::MOP::Class->meta->add_attribute(
236 Class::MOP::Attribute->new('$!attribute_metaclass' => (
239 # we just alias the original method
240 # rather than re-produce it here
241 'attribute_metaclass' => \&Class::MOP::Class::attribute_metaclass
243 init_arg => 'attribute_metaclass',
244 default => 'Class::MOP::Attribute',
248 Class::MOP::Class->meta->add_attribute(
249 Class::MOP::Attribute->new('$!method_metaclass' => (
252 # we just alias the original method
253 # rather than re-produce it here
254 'method_metaclass' => \&Class::MOP::Class::method_metaclass
256 init_arg => 'method_metaclass',
257 default => 'Class::MOP::Method',
261 Class::MOP::Class->meta->add_attribute(
262 Class::MOP::Attribute->new('$!instance_metaclass' => (
264 # NOTE: we need to do this in order
265 # for the instance meta-object to
266 # not fall into meta-circular death
268 # we just alias the original method
269 # rather than re-produce it here
270 'instance_metaclass' => \&Class::MOP::Class::instance_metaclass
272 init_arg => 'instance_metaclass',
273 default => 'Class::MOP::Instance',
278 # we don't actually need to tie the knot with
279 # Class::MOP::Class here, it is actually handled
280 # within Class::MOP::Class itself in the
281 # construct_class_instance method.
283 ## --------------------------------------------------------
284 ## Class::MOP::Attribute
286 Class::MOP::Attribute->meta->add_attribute(
287 Class::MOP::Attribute->new('$!name' => (
290 # NOTE: we need to do this in order
291 # for the instance meta-object to
292 # not fall into meta-circular death
294 # we just alias the original method
295 # rather than re-produce it here
296 'name' => \&Class::MOP::Attribute::name
301 Class::MOP::Attribute->meta->add_attribute(
302 Class::MOP::Attribute->new('$!associated_class' => (
303 init_arg => 'associated_class',
305 # NOTE: we need to do this in order
306 # for the instance meta-object to
307 # not fall into meta-circular death
309 # we just alias the original method
310 # rather than re-produce it here
311 'associated_class' => \&Class::MOP::Attribute::associated_class
316 Class::MOP::Attribute->meta->add_attribute(
317 Class::MOP::Attribute->new('$!accessor' => (
318 init_arg => 'accessor',
319 reader => { 'accessor' => \&Class::MOP::Attribute::accessor },
320 predicate => { 'has_accessor' => \&Class::MOP::Attribute::has_accessor },
324 Class::MOP::Attribute->meta->add_attribute(
325 Class::MOP::Attribute->new('$!reader' => (
326 init_arg => 'reader',
327 reader => { 'reader' => \&Class::MOP::Attribute::reader },
328 predicate => { 'has_reader' => \&Class::MOP::Attribute::has_reader },
332 Class::MOP::Attribute->meta->add_attribute(
333 Class::MOP::Attribute->new('$!writer' => (
334 init_arg => 'writer',
335 reader => { 'writer' => \&Class::MOP::Attribute::writer },
336 predicate => { 'has_writer' => \&Class::MOP::Attribute::has_writer },
340 Class::MOP::Attribute->meta->add_attribute(
341 Class::MOP::Attribute->new('$!predicate' => (
342 init_arg => 'predicate',
343 reader => { 'predicate' => \&Class::MOP::Attribute::predicate },
344 predicate => { 'has_predicate' => \&Class::MOP::Attribute::has_predicate },
348 Class::MOP::Attribute->meta->add_attribute(
349 Class::MOP::Attribute->new('$!clearer' => (
350 init_arg => 'clearer',
351 reader => { 'clearer' => \&Class::MOP::Attribute::clearer },
352 predicate => { 'has_clearer' => \&Class::MOP::Attribute::has_clearer },
356 Class::MOP::Attribute->meta->add_attribute(
357 Class::MOP::Attribute->new('$!init_arg' => (
358 init_arg => 'init_arg',
359 reader => { 'init_arg' => \&Class::MOP::Attribute::init_arg },
360 predicate => { 'has_init_arg' => \&Class::MOP::Attribute::has_init_arg },
364 Class::MOP::Attribute->meta->add_attribute(
365 Class::MOP::Attribute->new('$!default' => (
366 init_arg => 'default',
367 # default has a custom 'reader' method ...
368 predicate => { 'has_default' => \&Class::MOP::Attribute::has_default },
372 Class::MOP::Attribute->meta->add_attribute(
373 Class::MOP::Attribute->new('@!associated_methods' => (
374 init_arg => 'associated_methods',
375 reader => { 'associated_methods' => \&Class::MOP::Attribute::associated_methods },
376 default => sub { [] }
380 # NOTE: (meta-circularity)
381 # This should be one of the last things done
382 # it will "tie the knot" with Class::MOP::Attribute
383 # so that it uses the attributes meta-objects
384 # to construct itself.
385 Class::MOP::Attribute->meta->add_method('new' => sub {
390 (defined $name && $name)
391 || confess "You must provide a name for the attribute";
392 $options{init_arg} = $name
393 if not exists $options{init_arg};
395 (Class::MOP::Attribute::is_default_a_coderef(\%options))
396 || confess("References are not allowed as default values, you must ".
397 "wrap then in a CODE reference (ex: sub { [] } and not [])")
398 if exists $options{default} && ref $options{default};
400 # return the new object
401 $class->meta->new_object(name => $name, %options);
404 Class::MOP::Attribute->meta->add_method('clone' => sub {
406 $self->meta->clone_object($self, @_);
409 ## --------------------------------------------------------
410 ## Class::MOP::Method
412 Class::MOP::Method->meta->add_attribute(
413 Class::MOP::Attribute->new('&!body' => (
415 reader => { 'body' => \&Class::MOP::Method::body },
419 ## --------------------------------------------------------
420 ## Class::MOP::Method::Wrapped
423 # the way this item is initialized, this
424 # really does not follow the standard
425 # practices of attributes, but we put
426 # it here for completeness
427 Class::MOP::Method::Wrapped->meta->add_attribute(
428 Class::MOP::Attribute->new('%!modifier_table')
431 ## --------------------------------------------------------
432 ## Class::MOP::Method::Generated
434 Class::MOP::Method::Generated->meta->add_attribute(
435 Class::MOP::Attribute->new('$!is_inline' => (
436 init_arg => 'is_inline',
437 reader => { 'is_inline' => \&Class::MOP::Method::Generated::is_inline },
441 ## --------------------------------------------------------
442 ## Class::MOP::Method::Accessor
444 Class::MOP::Method::Accessor->meta->add_attribute(
445 Class::MOP::Attribute->new('$!attribute' => (
446 init_arg => 'attribute',
448 'associated_attribute' => \&Class::MOP::Method::Accessor::associated_attribute
453 Class::MOP::Method::Accessor->meta->add_attribute(
454 Class::MOP::Attribute->new('$!accessor_type' => (
455 init_arg => 'accessor_type',
456 reader => { 'accessor_type' => \&Class::MOP::Method::Accessor::accessor_type },
461 ## --------------------------------------------------------
462 ## Class::MOP::Method::Constructor
464 Class::MOP::Method::Constructor->meta->add_attribute(
465 Class::MOP::Attribute->new('%!options' => (
466 init_arg => 'options',
468 'options' => \&Class::MOP::Method::Constructor::options
473 Class::MOP::Method::Constructor->meta->add_attribute(
474 Class::MOP::Attribute->new('$!associated_metaclass' => (
475 init_arg => 'metaclass',
477 'associated_metaclass' => \&Class::MOP::Method::Constructor::associated_metaclass
482 ## --------------------------------------------------------
483 ## Class::MOP::Instance
486 # these don't yet do much of anything, but are just
487 # included for completeness
489 Class::MOP::Instance->meta->add_attribute(
490 Class::MOP::Attribute->new('$!meta')
493 Class::MOP::Instance->meta->add_attribute(
494 Class::MOP::Attribute->new('@!slots')
497 ## --------------------------------------------------------
498 ## Now close all the Class::MOP::* classes
501 # we don't need to inline the
502 # constructors or the accessors
503 # this only lengthens the compile
504 # time of the MOP, and gives us
505 # no actual benefits.
507 $_->meta->make_immutable(
508 inline_constructor => 0,
509 inline_accessors => 0,
515 Class::MOP::Attribute
521 Class::MOP::Method::Generated
523 Class::MOP::Method::Accessor
524 Class::MOP::Method::Constructor
525 Class::MOP::Method::Wrapped
536 Class::MOP - A Meta Object Protocol for Perl 5
540 This module is an attempt to create a meta object protocol for the
541 Perl 5 object system. It makes no attempt to change the behavior or
542 characteristics of the Perl 5 object system, only to create a
543 protocol for its manipulation and introspection.
545 That said, it does attempt to create the tools for building a rich
546 set of extensions to the Perl 5 object system. Every attempt has been
547 made for these tools to keep to the spirit of the Perl 5 object
548 system that we all know and love.
550 This documentation is admittedly sparse on details, as time permits
551 I will try to improve them. For now, I suggest looking at the items
552 listed in the L<SEE ALSO> section for more information. In particular
553 the book "The Art of the Meta Object Protocol" was very influential
554 in the development of this system.
556 =head2 What is a Meta Object Protocol?
558 A meta object protocol is an API to an object system.
560 To be more specific, it is a set of abstractions of the components of
561 an object system (typically things like; classes, object, methods,
562 object attributes, etc.). These abstractions can then be used to both
563 inspect and manipulate the object system which they describe.
565 It can be said that there are two MOPs for any object system; the
566 implicit MOP, and the explicit MOP. The implicit MOP handles things
567 like method dispatch or inheritance, which happen automatically as
568 part of how the object system works. The explicit MOP typically
569 handles the introspection/reflection features of the object system.
570 All object systems have implicit MOPs, without one, they would not
571 work. Explict MOPs however as less common, and depending on the
572 language can vary from restrictive (Reflection in Java or C#) to
573 wide open (CLOS is a perfect example).
575 =head2 Yet Another Class Builder!! Why?
577 This is B<not> a class builder so much as it is a I<class builder
578 B<builder>>. My intent is that an end user does not use this module
579 directly, but instead this module is used by module authors to
580 build extensions and features onto the Perl 5 object system.
582 =head2 Who is this module for?
584 This module is specifically for anyone who has ever created or
585 wanted to create a module for the Class:: namespace. The tools which
586 this module will provide will hopefully make it easier to do more
587 complex things with Perl 5 classes by removing such barriers as
588 the need to hack the symbol tables, or understand the fine details
591 =head2 What changes do I have to make to use this module?
593 This module was designed to be as unintrusive as possible. Many of
594 its features are accessible without B<any> change to your existsing
595 code at all. It is meant to be a compliment to your existing code and
596 not an intrusion on your code base. Unlike many other B<Class::>
597 modules, this module B<does not> require you subclass it, or even that
598 you C<use> it in within your module's package.
600 The only features which requires additions to your code are the
601 attribute handling and instance construction features, and these are
602 both completely optional features. The only reason for this is because
603 Perl 5's object system does not actually have these features built
604 in. More information about this feature can be found below.
606 =head2 A Note about Performance?
608 It is a common misconception that explict MOPs are performance drains.
609 But this is not a universal truth at all, it is an side-effect of
610 specific implementations. For instance, using Java reflection is much
611 slower because the JVM cannot take advantage of any compiler
612 optimizations, and the JVM has to deal with much more runtime type
613 information as well. Reflection in C# is marginally better as it was
614 designed into the language and runtime (the CLR). In contrast, CLOS
615 (the Common Lisp Object System) was built to support an explicit MOP,
616 and so performance is tuned for it.
618 This library in particular does it's absolute best to avoid putting
619 B<any> drain at all upon your code's performance. In fact, by itself
620 it does nothing to affect your existing code. So you only pay for
621 what you actually use.
623 =head2 About Metaclass compatibility
625 This module makes sure that all metaclasses created are both upwards
626 and downwards compatible. The topic of metaclass compatibility is
627 highly esoteric and is something only encountered when doing deep and
628 involved metaclass hacking. There are two basic kinds of metaclass
629 incompatibility; upwards and downwards.
631 Upwards metaclass compatibility means that the metaclass of a
632 given class is either the same as (or a subclass of) all of the
635 Downward metaclass compatibility means that the metaclasses of a
636 given class's anscestors are all either the same as (or a subclass
639 Here is a diagram showing a set of two classes (C<A> and C<B>) and
640 two metaclasses (C<Meta::A> and C<Meta::B>) which have correct
641 metaclass compatibility both upwards and downwards.
643 +---------+ +---------+
644 | Meta::A |<----| Meta::B | <....... (instance of )
645 +---------+ +---------+ <------- (inherits from)
648 +---------+ +---------+
650 +---------+ +---------+
652 As I said this is a highly esoteric topic and one you will only run
653 into if you do a lot of subclassing of B<Class::MOP::Class>. If you
654 are interested in why this is an issue see the paper
655 I<Uniform and safe metaclass composition> linked to in the
656 L<SEE ALSO> section of this document.
658 =head2 Using custom metaclasses
660 Always use the metaclass pragma when using a custom metaclass, this
661 will ensure the proper initialization order and not accidentely
662 create an incorrect type of metaclass for you. This is a very rare
663 problem, and one which can only occur if you are doing deep metaclass
664 programming. So in other words, don't worry about it.
668 The protocol is divided into 3 main sub-protocols:
672 =item The Class protocol
674 This provides a means of manipulating and introspecting a Perl 5
675 class. It handles all of symbol table hacking for you, and provides
676 a rich set of methods that go beyond simple package introspection.
678 See L<Class::MOP::Class> for more details.
680 =item The Attribute protocol
682 This provides a consistent represenation for an attribute of a
683 Perl 5 class. Since there are so many ways to create and handle
684 atttributes in Perl 5 OO, this attempts to provide as much of a
685 unified approach as possible, while giving the freedom and
686 flexibility to subclass for specialization.
688 See L<Class::MOP::Attribute> for more details.
690 =item The Method protocol
692 This provides a means of manipulating and introspecting methods in
693 the Perl 5 object system. As with attributes, there are many ways to
694 approach this topic, so we try to keep it pretty basic, while still
695 making it possible to extend the system in many ways.
697 See L<Class::MOP::Method> for more details.
703 =head2 Utility functions
707 =item B<load_class ($class_name)>
709 This will load a given C<$class_name> and if it does not have an
710 already initialized metaclass, then it will intialize one for it.
712 =item B<is_class_loaded ($class_name)>
714 This will return a boolean depending on if the C<$class_name> has
717 NOTE: This does a basic check of the symbol table to try and
718 determine as best it can if the C<$class_name> is loaded, it
719 is probably correct about 99% of the time.
723 =head2 Metaclass cache functions
725 Class::MOP holds a cache of metaclasses, the following are functions
726 (B<not methods>) which can be used to access that cache. It is not
727 recommended that you mess with this, bad things could happen. But if
728 you are brave and willing to risk it, go for it.
732 =item B<get_all_metaclasses>
734 This will return an hash of all the metaclass instances that have
735 been cached by B<Class::MOP::Class> keyed by the package name.
737 =item B<get_all_metaclass_instances>
739 This will return an array of all the metaclass instances that have
740 been cached by B<Class::MOP::Class>.
742 =item B<get_all_metaclass_names>
744 This will return an array of all the metaclass names that have
745 been cached by B<Class::MOP::Class>.
747 =item B<get_metaclass_by_name ($name)>
749 =item B<store_metaclass_by_name ($name, $meta)>
751 =item B<weaken_metaclass ($name)>
753 =item B<does_metaclass_exist ($name)>
755 =item B<remove_metaclass_by_name ($name)>
763 There are very few books out on Meta Object Protocols and Metaclasses
764 because it is such an esoteric topic. The following books are really
765 the only ones I have found. If you know of any more, B<I<please>>
766 email me and let me know, I would love to hear about them.
770 =item "The Art of the Meta Object Protocol"
772 =item "Advances in Object-Oriented Metalevel Architecture and Reflection"
774 =item "Putting MetaClasses to Work"
776 =item "Smalltalk: The Language"
784 =item Uniform and safe metaclass composition
786 An excellent paper by the people who brought us the original Traits paper.
787 This paper is on how Traits can be used to do safe metaclass composition,
788 and offers an excellent introduction section which delves into the topic of
789 metaclass compatibility.
791 L<http://www.iam.unibe.ch/~scg/Archive/Papers/Duca05ySafeMetaclassTrait.pdf>
793 =item Safe Metaclass Programming
795 This paper seems to precede the above paper, and propose a mix-in based
796 approach as opposed to the Traits based approach. Both papers have similar
797 information on the metaclass compatibility problem space.
799 L<http://citeseer.ist.psu.edu/37617.html>
807 =item The Perl 6 MetaModel work in the Pugs project
811 =item L<http://svn.openfoundry.org/pugs/perl5/Perl6-MetaModel>
813 =item L<http://svn.openfoundry.org/pugs/perl5/Perl6-ObjectSpace>
823 =item CPAN Module Review of Class::MOP
825 L<http://www.oreillynet.com/onlamp/blog/2006/06/cpan_module_review_classmop.html>
829 =head1 SIMILAR MODULES
831 As I have said above, this module is a class-builder-builder, so it is
832 not the same thing as modules like L<Class::Accessor> and
833 L<Class::MethodMaker>. That being said there are very few modules on CPAN
834 with similar goals to this module. The one I have found which is most
835 like this module is L<Class::Meta>, although it's philosophy and the MOP it
836 creates are very different from this modules.
840 All complex software has bugs lurking in it, and this module is no
841 exception. If you find a bug please either email me, or add the bug
844 =head1 ACKNOWLEDGEMENTS
850 Thanks to Rob for actually getting the development of this module kick-started.
856 Stevan Little E<lt>stevan@iinteractive.comE<gt>
858 B<with contributions from:>
860 Brandon (blblack) Black
862 Guillermo (groditi) Roditi
866 Rob (robkinyon) Kinyon
868 Yuval (nothingmuch) Kogman
870 =head1 COPYRIGHT AND LICENSE
872 Copyright 2006, 2007 by Infinity Interactive, Inc.
874 L<http://www.iinteractive.com>
876 This library is free software; you can redistribute it and/or modify
877 it under the same terms as Perl itself.