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