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