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