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