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