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