lib/Class/MOP/Class.pm

   1
   2 package Class::MOP::Class;
   3
   4 use strict;
   5 use warnings;
   6
   7 use Carp         'confess';
   8 use Scalar::Util 'blessed', 'reftype';
   9 use Sub::Name    'subname';
  10 use B            'svref_2object';
  11 use Clone         ();
  12
  13 our $VERSION = '0.04';
  14
  15 # Self-introspection
  16
  17 sub meta { Class::MOP::Class->initialize(blessed($_[0]) || $_[0]) }
  18
  19 # Creation
  20
  21 {
  22     # Metaclasses are singletons, so we cache them here.
  23     # there is no need to worry about destruction though
  24     # because they should die only when the program dies.
  25     # After all, do package definitions even get reaped?
  26     my %METAS;
  27
  28     sub initialize {
  29         my $class        = shift;
  30         my $package_name = shift;
  31         (defined $package_name && $package_name)
  32             || confess "You must pass a package name";
  33         # make sure the package name is not blessed
  34         $package_name = blessed($package_name) || $package_name;
  35         $class->construct_class_instance(':package' => $package_name, @_);
  36     }
  37
  38     # NOTE: (meta-circularity)
  39     # this is a special form of &construct_instance
  40     # (see below), which is used to construct class
  41     # meta-object instances for any Class::MOP::*
  42     # class. All other classes will use the more
  43     # normal &construct_instance.
  44     sub construct_class_instance {
  45         my $class        = shift;
  46         my %options      = @_;
  47         my $package_name = $options{':package'};
  48         (defined $package_name && $package_name)
  49             || confess "You must pass a package name";
  50         return $METAS{$package_name} if exists $METAS{$package_name};
  51         $class = blessed($class) || $class;
  52         # now create the metaclass
  53         my $meta;
  54         if ($class =~ /^Class::MOP::/) {
  55             $meta = bless {
  56                 '$:package'             => $package_name,
  57                 '%:attributes'          => {},
  58                 '$:attribute_metaclass' => $options{':attribute_metaclass'} || 'Class::MOP::Attribute',
  59                 '$:method_metaclass'    => $options{':method_metaclass'}    || 'Class::MOP::Method',
  60             } => $class;
  61         }
  62         else {
  63             # NOTE:
  64             # it is safe to use meta here because
  65             # class will always be a subclass of
  66             # Class::MOP::Class, which defines meta
  67             $meta = bless $class->meta->construct_instance(%options) => $class
  68         }
  69         # and check the metaclass compatibility
  70         $meta->check_metaclass_compatability();
  71         $METAS{$package_name} = $meta;
  72     }
  73
  74     sub check_metaclass_compatability {
  75         my $self = shift;
  76
  77         # this is always okay ...
  78         return if blessed($self) eq 'Class::MOP::Class';
  79
  80         my @class_list = $self->class_precedence_list;
  81         shift @class_list; # shift off $self->name
  82
  83         foreach my $class_name (@class_list) {
  84             my $meta = $METAS{$class_name};
  85             ($self->isa(blessed($meta)))
  86                 || confess $self->name . "->meta => (" . (blessed($self)) . ")" .
  87                            " is not compatible with the " .
  88                            $class_name . "->meta => (" . (blessed($meta)) . ")";
  89         }
  90     }
  91 }
  92
  93 sub create {
  94     my ($class, $package_name, $package_version, %options) = @_;
  95     (defined $package_name && $package_name)
  96         || confess "You must pass a package name";
  97     my $code = "package $package_name;";
  98     $code .= "\$$package_name\:\:VERSION = '$package_version';"
  99         if defined $package_version;
 100     eval $code;
 101     confess "creation of $package_name failed : $@" if $@;
 102     my $meta = $class->initialize($package_name);
 103
 104     $meta->add_method('meta' => sub {
 105         Class::MOP::Class->initialize(blessed($_[0]) || $_[0]);
 106     });
 107
 108     $meta->superclasses(@{$options{superclasses}})
 109         if exists $options{superclasses};
 110     # NOTE:
 111     # process attributes first, so that they can
 112     # install accessors, but locally defined methods
 113     # can then overwrite them. It is maybe a little odd, but
 114     # I think this should be the order of things.
 115     if (exists $options{attributes}) {
 116         foreach my $attr (@{$options{attributes}}) {
 117             $meta->add_attribute($attr);
 118         }
 119     }
 120     if (exists $options{methods}) {
 121         foreach my $method_name (keys %{$options{methods}}) {
 122             $meta->add_method($method_name, $options{methods}->{$method_name});
 123         }
 124     }
 125     return $meta;
 126 }
 127
 128 ## Attribute readers
 129
 130 # NOTE:
 131 # all these attribute readers will be bootstrapped
 132 # away in the Class::MOP bootstrap section
 133
 134 sub name                { $_[0]->{'$:package'}             }
 135 sub get_attribute_map   { $_[0]->{'%:attributes'}          }
 136 sub attribute_metaclass { $_[0]->{'$:attribute_metaclass'} }
 137 sub method_metaclass    { $_[0]->{'$:method_metaclass'}    }
 138
 139 # Instance Construction & Cloning
 140
 141 sub new_object {
 142     my $class = shift;
 143     # NOTE:
 144     # we need to protect the integrity of the
 145     # Class::MOP::Class singletons here, so we
 146     # delegate this to &construct_class_instance
 147     # which will deal with the singletons
 148     return $class->construct_class_instance(@_)
 149         if $class->name->isa('Class::MOP::Class');
 150     bless $class->construct_instance(@_) => $class->name;
 151 }
 152
 153 sub construct_instance {
 154     my ($class, %params) = @_;
 155     my $instance = {};
 156     foreach my $attr ($class->compute_all_applicable_attributes()) {
 157         my $init_arg = $attr->init_arg();
 158         # try to fetch the init arg from the %params ...
 159         my $val;
 160         $val = $params{$init_arg} if exists $params{$init_arg};
 161         # if nothing was in the %params, we can use the
 162         # attribute's default value (if it has one)
 163         $val ||= $attr->default($instance) if $attr->has_default();
 164         $instance->{$attr->name} = $val;
 165     }
 166     return $instance;
 167 }
 168
 169 sub clone_object {
 170     my $class    = shift;
 171     my $instance = shift;
 172     (blessed($instance) && $instance->isa($class->name))
 173         || confess "You must pass an instance ($instance) of the metaclass (" . $class->name . ")";
 174     # NOTE:
 175     # we need to protect the integrity of the
 176     # Class::MOP::Class singletons here, they
 177     # should not be cloned.
 178     return $instance if $instance->isa('Class::MOP::Class');
 179     bless $class->clone_instance($instance, @_) => blessed($instance);
 180 }
 181
 182 sub clone_instance {
 183     my ($class, $instance, %params) = @_;
 184     (blessed($instance))
 185         || confess "You can only clone instances, \$self is not a blessed instance";
 186     # NOTE:
 187     # This will deep clone, which might
 188     # not be what you always want. So
 189     # the best thing is to write a more
 190     # controled &clone method locally
 191     # in the class (see Class::MOP)
 192     my $clone = Clone::clone($instance);
 193     foreach my $attr ($class->compute_all_applicable_attributes()) {
 194         my $init_arg = $attr->init_arg();
 195         # try to fetch the init arg from the %params ...
 196         $clone->{$attr->name} = $params{$init_arg}
 197             if exists $params{$init_arg};
 198     }
 199     return $clone;
 200 }
 201
 202 # Informational
 203
 204 # &name should be here too, but it is above
 205 # because it gets bootstrapped away
 206
 207 sub version {
 208     my $self = shift;
 209     no strict 'refs';
 210     ${$self->name . '::VERSION'};
 211 }
 212
 213 # Inheritance
 214
 215 sub superclasses {
 216     my $self = shift;
 217     no strict 'refs';
 218     if (@_) {
 219         my @supers = @_;
 220         @{$self->name . '::ISA'} = @supers;
 221     }
 222     @{$self->name . '::ISA'};
 223 }
 224
 225 sub class_precedence_list {
 226     my $self = shift;
 227     # NOTE:
 228     # We need to check for ciruclar inheirtance here.
 229     # This will do nothing if all is well, and blow
 230     # up otherwise. Yes, it's an ugly hack, better
 231     # suggestions are welcome.
 232     { $self->name->isa('This is a test for circular inheritance') }
 233     # ... and no back to our regularly scheduled program
 234     (
 235         $self->name,
 236         map {
 237             $self->initialize($_)->class_precedence_list()
 238         } $self->superclasses()
 239     );
 240 }
 241
 242 ## Methods
 243
 244 sub add_method {
 245     my ($self, $method_name, $method) = @_;
 246     (defined $method_name && $method_name)
 247         || confess "You must define a method name";
 248     # use reftype here to allow for blessed subs ...
 249     (reftype($method) && reftype($method) eq 'CODE')
 250         || confess "Your code block must be a CODE reference";
 251     my $full_method_name = ($self->name . '::' . $method_name);
 252
 253     no strict 'refs';
 254     no warnings 'redefine';
 255     *{$full_method_name} = subname $full_method_name => $method;
 256 }
 257
 258 sub alias_method {
 259     my ($self, $method_name, $method) = @_;
 260     (defined $method_name && $method_name)
 261         || confess "You must define a method name";
 262     # use reftype here to allow for blessed subs ...
 263     (reftype($method) && reftype($method) eq 'CODE')
 264         || confess "Your code block must be a CODE reference";
 265     my $full_method_name = ($self->name . '::' . $method_name);
 266
 267     no strict 'refs';
 268     no warnings 'redefine';
 269     *{$full_method_name} = $method;
 270 }
 271
 272 {
 273
 274     ## private utility functions for has_method
 275     my $_find_subroutine_package_name = sub { eval { svref_2object($_[0])->GV->STASH->NAME } || '' };
 276     my $_find_subroutine_name         = sub { eval { svref_2object($_[0])->GV->NAME        } || '' };
 277
 278     sub has_method {
 279         my ($self, $method_name) = @_;
 280         (defined $method_name && $method_name)
 281             || confess "You must define a method name";
 282
 283         my $sub_name = ($self->name . '::' . $method_name);
 284
 285         no strict 'refs';
 286         return 0 if !defined(&{$sub_name});
 287         return 0 if $_find_subroutine_package_name->(\&{$sub_name}) ne $self->name &&
 288                     $_find_subroutine_name->(\&{$sub_name})         ne '__ANON__';
 289         return 1;
 290     }
 291
 292 }
 293
 294 sub get_method {
 295     my ($self, $method_name) = @_;
 296     (defined $method_name && $method_name)
 297         || confess "You must define a method name";
 298
 299     no strict 'refs';
 300     return \&{$self->name . '::' . $method_name}
 301         if $self->has_method($method_name);
 302     return; # <- make sure to return undef
 303 }
 304
 305 sub remove_method {
 306     my ($self, $method_name) = @_;
 307     (defined $method_name && $method_name)
 308         || confess "You must define a method name";
 309
 310     my $removed_method = $self->get_method($method_name);
 311
 312     no strict 'refs';
 313     delete ${$self->name . '::'}{$method_name}
 314         if defined $removed_method;
 315
 316     return $removed_method;
 317 }
 318
 319 sub get_method_list {
 320     my $self = shift;
 321     no strict 'refs';
 322     grep { $self->has_method($_) } %{$self->name . '::'};
 323 }
 324
 325 sub compute_all_applicable_methods {
 326     my $self = shift;
 327     my @methods;
 328     # keep a record of what we have seen
 329     # here, this will handle all the
 330     # inheritence issues because we are
 331     # using the &class_precedence_list
 332     my (%seen_class, %seen_method);
 333     foreach my $class ($self->class_precedence_list()) {
 334         next if $seen_class{$class};
 335         $seen_class{$class}++;
 336         # fetch the meta-class ...
 337         my $meta = $self->initialize($class);
 338         foreach my $method_name ($meta->get_method_list()) {
 339             next if exists $seen_method{$method_name};
 340             $seen_method{$method_name}++;
 341             push @methods => {
 342                 name  => $method_name,
 343                 class => $class,
 344                 code  => $meta->get_method($method_name)
 345             };
 346         }
 347     }
 348     return @methods;
 349 }
 350
 351 sub find_all_methods_by_name {
 352     my ($self, $method_name) = @_;
 353     (defined $method_name && $method_name)
 354         || confess "You must define a method name to find";
 355     my @methods;
 356     # keep a record of what we have seen
 357     # here, this will handle all the
 358     # inheritence issues because we are
 359     # using the &class_precedence_list
 360     my %seen_class;
 361     foreach my $class ($self->class_precedence_list()) {
 362         next if $seen_class{$class};
 363         $seen_class{$class}++;
 364         # fetch the meta-class ...
 365         my $meta = $self->initialize($class);;
 366         push @methods => {
 367             name  => $method_name,
 368             class => $class,
 369             code  => $meta->get_method($method_name)
 370         } if $meta->has_method($method_name);
 371     }
 372     return @methods;
 373
 374 }
 375
 376 ## Attributes
 377
 378 sub add_attribute {
 379     my $self      = shift;
 380     # either we have an attribute object already
 381     # or we need to create one from the args provided
 382     my $attribute = blessed($_[0]) ? $_[0] : $self->attribute_metaclass->new(@_);
 383     # make sure it is derived from the correct type though
 384     ($attribute->isa('Class::MOP::Attribute'))
 385         || confess "Your attribute must be an instance of Class::MOP::Attribute (or a subclass)";
 386     $attribute->attach_to_class($self);
 387     $attribute->install_accessors();
 388     $self->get_attribute_map->{$attribute->name} = $attribute;
 389 }
 390
 391 sub has_attribute {
 392     my ($self, $attribute_name) = @_;
 393     (defined $attribute_name && $attribute_name)
 394         || confess "You must define an attribute name";
 395     exists $self->get_attribute_map->{$attribute_name} ? 1 : 0;
 396 }
 397
 398 sub get_attribute {
 399     my ($self, $attribute_name) = @_;
 400     (defined $attribute_name && $attribute_name)
 401         || confess "You must define an attribute name";
 402     return $self->get_attribute_map->{$attribute_name}
 403         if $self->has_attribute($attribute_name);
 404 }
 405
 406 sub remove_attribute {
 407     my ($self, $attribute_name) = @_;
 408     (defined $attribute_name && $attribute_name)
 409         || confess "You must define an attribute name";
 410     my $removed_attribute = $self->get_attribute_map->{$attribute_name};
 411     delete $self->get_attribute_map->{$attribute_name}
 412         if defined $removed_attribute;
 413     $removed_attribute->remove_accessors();
 414     $removed_attribute->detach_from_class();
 415     return $removed_attribute;
 416 }
 417
 418 sub get_attribute_list {
 419     my $self = shift;
 420     keys %{$self->get_attribute_map};
 421 }
 422
 423 sub compute_all_applicable_attributes {
 424     my $self = shift;
 425     my @attrs;
 426     # keep a record of what we have seen
 427     # here, this will handle all the
 428     # inheritence issues because we are
 429     # using the &class_precedence_list
 430     my (%seen_class, %seen_attr);
 431     foreach my $class ($self->class_precedence_list()) {
 432         next if $seen_class{$class};
 433         $seen_class{$class}++;
 434         # fetch the meta-class ...
 435         my $meta = $self->initialize($class);
 436         foreach my $attr_name ($meta->get_attribute_list()) {
 437             next if exists $seen_attr{$attr_name};
 438             $seen_attr{$attr_name}++;
 439             push @attrs => $meta->get_attribute($attr_name);
 440         }
 441     }
 442     return @attrs;
 443 }
 444
 445 # Class attributes
 446
 447 sub add_package_variable {
 448     my ($self, $variable, $initial_value) = @_;
 449     (defined $variable && $variable =~ /^[\$\@\%]/)
 450         || confess "variable name does not have a sigil";
 451
 452     my ($sigil, $name) = ($variable =~ /^(.)(.*)$/);
 453     if (defined $initial_value) {
 454         no strict 'refs';
 455         *{$self->name . '::' . $name} = $initial_value;
 456     }
 457     else {
 458         eval $sigil . $self->name . '::' . $name;
 459         confess "Could not create package variable ($variable) because : $@" if $@;
 460     }
 461 }
 462
 463 sub has_package_variable {
 464     my ($self, $variable) = @_;
 465     (defined $variable && $variable =~ /^[\$\@\%]/)
 466         || confess "variable name does not have a sigil";
 467     my ($sigil, $name) = ($variable =~ /^(.)(.*)$/);
 468     no strict 'refs';
 469     defined ${$self->name . '::'}{$name} ? 1 : 0;
 470 }
 471
 472 sub get_package_variable {
 473     my ($self, $variable) = @_;
 474     (defined $variable && $variable =~ /^[\$\@\%]/)
 475         || confess "variable name does not have a sigil";
 476     my ($sigil, $name) = ($variable =~ /^(.)(.*)$/);
 477     no strict 'refs';
 478     # try to fetch it first,.. see what happens
 479     eval '\\' . $sigil . $self->name . '::' . $name;
 480     confess "Could not get the package variable ($variable) because : $@" if $@;
 481     # if we didn't die, then we can return it
 482     # NOTE:
 483     # this is not ideal, better suggestions are welcome
 484     eval '\\' . $sigil . $self->name . '::' . $name;
 485 }
 486
 487 sub remove_package_variable {
 488     my ($self, $variable) = @_;
 489     (defined $variable && $variable =~ /^[\$\@\%]/)
 490         || confess "variable name does not have a sigil";
 491     my ($sigil, $name) = ($variable =~ /^(.)(.*)$/);
 492     no strict 'refs';
 493     delete ${$self->name . '::'}{$name};
 494 }
 495
 496 # class mixins
 497
 498 sub mixin {
 499     my ($self, $mixin) = @_;
 500     $mixin = $self->initialize($mixin)
 501         unless blessed($mixin);
 502
 503     my @attributes = map {
 504         $mixin->get_attribute($_)->clone()
 505     } $mixin->get_attribute_list;
 506
 507     my %methods = map  {
 508         my $method = $mixin->get_method($_);
 509         (blessed($method) && $method->isa('Class::MOP::Attribute::Accessor'))
 510             ? () : ($_ => $method)
 511     } $mixin->get_method_list;
 512
 513     foreach my $attr (@attributes) {
 514         $self->add_attribute($attr)
 515             unless $self->has_attribute($attr->name);
 516     }
 517
 518     foreach my $method_name (keys %methods) {
 519         $self->alias_method($method_name => $methods{$method_name})
 520             unless $self->has_method($method_name);
 521     }
 522 }
 523
 524 1;
 525
 526 __END__
 527
 528 =pod
 529
 530 =head1 NAME
 531
 532 Class::MOP::Class - Class Meta Object
 533
 534 =head1 SYNOPSIS
 535
 536   # use this for introspection ...
 537
 538   # add a method to Foo ...
 539   Foo->meta->add_method('bar' => sub { ... })
 540
 541   # get a list of all the classes searched
 542   # the method dispatcher in the correct order
 543   Foo->meta->class_precedence_list()
 544
 545   # remove a method from Foo
 546   Foo->meta->remove_method('bar');
 547
 548   # or use this to actually create classes ...
 549
 550   Class::MOP::Class->create('Bar' => '0.01' => (
 551       superclasses => [ 'Foo' ],
 552       attributes => [
 553           Class::MOP:::Attribute->new('$bar'),
 554           Class::MOP:::Attribute->new('$baz'),
 555       ],
 556       methods => {
 557           calculate_bar => sub { ... },
 558           construct_baz => sub { ... }
 559       }
 560   ));
 561
 562 =head1 DESCRIPTION
 563
 564 This is the largest and currently most complex part of the Perl 5
 565 meta-object protocol. It controls the introspection and
 566 manipulation of Perl 5 classes (and it can create them too). The
 567 best way to understand what this module can do, is to read the
 568 documentation for each of it's methods.
 569
 570 =head1 METHODS
 571
 572 =head2 Self Introspection
 573
 574 =over 4
 575
 576 =item B<meta>
 577
 578 This will return a B<Class::MOP::Class> instance which is related
 579 to this class. Thereby allowing B<Class::MOP::Class> to actually
 580 introspect itself.
 581
 582 As with B<Class::MOP::Attribute>, B<Class::MOP> will actually
 583 bootstrap this module by installing a number of attribute meta-objects
 584 into it's metaclass. This will allow this class to reap all the benifits
 585 of the MOP when subclassing it.
 586
 587 =back
 588
 589 =head2 Class construction
 590
 591 These methods will handle creating B<Class::MOP::Class> objects,
 592 which can be used to both create new classes, and analyze
 593 pre-existing classes.
 594
 595 This module will internally store references to all the instances
 596 you create with these methods, so that they do not need to be
 597 created any more than nessecary. Basically, they are singletons.
 598
 599 =over 4
 600
 601 =item B<create ($package_name, ?$package_version,
 602                 superclasses =E<gt> ?@superclasses,
 603                 methods      =E<gt> ?%methods,
 604                 attributes   =E<gt> ?%attributes)>
 605
 606 This returns a B<Class::MOP::Class> object, bringing the specified
 607 C<$package_name> into existence and adding any of the
 608 C<$package_version>, C<@superclasses>, C<%methods> and C<%attributes>
 609 to it.
 610
 611 =item B<initialize ($package_name)>
 612
 613 This initializes and returns returns a B<Class::MOP::Class> object
 614 for a given a C<$package_name>.
 615
 616 =item B<construct_class_instance (%options)>
 617
 618 This will construct an instance of B<Class::MOP::Class>, it is
 619 here so that we can actually "tie the knot" for B<Class::MOP::Class>
 620 to use C<construct_instance> once all the bootstrapping is done. This
 621 method is used internally by C<initialize> and should never be called
 622 from outside of that method really.
 623
 624 =item B<check_metaclass_compatability>
 625
 626 This method is called as the very last thing in the
 627 C<construct_class_instance> method. This will check that the
 628 metaclass you are creating is compatible with the metaclasses of all
 629 your ancestors. For more inforamtion about metaclass compatibility
 630 see the C<About Metaclass compatibility> section in L<Class::MOP>.
 631
 632 =back
 633
 634 =head2 Object instance construction and cloning
 635
 636 These methods are B<entirely optional>, it is up to you whether you want
 637 to use them or not.
 638
 639 =over 4
 640
 641 =item B<new_object (%params)>
 642
 643 This is a convience method for creating a new object of the class, and
 644 blessing it into the appropriate package as well. Ideally your class
 645 would call a C<new> this method like so:
 646
 647   sub MyClass::new {
 648       my ($class, %param) = @_;
 649       $class->meta->new_object(%params);
 650   }
 651
 652 Of course the ideal place for this would actually be in C<UNIVERSAL::>
 653 but that is considered bad style, so we do not do that.
 654
 655 =item B<construct_instance (%params)>
 656
 657 This method is used to construct an instace structure suitable for
 658 C<bless>-ing into your package of choice. It works in conjunction
 659 with the Attribute protocol to collect all applicable attributes.
 660
 661 This will construct and instance using a HASH ref as storage
 662 (currently only HASH references are supported). This will collect all
 663 the applicable attributes and layout out the fields in the HASH ref,
 664 it will then initialize them using either use the corresponding key
 665 in C<%params> or any default value or initializer found in the
 666 attribute meta-object.
 667
 668 =item B<clone_object ($instance, %params)>
 669
 670 This is a convience method for cloning an object instance, then
 671 blessing it into the appropriate package. Ideally your class
 672 would call a C<clone> this method like so:
 673
 674   sub MyClass::clone {
 675       my ($self, %param) = @_;
 676       $self->meta->clone_object($self, %params);
 677   }
 678
 679 Of course the ideal place for this would actually be in C<UNIVERSAL::>
 680 but that is considered bad style, so we do not do that.
 681
 682 =item B<clone_instance($instance, %params)>
 683
 684 This method is a compliment of C<construct_instance> (which means if
 685 you override C<construct_instance>, you need to override this one too).
 686
 687 This method will clone the C<$instance> structure created by the
 688 C<construct_instance> method, and apply any C<%params> passed to it
 689 to change the attribute values. The structure returned is (like with
 690 C<construct_instance>) an unC<bless>ed HASH reference, it is your
 691 responsibility to then bless this cloned structure into the right
 692 class.
 693
 694 =back
 695
 696 =head2 Informational
 697
 698 =over 4
 699
 700 =item B<name>
 701
 702 This is a read-only attribute which returns the package name for the
 703 given B<Class::MOP::Class> instance.
 704
 705 =item B<version>
 706
 707 This is a read-only attribute which returns the C<$VERSION> of the
 708 package for the given B<Class::MOP::Class> instance.
 709
 710 =back
 711
 712 =head2 Inheritance Relationships
 713
 714 =over 4
 715
 716 =item B<superclasses (?@superclasses)>
 717
 718 This is a read-write attribute which represents the superclass
 719 relationships of the class the B<Class::MOP::Class> instance is
 720 associated with. Basically, it can get and set the C<@ISA> for you.
 721
 722 B<NOTE:>
 723 Perl will occasionally perform some C<@ISA> and method caching, if
 724 you decide to change your superclass relationship at runtime (which
 725 is quite insane and very much not recommened), then you should be
 726 aware of this and the fact that this module does not make any
 727 attempt to address this issue.
 728
 729 =item B<class_precedence_list>
 730
 731 This computes the a list of all the class's ancestors in the same order
 732 in which method dispatch will be done. This is similair to
 733 what B<Class::ISA::super_path> does, but we don't remove duplicate names.
 734
 735 =back
 736
 737 =head2 Methods
 738
 739 =over 4
 740
 741 =item B<method_metaclass>
 742
 743 =item B<add_method ($method_name, $method)>
 744
 745 This will take a C<$method_name> and CODE reference to that
 746 C<$method> and install it into the class's package.
 747
 748 B<NOTE>:
 749 This does absolutely nothing special to C<$method>
 750 other than use B<Sub::Name> to make sure it is tagged with the
 751 correct name, and therefore show up correctly in stack traces and
 752 such.
 753
 754 =item B<alias_method ($method_name, $method)>
 755
 756 This will take a C<$method_name> and CODE reference to that
 757 C<$method> and alias the method into the class's package.
 758
 759 B<NOTE>:
 760 Unlike C<add_method>, this will B<not> try to name the
 761 C<$method> using B<Sub::Name>, it only aliases the method in
 762 the class's package.
 763
 764 =item B<has_method ($method_name)>
 765
 766 This just provides a simple way to check if the class implements
 767 a specific C<$method_name>. It will I<not> however, attempt to check
 768 if the class inherits the method (use C<UNIVERSAL::can> for that).
 769
 770 This will correctly handle functions defined outside of the package
 771 that use a fully qualified name (C<sub Package::name { ... }>).
 772
 773 This will correctly handle functions renamed with B<Sub::Name> and
 774 installed using the symbol tables. However, if you are naming the
 775 subroutine outside of the package scope, you must use the fully
 776 qualified name, including the package name, for C<has_method> to
 777 correctly identify it.
 778
 779 This will attempt to correctly ignore functions imported from other
 780 packages using B<Exporter>. It breaks down if the function imported
 781 is an C<__ANON__> sub (such as with C<use constant>), which very well
 782 may be a valid method being applied to the class.
 783
 784 In short, this method cannot always be trusted to determine if the
 785 C<$method_name> is actually a method. However, it will DWIM about
 786 90% of the time, so it's a small trade off I think.
 787
 788 =item B<get_method ($method_name)>
 789
 790 This will return a CODE reference of the specified C<$method_name>,
 791 or return undef if that method does not exist.
 792
 793 =item B<remove_method ($method_name)>
 794
 795 This will attempt to remove a given C<$method_name> from the class.
 796 It will return the CODE reference that it has removed, and will
 797 attempt to use B<Sub::Name> to clear the methods associated name.
 798
 799 =item B<get_method_list>
 800
 801 This will return a list of method names for all I<locally> defined
 802 methods. It does B<not> provide a list of all applicable methods,
 803 including any inherited ones. If you want a list of all applicable
 804 methods, use the C<compute_all_applicable_methods> method.
 805
 806 =item B<compute_all_applicable_methods>
 807
 808 This will return a list of all the methods names this class will
 809 respond to, taking into account inheritance. The list will be a list of
 810 HASH references, each one containing the following information; method
 811 name, the name of the class in which the method lives and a CODE
 812 reference for the actual method.
 813
 814 =item B<find_all_methods_by_name ($method_name)>
 815
 816 This will traverse the inheritence hierarchy and locate all methods
 817 with a given C<$method_name>. Similar to
 818 C<compute_all_applicable_methods> it returns a list of HASH references
 819 with the following information; method name (which will always be the
 820 same as C<$method_name>), the name of the class in which the method
 821 lives and a CODE reference for the actual method.
 822
 823 The list of methods produced is a distinct list, meaning there are no
 824 duplicates in it. This is especially useful for things like object
 825 initialization and destruction where you only want the method called
 826 once, and in the correct order.
 827
 828 =back
 829
 830 =head2 Attributes
 831
 832 It should be noted that since there is no one consistent way to define
 833 the attributes of a class in Perl 5. These methods can only work with
 834 the information given, and can not easily discover information on
 835 their own. See L<Class::MOP::Attribute> for more details.
 836
 837 =over 4
 838
 839 =item B<attribute_metaclass>
 840
 841 =item B<get_attribute_map>
 842
 843 =item B<add_attribute ($attribute_name, $attribute_meta_object)>
 844
 845 This stores a C<$attribute_meta_object> in the B<Class::MOP::Class>
 846 instance associated with the given class, and associates it with
 847 the C<$attribute_name>. Unlike methods, attributes within the MOP
 848 are stored as meta-information only. They will be used later to
 849 construct instances from (see C<construct_instance> above).
 850 More details about the attribute meta-objects can be found in the
 851 L<Class::MOP::Attribute> or the L<Class::MOP/The Attribute protocol>
 852 section.
 853
 854 It should be noted that any accessor, reader/writer or predicate
 855 methods which the C<$attribute_meta_object> has will be installed
 856 into the class at this time.
 857
 858 =item B<has_attribute ($attribute_name)>
 859
 860 Checks to see if this class has an attribute by the name of
 861 C<$attribute_name> and returns a boolean.
 862
 863 =item B<get_attribute ($attribute_name)>
 864
 865 Returns the attribute meta-object associated with C<$attribute_name>,
 866 if none is found, it will return undef.
 867
 868 =item B<remove_attribute ($attribute_name)>
 869
 870 This will remove the attribute meta-object stored at
 871 C<$attribute_name>, then return the removed attribute meta-object.
 872
 873 B<NOTE:>
 874 Removing an attribute will only affect future instances of
 875 the class, it will not make any attempt to remove the attribute from
 876 any existing instances of the class.
 877
 878 It should be noted that any accessor, reader/writer or predicate
 879 methods which the attribute meta-object stored at C<$attribute_name>
 880 has will be removed from the class at this time. This B<will> make
 881 these attributes somewhat inaccessable in previously created
 882 instances. But if you are crazy enough to do this at runtime, then
 883 you are crazy enough to deal with something like this :).
 884
 885 =item B<get_attribute_list>
 886
 887 This returns a list of attribute names which are defined in the local
 888 class. If you want a list of all applicable attributes for a class,
 889 use the C<compute_all_applicable_attributes> method.
 890
 891 =item B<compute_all_applicable_attributes>
 892
 893 This will traverse the inheritance heirachy and return a list of all
 894 the applicable attributes for this class. It does not construct a
 895 HASH reference like C<compute_all_applicable_methods> because all
 896 that same information is discoverable through the attribute
 897 meta-object itself.
 898
 899 =back
 900
 901 =head2 Package Variables
 902
 903 Since Perl's classes are built atop the Perl package system, it is
 904 fairly common to use package scoped variables for things like static
 905 class variables. The following methods are convience methods for
 906 the creation and inspection of package scoped variables.
 907
 908 =over 4
 909
 910 =item B<add_package_variable ($variable_name, ?$initial_value)>
 911
 912 Given a C<$variable_name>, which must contain a leading sigil, this
 913 method will create that variable within the package which houses the
 914 class. It also takes an optional C<$initial_value>, which must be a
 915 reference of the same type as the sigil of the C<$variable_name>
 916 implies.
 917
 918 =item B<get_package_variable ($variable_name)>
 919
 920 This will return a reference to the package variable in
 921 C<$variable_name>.
 922
 923 =item B<has_package_variable ($variable_name)>
 924
 925 Returns true (C<1>) if there is a package variable defined for
 926 C<$variable_name>, and false (C<0>) otherwise.
 927
 928 =item B<remove_package_variable ($variable_name)>
 929
 930 This will attempt to remove the package variable at C<$variable_name>.
 931
 932 =back
 933
 934 =head1 AUTHOR
 935
 936 Stevan Little E<lt>stevan@iinteractive.comE<gt>
 937
 938 =head1 COPYRIGHT AND LICENSE
 939
 940 Copyright 2006 by Infinity Interactive, Inc.
 941
 942 L<http://www.iinteractive.com>
 943
 944 This library is free software; you can redistribute it and/or modify
 945 it under the same terms as Perl itself.
 946
 947 =cut