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