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.38';
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::Accessor
434 Class::MOP::Method::Accessor->meta->add_attribute(
435 Class::MOP::Attribute->new('$!attribute' => (
436 init_arg => 'attribute',
438 'associated_attribute' => \&Class::MOP::Method::Accessor::associated_attribute
443 Class::MOP::Method::Accessor->meta->add_attribute(
444 Class::MOP::Attribute->new('$!accessor_type' => (
445 init_arg => 'accessor_type',
446 reader => { 'accessor_type' => \&Class::MOP::Method::Accessor::accessor_type },
450 Class::MOP::Method::Accessor->meta->add_attribute(
451 Class::MOP::Attribute->new('$!is_inline' => (
452 init_arg => 'is_inline',
453 reader => { 'is_inline' => \&Class::MOP::Method::Accessor::is_inline },
457 ## --------------------------------------------------------
458 ## Class::MOP::Method::Constructor
460 Class::MOP::Method::Constructor->meta->add_attribute(
461 Class::MOP::Attribute->new('%!options' => (
462 init_arg => 'options',
464 'options' => \&Class::MOP::Method::Constructor::options
469 Class::MOP::Method::Constructor->meta->add_attribute(
470 Class::MOP::Attribute->new('$!associated_metaclass' => (
471 init_arg => 'metaclass',
473 'associated_metaclass' => \&Class::MOP::Method::Constructor::associated_metaclass
478 ## --------------------------------------------------------
479 ## Class::MOP::Instance
482 # these don't yet do much of anything, but are just
483 # included for completeness
485 Class::MOP::Instance->meta->add_attribute(
486 Class::MOP::Attribute->new('$!meta')
489 Class::MOP::Instance->meta->add_attribute(
490 Class::MOP::Attribute->new('@!slots')
493 ## --------------------------------------------------------
494 ## Now close all the Class::MOP::* classes
497 # we don't need to inline the
498 # constructors or the accessors
499 # this only lengthens the compile
500 # time of the MOP, and gives us
501 # no actual benefits.
503 $_->meta->make_immutable(
504 inline_constructor => 0,
505 inline_accessors => 0,
511 Class::MOP::Attribute
517 Class::MOP::Method::Accessor
518 Class::MOP::Method::Constructor
519 Class::MOP::Method::Wrapped
530 Class::MOP - A Meta Object Protocol for Perl 5
534 This module is an attempt to create a meta object protocol for the
535 Perl 5 object system. It makes no attempt to change the behavior or
536 characteristics of the Perl 5 object system, only to create a
537 protocol for its manipulation and introspection.
539 That said, it does attempt to create the tools for building a rich
540 set of extensions to the Perl 5 object system. Every attempt has been
541 made for these tools to keep to the spirit of the Perl 5 object
542 system that we all know and love.
544 This documentation is admittedly sparse on details, as time permits
545 I will try to improve them. For now, I suggest looking at the items
546 listed in the L<SEE ALSO> section for more information. In particular
547 the book "The Art of the Meta Object Protocol" was very influential
548 in the development of this system.
550 =head2 What is a Meta Object Protocol?
552 A meta object protocol is an API to an object system.
554 To be more specific, it is a set of abstractions of the components of
555 an object system (typically things like; classes, object, methods,
556 object attributes, etc.). These abstractions can then be used to both
557 inspect and manipulate the object system which they describe.
559 It can be said that there are two MOPs for any object system; the
560 implicit MOP, and the explicit MOP. The implicit MOP handles things
561 like method dispatch or inheritance, which happen automatically as
562 part of how the object system works. The explicit MOP typically
563 handles the introspection/reflection features of the object system.
564 All object systems have implicit MOPs, without one, they would not
565 work. Explict MOPs however as less common, and depending on the
566 language can vary from restrictive (Reflection in Java or C#) to
567 wide open (CLOS is a perfect example).
569 =head2 Yet Another Class Builder!! Why?
571 This is B<not> a class builder so much as it is a I<class builder
572 B<builder>>. My intent is that an end user does not use this module
573 directly, but instead this module is used by module authors to
574 build extensions and features onto the Perl 5 object system.
576 =head2 Who is this module for?
578 This module is specifically for anyone who has ever created or
579 wanted to create a module for the Class:: namespace. The tools which
580 this module will provide will hopefully make it easier to do more
581 complex things with Perl 5 classes by removing such barriers as
582 the need to hack the symbol tables, or understand the fine details
585 =head2 What changes do I have to make to use this module?
587 This module was designed to be as unintrusive as possible. Many of
588 its features are accessible without B<any> change to your existsing
589 code at all. It is meant to be a compliment to your existing code and
590 not an intrusion on your code base. Unlike many other B<Class::>
591 modules, this module B<does not> require you subclass it, or even that
592 you C<use> it in within your module's package.
594 The only features which requires additions to your code are the
595 attribute handling and instance construction features, and these are
596 both completely optional features. The only reason for this is because
597 Perl 5's object system does not actually have these features built
598 in. More information about this feature can be found below.
600 =head2 A Note about Performance?
602 It is a common misconception that explict MOPs are performance drains.
603 But this is not a universal truth at all, it is an side-effect of
604 specific implementations. For instance, using Java reflection is much
605 slower because the JVM cannot take advantage of any compiler
606 optimizations, and the JVM has to deal with much more runtime type
607 information as well. Reflection in C# is marginally better as it was
608 designed into the language and runtime (the CLR). In contrast, CLOS
609 (the Common Lisp Object System) was built to support an explicit MOP,
610 and so performance is tuned for it.
612 This library in particular does it's absolute best to avoid putting
613 B<any> drain at all upon your code's performance. In fact, by itself
614 it does nothing to affect your existing code. So you only pay for
615 what you actually use.
617 =head2 About Metaclass compatibility
619 This module makes sure that all metaclasses created are both upwards
620 and downwards compatible. The topic of metaclass compatibility is
621 highly esoteric and is something only encountered when doing deep and
622 involved metaclass hacking. There are two basic kinds of metaclass
623 incompatibility; upwards and downwards.
625 Upwards metaclass compatibility means that the metaclass of a
626 given class is either the same as (or a subclass of) all of the
629 Downward metaclass compatibility means that the metaclasses of a
630 given class's anscestors are all either the same as (or a subclass
633 Here is a diagram showing a set of two classes (C<A> and C<B>) and
634 two metaclasses (C<Meta::A> and C<Meta::B>) which have correct
635 metaclass compatibility both upwards and downwards.
637 +---------+ +---------+
638 | Meta::A |<----| Meta::B | <....... (instance of )
639 +---------+ +---------+ <------- (inherits from)
642 +---------+ +---------+
644 +---------+ +---------+
646 As I said this is a highly esoteric topic and one you will only run
647 into if you do a lot of subclassing of B<Class::MOP::Class>. If you
648 are interested in why this is an issue see the paper
649 I<Uniform and safe metaclass composition> linked to in the
650 L<SEE ALSO> section of this document.
652 =head2 Using custom metaclasses
654 Always use the metaclass pragma when using a custom metaclass, this
655 will ensure the proper initialization order and not accidentely
656 create an incorrect type of metaclass for you. This is a very rare
657 problem, and one which can only occur if you are doing deep metaclass
658 programming. So in other words, don't worry about it.
662 The protocol is divided into 3 main sub-protocols:
666 =item The Class protocol
668 This provides a means of manipulating and introspecting a Perl 5
669 class. It handles all of symbol table hacking for you, and provides
670 a rich set of methods that go beyond simple package introspection.
672 See L<Class::MOP::Class> for more details.
674 =item The Attribute protocol
676 This provides a consistent represenation for an attribute of a
677 Perl 5 class. Since there are so many ways to create and handle
678 atttributes in Perl 5 OO, this attempts to provide as much of a
679 unified approach as possible, while giving the freedom and
680 flexibility to subclass for specialization.
682 See L<Class::MOP::Attribute> for more details.
684 =item The Method protocol
686 This provides a means of manipulating and introspecting methods in
687 the Perl 5 object system. As with attributes, there are many ways to
688 approach this topic, so we try to keep it pretty basic, while still
689 making it possible to extend the system in many ways.
691 See L<Class::MOP::Method> for more details.
697 =head2 Utility functions
701 =item B<load_class ($class_name)>
703 This will load a given C<$class_name> and if it does not have an
704 already initialized metaclass, then it will intialize one for it.
706 =item B<is_class_loaded ($class_name)>
708 This will return a boolean depending on if the C<$class_name> has
711 NOTE: This does a basic check of the symbol table to try and
712 determine as best it can if the C<$class_name> is loaded, it
713 is probably correct about 99% of the time.
717 =head2 Metaclass cache functions
719 Class::MOP holds a cache of metaclasses, the following are functions
720 (B<not methods>) which can be used to access that cache. It is not
721 recommended that you mess with this, bad things could happen. But if
722 you are brave and willing to risk it, go for it.
726 =item B<get_all_metaclasses>
728 This will return an hash of all the metaclass instances that have
729 been cached by B<Class::MOP::Class> keyed by the package name.
731 =item B<get_all_metaclass_instances>
733 This will return an array of all the metaclass instances that have
734 been cached by B<Class::MOP::Class>.
736 =item B<get_all_metaclass_names>
738 This will return an array of all the metaclass names that have
739 been cached by B<Class::MOP::Class>.
741 =item B<get_metaclass_by_name ($name)>
743 =item B<store_metaclass_by_name ($name, $meta)>
745 =item B<weaken_metaclass ($name)>
747 =item B<does_metaclass_exist ($name)>
749 =item B<remove_metaclass_by_name ($name)>
757 There are very few books out on Meta Object Protocols and Metaclasses
758 because it is such an esoteric topic. The following books are really
759 the only ones I have found. If you know of any more, B<I<please>>
760 email me and let me know, I would love to hear about them.
764 =item "The Art of the Meta Object Protocol"
766 =item "Advances in Object-Oriented Metalevel Architecture and Reflection"
768 =item "Putting MetaClasses to Work"
770 =item "Smalltalk: The Language"
778 =item Uniform and safe metaclass composition
780 An excellent paper by the people who brought us the original Traits paper.
781 This paper is on how Traits can be used to do safe metaclass composition,
782 and offers an excellent introduction section which delves into the topic of
783 metaclass compatibility.
785 L<http://www.iam.unibe.ch/~scg/Archive/Papers/Duca05ySafeMetaclassTrait.pdf>
787 =item Safe Metaclass Programming
789 This paper seems to precede the above paper, and propose a mix-in based
790 approach as opposed to the Traits based approach. Both papers have similar
791 information on the metaclass compatibility problem space.
793 L<http://citeseer.ist.psu.edu/37617.html>
801 =item The Perl 6 MetaModel work in the Pugs project
805 =item L<http://svn.openfoundry.org/pugs/perl5/Perl6-MetaModel>
807 =item L<http://svn.openfoundry.org/pugs/perl5/Perl6-ObjectSpace>
817 =item CPAN Module Review of Class::MOP
819 L<http://www.oreillynet.com/onlamp/blog/2006/06/cpan_module_review_classmop.html>
823 =head1 SIMILAR MODULES
825 As I have said above, this module is a class-builder-builder, so it is
826 not the same thing as modules like L<Class::Accessor> and
827 L<Class::MethodMaker>. That being said there are very few modules on CPAN
828 with similar goals to this module. The one I have found which is most
829 like this module is L<Class::Meta>, although it's philosophy and the MOP it
830 creates are very different from this modules.
834 All complex software has bugs lurking in it, and this module is no
835 exception. If you find a bug please either email me, or add the bug
838 =head1 ACKNOWLEDGEMENTS
844 Thanks to Rob for actually getting the development of this module kick-started.
850 Stevan Little E<lt>stevan@iinteractive.comE<gt>
852 B<with contributions from:>
854 Brandon (blblack) Black
856 Guillermo (groditi) Roditi
858 Rob (robkinyon) Kinyon
860 Yuval (nothingmuch) Kogman
862 =head1 COPYRIGHT AND LICENSE
864 Copyright 2006, 2007 by Infinity Interactive, Inc.
866 L<http://www.iinteractive.com>
868 This library is free software; you can redistribute it and/or modify
869 it under the same terms as Perl itself.