Sub::Name prereq
[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
1a29bc4d 519# FIMXE prime candidate for immutablization
4c105333 520Class::MOP::Method->meta->add_method('wrap' => sub {
5caf45ce 521 my ( $class, @args ) = @_;
522
523 unshift @args, 'body' if @args % 2 == 1;
524
525 my %options = @args;
526 my $code = $options{body};
4c105333 527
9b522fc4 528 ('CODE' eq ref($code))
4c105333 529 || confess "You must supply a CODE reference to bless, not (" . ($code || 'undef') . ")";
530
b38f3848 531 ($options{package_name} && $options{name})
532 || confess "You must supply the package_name and name parameters";
533
4c105333 534 # return the new object
5caf45ce 535 $class->meta->new_object(%options);
4c105333 536});
537
538Class::MOP::Method->meta->add_method('clone' => sub {
539 my $self = shift;
540 $self->meta->clone_object($self, @_);
541});
542
b6164407 543## --------------------------------------------------------
544## Class::MOP::Method::Wrapped
545
546# NOTE:
1d68af04 547# the way this item is initialized, this
548# really does not follow the standard
549# practices of attributes, but we put
b6164407 550# it here for completeness
551Class::MOP::Method::Wrapped->meta->add_attribute(
8683db0e 552 Class::MOP::Attribute->new('modifier_table')
b6164407 553);
554
555## --------------------------------------------------------
565f0cbb 556## Class::MOP::Method::Generated
557
558Class::MOP::Method::Generated->meta->add_attribute(
8683db0e 559 Class::MOP::Attribute->new('is_inline' => (
565f0cbb 560 reader => { 'is_inline' => \&Class::MOP::Method::Generated::is_inline },
4c105333 561 default => 0,
1d68af04 562 ))
565f0cbb 563);
564
4c105333 565Class::MOP::Method::Generated->meta->add_method('new' => sub {
566 my ($class, %options) = @_;
b38f3848 567 ($options{package_name} && $options{name})
568 || confess "You must supply the package_name and name parameters";
4c105333 569 my $self = $class->meta->new_object(%options);
570 $self->initialize_body;
571 $self;
572});
573
565f0cbb 574## --------------------------------------------------------
d90b42a6 575## Class::MOP::Method::Accessor
576
577Class::MOP::Method::Accessor->meta->add_attribute(
8683db0e 578 Class::MOP::Attribute->new('attribute' => (
1d68af04 579 reader => {
580 'associated_attribute' => \&Class::MOP::Method::Accessor::associated_attribute
d90b42a6 581 },
1d68af04 582 ))
d90b42a6 583);
584
585Class::MOP::Method::Accessor->meta->add_attribute(
8683db0e 586 Class::MOP::Attribute->new('accessor_type' => (
c23184fc 587 reader => { 'accessor_type' => \&Class::MOP::Method::Accessor::accessor_type },
1d68af04 588 ))
d90b42a6 589);
590
4c105333 591Class::MOP::Method::Accessor->meta->add_method('new' => sub {
592 my $class = shift;
593 my %options = @_;
594
595 (exists $options{attribute})
596 || confess "You must supply an attribute to construct with";
597
598 (exists $options{accessor_type})
599 || confess "You must supply an accessor_type to construct with";
600
601 (Scalar::Util::blessed($options{attribute}) && $options{attribute}->isa('Class::MOP::Attribute'))
602 || confess "You must supply an attribute which is a 'Class::MOP::Attribute' instance";
603
b38f3848 604 ($options{package_name} && $options{name})
605 || confess "You must supply the package_name and name parameters";
606
4c105333 607 # return the new object
608 my $self = $class->meta->new_object(%options);
609
610 # we don't want this creating
611 # a cycle in the code, if not
612 # needed
8683db0e 613 Scalar::Util::weaken($self->{'attribute'});
4c105333 614
615 $self->initialize_body;
616
617 $self;
618});
619
d90b42a6 620
621## --------------------------------------------------------
622## Class::MOP::Method::Constructor
623
624Class::MOP::Method::Constructor->meta->add_attribute(
8683db0e 625 Class::MOP::Attribute->new('options' => (
1d68af04 626 reader => {
627 'options' => \&Class::MOP::Method::Constructor::options
d90b42a6 628 },
4c105333 629 default => sub { +{} }
1d68af04 630 ))
d90b42a6 631);
632
633Class::MOP::Method::Constructor->meta->add_attribute(
8683db0e 634 Class::MOP::Attribute->new('associated_metaclass' => (
e8a38403 635 init_arg => "metaclass", # FIXME alias and rename
1d68af04 636 reader => {
637 'associated_metaclass' => \&Class::MOP::Method::Constructor::associated_metaclass
638 },
639 ))
d90b42a6 640);
641
4c105333 642Class::MOP::Method::Constructor->meta->add_method('new' => sub {
643 my $class = shift;
644 my %options = @_;
645
646 (Scalar::Util::blessed $options{metaclass} && $options{metaclass}->isa('Class::MOP::Class'))
647 || confess "You must pass a metaclass instance if you want to inline"
648 if $options{is_inline};
649
b38f3848 650 ($options{package_name} && $options{name})
651 || confess "You must supply the package_name and name parameters";
652
4c105333 653 # return the new object
654 my $self = $class->meta->new_object(%options);
655
656 # we don't want this creating
657 # a cycle in the code, if not
658 # needed
8683db0e 659 Scalar::Util::weaken($self->{'associated_metaclass'});
4c105333 660
661 $self->initialize_body;
662
663 $self;
664});
665
d90b42a6 666## --------------------------------------------------------
86482605 667## Class::MOP::Instance
668
669# NOTE:
1d68af04 670# these don't yet do much of anything, but are just
86482605 671# included for completeness
672
673Class::MOP::Instance->meta->add_attribute(
74890687 674 Class::MOP::Attribute->new('associated_metaclass',
675 reader => { associated_metaclass => \&Class::MOP::Instance::associated_metaclass },
676 ),
86482605 677);
678
679Class::MOP::Instance->meta->add_attribute(
74890687 680 Class::MOP::Attribute->new('_class_name',
681 init_arg => undef,
682 reader => { _class_name => \&Class::MOP::Instance::_class_name },
683 #lazy => 1, # not yet supported by Class::MOP but out our version does it anyway
684 #default => sub { $_[0]->associated_metaclass->name },
685 ),
686);
687
688Class::MOP::Instance->meta->add_attribute(
689 Class::MOP::Attribute->new('attributes',
690 reader => { attributes => \&Class::MOP::Instance::attributes },
691 ),
32bfc810 692);
693
694Class::MOP::Instance->meta->add_attribute(
74890687 695 Class::MOP::Attribute->new('slots',
696 reader => { slots => \&Class::MOP::Instance::slots },
697 ),
86482605 698);
699
63d08a9e 700Class::MOP::Instance->meta->add_attribute(
74890687 701 Class::MOP::Attribute->new('slot_hash',
702 reader => { slot_hash => \&Class::MOP::Instance::slot_hash },
703 ),
63d08a9e 704);
705
706
caa051fa 707# we need the meta instance of the meta instance to be created now, in order
708# for the constructor to be able to use it
709Class::MOP::Instance->meta->get_meta_instance;
710
711Class::MOP::Instance->meta->add_method('new' => sub {
712 my $class = shift;
713 my $options = $class->BUILDARGS(@_);
714
715 my $self = $class->meta->new_object(%$options);
716
717 Scalar::Util::weaken($self->{'associated_metaclass'});
718
719 $self;
720});
721
722# pretend the add_method never happenned. it hasn't yet affected anything
723undef Class::MOP::Instance->meta->{_package_cache_flag};
724
86482605 725## --------------------------------------------------------
f0480c45 726## Now close all the Class::MOP::* classes
4d47b77f 727
0b9372a2 728# NOTE:
1d68af04 729# we don't need to inline the
730# constructors or the accessors
731# this only lengthens the compile
732# time of the MOP, and gives us
0b9372a2 733# no actual benefits.
734
735$_->meta->make_immutable(
736 inline_constructor => 0,
737 inline_accessors => 0,
738) for qw/
1d68af04 739 Class::MOP::Package
740 Class::MOP::Module
741 Class::MOP::Class
742
0b9372a2 743 Class::MOP::Attribute
1d68af04 744 Class::MOP::Method
745 Class::MOP::Instance
746
747 Class::MOP::Object
0b9372a2 748
565f0cbb 749 Class::MOP::Method::Generated
1d68af04 750
ba38bf08 751 Class::MOP::Method::Accessor
1d68af04 752 Class::MOP::Method::Constructor
753 Class::MOP::Method::Wrapped
0b9372a2 754/;
b6164407 755
94b19069 7561;
757
758__END__
759
760=pod
761
1d68af04 762=head1 NAME
94b19069 763
764Class::MOP - A Meta Object Protocol for Perl 5
765
94b19069 766=head1 DESCRIPTON
767
127d39a7 768This module is a fully functioning meta object protocol for the
1d68af04 769Perl 5 object system. It makes no attempt to change the behavior or
770characteristics of the Perl 5 object system, only to create a
27e31eaf 771protocol for its manipulation and introspection.
94b19069 772
1d68af04 773That said, it does attempt to create the tools for building a rich
774set of extensions to the Perl 5 object system. Every attempt has been
775made for these tools to keep to the spirit of the Perl 5 object
94b19069 776system that we all know and love.
777
1d68af04 778This documentation is admittedly sparse on details, as time permits
779I will try to improve them. For now, I suggest looking at the items
780listed in the L<SEE ALSO> section for more information. In particular
781the book "The Art of the Meta Object Protocol" was very influential
40483095 782in the development of this system.
783
bfe4d0fc 784=head2 What is a Meta Object Protocol?
785
1d68af04 786A meta object protocol is an API to an object system.
bfe4d0fc 787
1d68af04 788To be more specific, it is a set of abstractions of the components of
789an object system (typically things like; classes, object, methods,
790object attributes, etc.). These abstractions can then be used to both
bfe4d0fc 791inspect and manipulate the object system which they describe.
792
1d68af04 793It can be said that there are two MOPs for any object system; the
794implicit MOP, and the explicit MOP. The implicit MOP handles things
795like method dispatch or inheritance, which happen automatically as
796part of how the object system works. The explicit MOP typically
797handles the introspection/reflection features of the object system.
798All object systems have implicit MOPs, without one, they would not
799work. Explict MOPs however as less common, and depending on the
800language can vary from restrictive (Reflection in Java or C#) to
801wide open (CLOS is a perfect example).
bfe4d0fc 802
e16da3e6 803=head2 Yet Another Class Builder!! Why?
804
1d68af04 805This is B<not> a class builder so much as it is a I<class builder
806B<builder>>. My intent is that an end user does not use this module
807directly, but instead this module is used by module authors to
808build extensions and features onto the Perl 5 object system.
e16da3e6 809
94b19069 810=head2 Who is this module for?
811
1d68af04 812This module is specifically for anyone who has ever created or
813wanted to create a module for the Class:: namespace. The tools which
814this module will provide will hopefully make it easier to do more
815complex things with Perl 5 classes by removing such barriers as
816the need to hack the symbol tables, or understand the fine details
817of method dispatch.
94b19069 818
bfe4d0fc 819=head2 What changes do I have to make to use this module?
820
1d68af04 821This module was designed to be as unintrusive as possible. Many of
822its features are accessible without B<any> change to your existsing
823code at all. It is meant to be a compliment to your existing code and
824not an intrusion on your code base. Unlike many other B<Class::>
825modules, this module B<does not> require you subclass it, or even that
826you C<use> it in within your module's package.
bfe4d0fc 827
1d68af04 828The only features which requires additions to your code are the
2eb717d5 829attribute handling and instance construction features, and these are
1d68af04 830both completely optional features. The only reason for this is because
831Perl 5's object system does not actually have these features built
2eb717d5 832in. More information about this feature can be found below.
bfe4d0fc 833
834=head2 A Note about Performance?
835
1d68af04 836It is a common misconception that explict MOPs are performance drains.
837But this is not a universal truth at all, it is an side-effect of
838specific implementations. For instance, using Java reflection is much
839slower because the JVM cannot take advantage of any compiler
840optimizations, and the JVM has to deal with much more runtime type
841information as well. Reflection in C# is marginally better as it was
842designed into the language and runtime (the CLR). In contrast, CLOS
843(the Common Lisp Object System) was built to support an explicit MOP,
844and so performance is tuned for it.
845
846This library in particular does it's absolute best to avoid putting
847B<any> drain at all upon your code's performance. In fact, by itself
848it does nothing to affect your existing code. So you only pay for
2eb717d5 849what you actually use.
bfe4d0fc 850
550d56db 851=head2 About Metaclass compatibility
852
1d68af04 853This module makes sure that all metaclasses created are both upwards
854and downwards compatible. The topic of metaclass compatibility is
855highly esoteric and is something only encountered when doing deep and
856involved metaclass hacking. There are two basic kinds of metaclass
857incompatibility; upwards and downwards.
550d56db 858
1d68af04 859Upwards metaclass compatibility means that the metaclass of a
860given class is either the same as (or a subclass of) all of the
550d56db 861class's ancestors.
862
1d68af04 863Downward metaclass compatibility means that the metaclasses of a
864given class's anscestors are all either the same as (or a subclass
550d56db 865of) that metaclass.
866
1d68af04 867Here is a diagram showing a set of two classes (C<A> and C<B>) and
868two metaclasses (C<Meta::A> and C<Meta::B>) which have correct
550d56db 869metaclass compatibility both upwards and downwards.
870
871 +---------+ +---------+
872 | Meta::A |<----| Meta::B | <....... (instance of )
1d68af04 873 +---------+ +---------+ <------- (inherits from)
550d56db 874 ^ ^
875 : :
876 +---------+ +---------+
877 | A |<----| B |
878 +---------+ +---------+
879
1d68af04 880As I said this is a highly esoteric topic and one you will only run
881into if you do a lot of subclassing of B<Class::MOP::Class>. If you
882are interested in why this is an issue see the paper
883I<Uniform and safe metaclass composition> linked to in the
550d56db 884L<SEE ALSO> section of this document.
885
aa448b16 886=head2 Using custom metaclasses
887
1d68af04 888Always use the metaclass pragma when using a custom metaclass, this
889will ensure the proper initialization order and not accidentely
890create an incorrect type of metaclass for you. This is a very rare
891problem, and one which can only occur if you are doing deep metaclass
aa448b16 892programming. So in other words, don't worry about it.
893
94b19069 894=head1 PROTOCOLS
895
127d39a7 896The protocol is divided into 4 main sub-protocols:
94b19069 897
898=over 4
899
900=item The Class protocol
901
1d68af04 902This provides a means of manipulating and introspecting a Perl 5
903class. It handles all of symbol table hacking for you, and provides
94b19069 904a rich set of methods that go beyond simple package introspection.
905
552e3d24 906See L<Class::MOP::Class> for more details.
907
94b19069 908=item The Attribute protocol
909
1d68af04 910This provides a consistent represenation for an attribute of a
911Perl 5 class. Since there are so many ways to create and handle
127d39a7 912attributes in Perl 5 OO, this attempts to provide as much of a
1d68af04 913unified approach as possible, while giving the freedom and
94b19069 914flexibility to subclass for specialization.
915
552e3d24 916See L<Class::MOP::Attribute> for more details.
917
94b19069 918=item The Method protocol
919
1d68af04 920This provides a means of manipulating and introspecting methods in
921the Perl 5 object system. As with attributes, there are many ways to
922approach this topic, so we try to keep it pretty basic, while still
94b19069 923making it possible to extend the system in many ways.
924
552e3d24 925See L<Class::MOP::Method> for more details.
94b19069 926
127d39a7 927=item The Instance protocol
928
929This provides a layer of abstraction for creating object instances.
930Since the other layers use this protocol, it is relatively easy to
931change the type of your instances from the default HASH ref to other
932types of references. Several examples are provided in the F<examples/>
933directory included in this distribution.
934
935See L<Class::MOP::Instance> for more details.
936
94b19069 937=back
938
be7677c7 939=head1 FUNCTIONS
940
c1d5345a 941=head2 Constants
942
943=over 4
944
945=item I<IS_RUNNING_ON_5_10>
946
947We set this constant depending on what version perl we are on, this
948allows us to take advantage of new 5.10 features and stay backwards
949compat.
950
9efe16ca 951=item I<HAVE_ISAREV>
952
953Whether or not C<mro> provides C<get_isarev>, a much faster way to get all the
954subclasses of a certain class.
955
c1d5345a 956=back
957
448b6e55 958=head2 Utility functions
959
960=over 4
961
962=item B<load_class ($class_name)>
963
1d68af04 964This will load a given C<$class_name> and if it does not have an
448b6e55 965already initialized metaclass, then it will intialize one for it.
127d39a7 966This function can be used in place of tricks like
967C<eval "use $module"> or using C<require>.
448b6e55 968
969=item B<is_class_loaded ($class_name)>
970
1d68af04 971This will return a boolean depending on if the C<$class_name> has
972been loaded.
448b6e55 973
1d68af04 974NOTE: This does a basic check of the symbol table to try and
448b6e55 975determine as best it can if the C<$class_name> is loaded, it
1d68af04 976is probably correct about 99% of the time.
448b6e55 977
b1f5f41d 978=item B<check_package_cache_flag ($pkg)>
e0e4674a 979
127d39a7 980This will return an integer that is managed by C<Class::MOP::Class>
981to determine if a module's symbol table has been altered.
982
983In Perl 5.10 or greater, this flag is package specific. However in
984versions prior to 5.10, this will use the C<PL_sub_generation> variable
985which is not package specific.
986
e0e4674a 987=item B<get_code_info ($code)>
988
127d39a7 989This function returns two values, the name of the package the C<$code>
990is from and the name of the C<$code> itself. This is used by several
991elements of the MOP to detemine where a given C<$code> reference is from.
992
4c105333 993=item B<subname ($name, $code)>
994
995B<NOTE: DO NOT USE THIS FUNCTION, IT IS FOR INTERNAL USE ONLY!>
996
997If possible, we will load the L<Sub::Name> module and this will function
998as C<Sub::Name::subname> does, otherwise it will just return the C<$code>
999argument.
1000
448b6e55 1001=back
1002
1003=head2 Metaclass cache functions
1004
1d68af04 1005Class::MOP holds a cache of metaclasses, the following are functions
1006(B<not methods>) which can be used to access that cache. It is not
1007recommended that you mess with this, bad things could happen. But if
be7677c7 1008you are brave and willing to risk it, go for it.
1009
1010=over 4
1011
1012=item B<get_all_metaclasses>
1013
1d68af04 1014This will return an hash of all the metaclass instances that have
1015been cached by B<Class::MOP::Class> keyed by the package name.
b9d9fc0b 1016
be7677c7 1017=item B<get_all_metaclass_instances>
1018
1d68af04 1019This will return an array of all the metaclass instances that have
b9d9fc0b 1020been cached by B<Class::MOP::Class>.
1021
be7677c7 1022=item B<get_all_metaclass_names>
1023
1d68af04 1024This will return an array of all the metaclass names that have
b9d9fc0b 1025been cached by B<Class::MOP::Class>.
1026
be7677c7 1027=item B<get_metaclass_by_name ($name)>
1028
127d39a7 1029This will return a cached B<Class::MOP::Class> instance of nothing
1030if no metaclass exist by that C<$name>.
1031
be7677c7 1032=item B<store_metaclass_by_name ($name, $meta)>
1033
127d39a7 1034This will store a metaclass in the cache at the supplied C<$key>.
1035
be7677c7 1036=item B<weaken_metaclass ($name)>
1037
127d39a7 1038In rare cases it is desireable to store a weakened reference in
1039the metaclass cache. This function will weaken the reference to
1040the metaclass stored in C<$name>.
1041
be7677c7 1042=item B<does_metaclass_exist ($name)>
1043
127d39a7 1044This will return true of there exists a metaclass stored in the
1045C<$name> key and return false otherwise.
1046
be7677c7 1047=item B<remove_metaclass_by_name ($name)>
1048
127d39a7 1049This will remove a the metaclass stored in the C<$name> key.
1050
be7677c7 1051=back
1052
552e3d24 1053=head1 SEE ALSO
8b978dd5 1054
552e3d24 1055=head2 Books
8b978dd5 1056
1d68af04 1057There are very few books out on Meta Object Protocols and Metaclasses
1058because it is such an esoteric topic. The following books are really
1059the only ones I have found. If you know of any more, B<I<please>>
a2e85e6c 1060email me and let me know, I would love to hear about them.
1061
8b978dd5 1062=over 4
1063
552e3d24 1064=item "The Art of the Meta Object Protocol"
8b978dd5 1065
552e3d24 1066=item "Advances in Object-Oriented Metalevel Architecture and Reflection"
8b978dd5 1067
b51af7f9 1068=item "Putting MetaClasses to Work"
1069
a2e85e6c 1070=item "Smalltalk: The Language"
1071
94b19069 1072=back
1073
550d56db 1074=head2 Papers
1075
1076=over 4
1077
1078=item Uniform and safe metaclass composition
1079
1d68af04 1080An excellent paper by the people who brought us the original Traits paper.
1081This paper is on how Traits can be used to do safe metaclass composition,
1082and offers an excellent introduction section which delves into the topic of
550d56db 1083metaclass compatibility.
1084
1085L<http://www.iam.unibe.ch/~scg/Archive/Papers/Duca05ySafeMetaclassTrait.pdf>
1086
1087=item Safe Metaclass Programming
1088
1d68af04 1089This paper seems to precede the above paper, and propose a mix-in based
1090approach as opposed to the Traits based approach. Both papers have similar
1091information on the metaclass compatibility problem space.
550d56db 1092
1093L<http://citeseer.ist.psu.edu/37617.html>
1094
1095=back
1096
552e3d24 1097=head2 Prior Art
8b978dd5 1098
1099=over 4
1100
7184ca14 1101=item The Perl 6 MetaModel work in the Pugs project
8b978dd5 1102
1103=over 4
1104
552e3d24 1105=item L<http://svn.openfoundry.org/pugs/perl5/Perl6-MetaModel>
8b978dd5 1106
552e3d24 1107=item L<http://svn.openfoundry.org/pugs/perl5/Perl6-ObjectSpace>
8b978dd5 1108
1109=back
1110
94b19069 1111=back
1112
1d68af04 1113=head2 Articles
f8dfcfb7 1114
1115=over 4
1116
1d68af04 1117=item CPAN Module Review of Class::MOP
f8dfcfb7 1118
1119L<http://www.oreillynet.com/onlamp/blog/2006/06/cpan_module_review_classmop.html>
1120
1121=back
1122
a2e85e6c 1123=head1 SIMILAR MODULES
1124
1d68af04 1125As I have said above, this module is a class-builder-builder, so it is
1126not the same thing as modules like L<Class::Accessor> and
1127L<Class::MethodMaker>. That being said there are very few modules on CPAN
1128with similar goals to this module. The one I have found which is most
1129like this module is L<Class::Meta>, although it's philosophy and the MOP it
1130creates are very different from this modules.
94b19069 1131
a2e85e6c 1132=head1 BUGS
1133
1d68af04 1134All complex software has bugs lurking in it, and this module is no
a2e85e6c 1135exception. If you find a bug please either email me, or add the bug
1136to cpan-RT.
1137
1138=head1 ACKNOWLEDGEMENTS
1139
1140=over 4
1141
b9d9fc0b 1142=item Rob Kinyon
a2e85e6c 1143
1d68af04 1144Thanks to Rob for actually getting the development of this module kick-started.
a2e85e6c 1145
1146=back
1147
1a09d9cc 1148=head1 AUTHORS
94b19069 1149
a2e85e6c 1150Stevan Little E<lt>stevan@iinteractive.comE<gt>
552e3d24 1151
9c8cda90 1152B<with contributions from:>
1153
1154Brandon (blblack) Black
1155
1156Guillermo (groditi) Roditi
1157
9195ddff 1158Matt (mst) Trout
1159
9c8cda90 1160Rob (robkinyon) Kinyon
1161
1162Yuval (nothingmuch) Kogman
1a09d9cc 1163
f430cfa4 1164Scott (konobi) McWhirter
1165
94b19069 1166=head1 COPYRIGHT AND LICENSE
1167
69e3ab0a 1168Copyright 2006-2008 by Infinity Interactive, Inc.
94b19069 1169
1170L<http://www.iinteractive.com>
1171
1172This library is free software; you can redistribute it and/or modify
1d68af04 1173it under the same terms as Perl itself.
94b19069 1174
1175=cut