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