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