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