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