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