lib/Class/MOP.pm

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