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