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