lib/Class/MOP.pm

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