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