X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FClass%2FMOP%2FClass.pm;h=6ef28d4e1035eca1d89c174fe0acc7faafc7fd44;hb=d5d2fbb799207b6da4a57072e42fe3617d9f91b0;hp=b953e3698c8f82ea21116fa7385cf965feb72b9c;hpb=f3ed8a15026e579291b5a8982930bc45d5e44126;p=gitmo%2FClass-MOP.git diff --git a/lib/Class/MOP/Class.pm b/lib/Class/MOP/Class.pm index b953e36..6ef28d4 100644 --- a/lib/Class/MOP/Class.pm +++ b/lib/Class/MOP/Class.pm @@ -14,12 +14,15 @@ use Scalar::Util 'blessed', 'reftype', 'weaken'; use Sub::Name 'subname'; use Devel::GlobalDestruction 'in_global_destruction'; use Try::Tiny; +use List::MoreUtils 'all'; -our $VERSION = '0.94'; +our $VERSION = '1.07'; $VERSION = eval $VERSION; our $AUTHORITY = 'cpan:STEVAN'; -use base 'Class::MOP::Module'; +use base 'Class::MOP::Module', + 'Class::MOP::Mixin::HasAttributes', + 'Class::MOP::Mixin::HasMethods'; # Creation @@ -64,15 +67,10 @@ sub _construct_class_instance { return $meta; } - # NOTE: - # we need to deal with the possibility - # of class immutability here, and then - # get the name of the class appropriately - $class = (ref($class) - ? ($class->is_immutable - ? $class->_get_mutable_metaclass_name() - : ref($class)) - : $class); + $class + = ref $class + ? $class->_real_ref_name + : $class; # now create the metaclass my $meta; @@ -100,6 +98,16 @@ sub _construct_class_instance { $meta; } +sub _real_ref_name { + my $self = shift; + + # NOTE: we need to deal with the possibility of class immutability here, + # and then get the name of the class appropriately + return $self->is_immutable + ? $self->_get_mutable_metaclass_name() + : ref $self; +} + sub _new { my $class = shift; @@ -165,40 +173,223 @@ sub update_package_cache_flag { $self->{'_package_cache_flag'} = Class::MOP::check_package_cache_flag($self->name); } +## Metaclass compatibility +{ + my %base_metaclass = ( + attribute_metaclass => 'Class::MOP::Attribute', + method_metaclass => 'Class::MOP::Method', + wrapped_method_metaclass => 'Class::MOP::Method::Wrapped', + instance_metaclass => 'Class::MOP::Instance', + constructor_class => 'Class::MOP::Method::Constructor', + destructor_class => 'Class::MOP::Method::Destructor', + ); + + sub _base_metaclasses { %base_metaclass } +} + sub _check_metaclass_compatibility { my $self = shift; + my @superclasses = $self->superclasses + or return; + + $self->_fix_metaclass_incompatibility(@superclasses); + + my %base_metaclass = $self->_base_metaclasses; + # this is always okay ... - return if ref($self) eq 'Class::MOP::Class' && - $self->instance_metaclass eq 'Class::MOP::Instance'; + return + if ref($self) eq 'Class::MOP::Class' + && all { + my $meta = $self->$_; + !defined($meta) || $meta eq $base_metaclass{$_}; + } + keys %base_metaclass; - my @class_list = $self->linearized_isa; - shift @class_list; # shift off $self->name + for my $superclass (@superclasses) { + $self->_check_class_metaclass_compatibility($superclass); + } - foreach my $superclass_name (@class_list) { - my $super_meta = Class::MOP::get_metaclass_by_name($superclass_name) || next; + for my $metaclass_type ( keys %base_metaclass ) { + next unless defined $self->$metaclass_type; + for my $superclass (@superclasses) { + $self->_check_single_metaclass_compatibility( $metaclass_type, + $superclass ); + } + } +} - # NOTE: - # we need to deal with the possibility - # of class immutability here, and then - # get the name of the class appropriately - my $super_meta_type - = $super_meta->is_immutable - ? $super_meta->_get_mutable_metaclass_name() - : ref($super_meta); - - ($self->isa($super_meta_type)) - || confess "The metaclass of " . $self->name . " (" - . (ref($self)) . ")" . " is not compatible with the " . - "metaclass of its superclass, ".$superclass_name . " (" - . ($super_meta_type) . ")"; - # NOTE: - # we also need to check that instance metaclasses - # are compatibile in the same the class. - ($self->instance_metaclass->isa($super_meta->instance_metaclass)) - || confess "The instance metaclass for " . $self->name . " (" . ($self->instance_metaclass) . ")" . - " is not compatible with the " . - "instance metaclass of its superclass, " . $superclass_name . " (" . ($super_meta->instance_metaclass) . ")"; +sub _class_metaclass_is_compatible { + my $self = shift; + my ( $superclass_name ) = @_; + + my $super_meta = Class::MOP::get_metaclass_by_name($superclass_name) + || return 1; + + my $super_meta_type = $super_meta->_real_ref_name; + + return $self->isa($super_meta_type); +} + +sub _check_class_metaclass_compatibility { + my $self = shift; + my ( $superclass_name ) = @_; + + if (!$self->_class_metaclass_is_compatible($superclass_name)) { + my $super_meta = Class::MOP::get_metaclass_by_name($superclass_name); + + my $super_meta_type = $super_meta->_real_ref_name; + + confess "The metaclass of " . $self->name . " (" + . (ref($self)) . ")" . " is not compatible with " + . "the metaclass of its superclass, " + . $superclass_name . " (" . ($super_meta_type) . ")"; + } +} + +sub _single_metaclass_is_compatible { + my $self = shift; + my ( $metaclass_type, $superclass_name ) = @_; + + my $super_meta = Class::MOP::get_metaclass_by_name($superclass_name) + || return 1; + + # for instance, Moose::Meta::Class has a error_class attribute, but + # Class::MOP::Class doesn't - this shouldn't be an error + return 1 unless $super_meta->can($metaclass_type); + # for instance, Moose::Meta::Class has a destructor_class, but + # Class::MOP::Class doesn't - this shouldn't be an error + return 1 unless defined $super_meta->$metaclass_type; + # if metaclass is defined in superclass but not here, it's not compatible + # this is a really odd case + return 0 unless defined $self->$metaclass_type; + + return $self->$metaclass_type->isa($super_meta->$metaclass_type); +} + +sub _check_single_metaclass_compatibility { + my $self = shift; + my ( $metaclass_type, $superclass_name ) = @_; + + if (!$self->_single_metaclass_is_compatible($metaclass_type, $superclass_name)) { + my $super_meta = Class::MOP::get_metaclass_by_name($superclass_name); + my $metaclass_type_name = $metaclass_type; + $metaclass_type_name =~ s/_(?:meta)?class$//; + $metaclass_type_name =~ s/_/ /g; + confess "The $metaclass_type_name metaclass for " + . $self->name . " (" . ($self->$metaclass_type) + . ")" . " is not compatible with the " + . "$metaclass_type_name metaclass of its " + . "superclass, " . $superclass_name . " (" + . ($super_meta->$metaclass_type) . ")"; + } +} + +sub _can_fix_class_metaclass_incompatibility_by_subclassing { + my $self = shift; + my ($super_meta) = @_; + + my $super_meta_type = $super_meta->_real_ref_name; + + return $super_meta_type ne blessed($self) + && $super_meta->isa(blessed($self)); +} + +sub _can_fix_single_metaclass_incompatibility_by_subclassing { + my $self = shift; + my ($metaclass_type, $super_meta) = @_; + + my $specific_meta = $self->$metaclass_type; + return unless $super_meta->can($metaclass_type); + my $super_specific_meta = $super_meta->$metaclass_type; + + # for instance, Moose::Meta::Class has a destructor_class, but + # Class::MOP::Class doesn't - this shouldn't be an error + return unless defined $super_specific_meta; + + # if metaclass is defined in superclass but not here, it's fixable + # this is a really odd case + return 1 unless defined $specific_meta; + + return $specific_meta ne $super_specific_meta + && $super_specific_meta->isa($specific_meta); +} + +sub _can_fix_metaclass_incompatibility_by_subclassing { + my $self = shift; + my ($super_meta) = @_; + + return 1 if $self->_can_fix_class_metaclass_incompatibility_by_subclassing($super_meta); + + my %base_metaclass = $self->_base_metaclasses; + for my $metaclass_type (keys %base_metaclass) { + return 1 if $self->_can_fix_single_metaclass_incompatibility_by_subclassing($metaclass_type, $super_meta); + } + + return; +} + +sub _can_fix_metaclass_incompatibility { + my $self = shift; + return $self->_can_fix_metaclass_incompatibility_by_subclassing(@_); +} + +sub _fix_metaclass_incompatibility { + my $self = shift; + my @supers = map { Class::MOP::Class->initialize($_) } @_; + + my $necessary = 0; + for my $super (@supers) { + $necessary = 1 + if $self->_can_fix_metaclass_incompatibility($super); + } + return unless $necessary; + + for my $super (@supers) { + if (!$self->_class_metaclass_is_compatible($super->name)) { + $self->_fix_class_metaclass_incompatibility($super); + } + } + + my %base_metaclass = $self->_base_metaclasses; + for my $metaclass_type (keys %base_metaclass) { + for my $super (@supers) { + if (!$self->_single_metaclass_is_compatible($metaclass_type, $super->name)) { + $self->_fix_single_metaclass_incompatibility( + $metaclass_type, $super + ); + } + } + } +} + +sub _fix_class_metaclass_incompatibility { + my $self = shift; + my ( $super_meta ) = @_; + + if ($self->_can_fix_class_metaclass_incompatibility_by_subclassing($super_meta)) { + ($self->is_pristine) + || confess "Can't fix metaclass incompatibility for " + . $self->name + . " because it is not pristine."; + + my $super_meta_name = $super_meta->_real_ref_name; + + $super_meta_name->meta->rebless_instance($self); + } +} + +sub _fix_single_metaclass_incompatibility { + my $self = shift; + my ( $metaclass_type, $super_meta ) = @_; + + if ($self->_can_fix_single_metaclass_incompatibility_by_subclassing($metaclass_type, $super_meta)) { + ($self->is_pristine) + || confess "Can't fix metaclass incompatibility for " + . $self->name + . " because it is not pristine."; + + $self->{$metaclass_type} = $super_meta->$metaclass_type; } } @@ -244,6 +435,7 @@ sub _check_metaclass_compatibility { no warnings 'uninitialized'; my $name = $self->name; return unless $name =~ /^$ANON_CLASS_PREFIX/o; + # Moose does a weird thing where it replaces the metaclass for # class when fixing metaclass incompatibility. In that case, # we don't want to clean out the namespace now. We can detect @@ -329,8 +521,6 @@ sub create { # all these attribute readers will be bootstrapped # away in the Class::MOP bootstrap section -sub get_attribute_map { $_[0]->{'attributes'} } -sub attribute_metaclass { $_[0]->{'attribute_metaclass'} } sub instance_metaclass { $_[0]->{'instance_metaclass'} } sub immutable_trait { $_[0]->{'immutable_trait'} } sub constructor_class { $_[0]->{'constructor_class'} } @@ -360,7 +550,21 @@ sub _construct_instance { # the code below is almost certainly incorrect # but this is foreign inheritance, so we might # have to kludge it in the end. - my $instance = $params->{__INSTANCE__} || $meta_instance->create_instance(); + my $instance; + if (my $instance_class = blessed($params->{__INSTANCE__})) { + ($instance_class eq $class->name) + || confess "Objects passed as the __INSTANCE__ parameter must " + . "already be blessed into the correct class, but " + . "$params->{__INSTANCE__} is not a " . $class->name; + $instance = $params->{__INSTANCE__}; + } + elsif (exists $params->{__INSTANCE__}) { + confess "The __INSTANCE__ parameter must be a blessed reference, not " + . $params->{__INSTANCE__}; + } + else { + $instance = $meta_instance->create_instance(); + } foreach my $attr ($class->get_all_attributes()) { $attr->initialize_instance_slot($meta_instance, $instance, $params); } @@ -466,18 +670,105 @@ sub rebless_instance { $instance; } +sub rebless_instance_back { + my ( $self, $instance ) = @_; + + my $old_metaclass = Class::MOP::class_of($instance); + + my $old_class + = $old_metaclass ? $old_metaclass->name : blessed($instance); + $old_class->isa( $self->name ) + || confess + "You may rebless only into a superclass of ($old_class), of which (" + . $self->name + . ") isn't."; + + $old_metaclass->rebless_instance_away( $instance, $self ) + if $old_metaclass; + + my $meta_instance = $self->get_meta_instance; + + # we use $_[1] here because of t/306_rebless_overload.t regressions on 5.8.8 + $meta_instance->rebless_instance_structure( $_[1], $self ); + + for my $attr ( $old_metaclass->get_all_attributes ) { + next if $self->has_attribute( $attr->name ); + $meta_instance->deinitialize_slot( $instance, $_ ) for $attr->slots; + } + + return $instance; +} + sub rebless_instance_away { # this intentionally does nothing, it is just a hook } +sub _attach_attribute { + my ($self, $attribute) = @_; + $attribute->attach_to_class($self); +} + +sub _post_add_attribute { + my ( $self, $attribute ) = @_; + + $self->invalidate_meta_instances; + + # invalidate package flag here + try { + local $SIG{__DIE__}; + $attribute->install_accessors; + } + catch { + $self->remove_attribute( $attribute->name ); + die $_; + }; +} + +sub remove_attribute { + my $self = shift; + + my $removed_attribute = $self->SUPER::remove_attribute(@_) + or return; + + $self->invalidate_meta_instances; + + $removed_attribute->remove_accessors; + $removed_attribute->detach_from_class; + + return$removed_attribute; +} + +sub find_attribute_by_name { + my ( $self, $attr_name ) = @_; + + foreach my $class ( $self->linearized_isa ) { + # fetch the meta-class ... + my $meta = Class::MOP::Class->initialize($class); + return $meta->get_attribute($attr_name) + if $meta->has_attribute($attr_name); + } + + return; +} + +sub get_all_attributes { + my $self = shift; + my %attrs = map { %{ Class::MOP::Class->initialize($_)->_attribute_map } } + reverse $self->linearized_isa; + return values %attrs; +} + # Inheritance sub superclasses { my $self = shift; - my $var_spec = { sigil => '@', type => 'ARRAY', name => 'ISA' }; + + my $isa = $self->get_package_symbol( + { sigil => '@', type => 'ARRAY', name => 'ISA' } ); + if (@_) { my @supers = @_; - @{$self->get_package_symbol($var_spec)} = @supers; + @{$isa} = @supers; # NOTE: # on 5.8 and below, we need to call @@ -496,7 +787,8 @@ sub superclasses { $self->_check_metaclass_compatibility(); $self->_superclasses_updated(); } - @{$self->get_package_symbol($var_spec)}; + + return @{$isa}; } sub _superclasses_updated { @@ -554,7 +846,7 @@ sub class_precedence_list { return ( $name, map { - $self->initialize($_)->class_precedence_list() + Class::MOP::Class->initialize($_)->class_precedence_list() } $self->superclasses() ); } @@ -643,7 +935,7 @@ sub find_method_by_name { (defined $method_name && length $method_name) || confess "You must define a method name to find"; foreach my $class ($self->linearized_isa) { - my $method = $self->initialize($class)->get_method($method_name); + my $method = Class::MOP::Class->initialize($class)->get_method($method_name); return $method if defined $method; } return; @@ -654,10 +946,9 @@ sub get_all_methods { my %methods; for my $class ( reverse $self->linearized_isa ) { - my $meta = $self->initialize($class); + my $meta = Class::MOP::Class->initialize($class); - $methods{$_} = $meta->get_method($_) - for $meta->get_method_list; + $methods{ $_->name } = $_ for $meta->_get_local_methods; } return values %methods; @@ -666,7 +957,7 @@ sub get_all_methods { sub get_all_method_names { my $self = shift; my %uniq; - return grep { !$uniq{$_}++ } map { $self->initialize($_)->get_method_list } $self->linearized_isa; + return grep { !$uniq{$_}++ } map { Class::MOP::Class->initialize($_)->get_method_list } $self->linearized_isa; } sub find_all_methods_by_name { @@ -676,7 +967,7 @@ sub find_all_methods_by_name { my @methods; foreach my $class ($self->linearized_isa) { # fetch the meta-class ... - my $meta = $self->initialize($class); + my $meta = Class::MOP::Class->initialize($class); push @methods => { name => $method_name, class => $class, @@ -693,61 +984,12 @@ sub find_next_method_by_name { my @cpl = $self->linearized_isa; shift @cpl; # discard ourselves foreach my $class (@cpl) { - my $method = $self->initialize($class)->get_method($method_name); + my $method = Class::MOP::Class->initialize($class)->get_method($method_name); return $method if defined $method; } return; } -## Attributes - -sub add_attribute { - my $self = shift; - # either we have an attribute object already - # or we need to create one from the args provided - my $attribute = blessed($_[0]) ? $_[0] : $self->attribute_metaclass->new(@_); - # make sure it is derived from the correct type though - ($attribute->isa('Class::MOP::Attribute')) - || confess "Your attribute must be an instance of Class::MOP::Attribute (or a subclass)"; - - # first we attach our new attribute - # because it might need certain information - # about the class which it is attached to - $attribute->attach_to_class($self); - - my $attr_name = $attribute->name; - - # then we remove attributes of a conflicting - # name here so that we can properly detach - # the old attr object, and remove any - # accessors it would have generated - if ( $self->has_attribute($attr_name) ) { - $self->remove_attribute($attr_name); - } else { - $self->invalidate_meta_instances(); - } - - # get our count of previously inserted attributes and - # increment by one so this attribute knows its order - my $order = (scalar keys %{$self->get_attribute_map}); - $attribute->_set_insertion_order($order); - - # then onto installing the new accessors - $self->get_attribute_map->{$attr_name} = $attribute; - - # invalidate package flag here - try { - local $SIG{__DIE__}; - $attribute->install_accessors(); - } - catch { - $self->remove_attribute($attr_name); - die $_; - }; - - return $attribute; -} - sub update_meta_instance_dependencies { my $self = shift; @@ -764,9 +1006,10 @@ sub add_meta_instance_dependencies { my @attrs = $self->get_all_attributes(); my %seen; - my @classes = grep { not $seen{$_->name}++ } map { $_->associated_class } @attrs; + my @classes = grep { not $seen{ $_->name }++ } + map { $_->associated_class } @attrs; - foreach my $class ( @classes ) { + foreach my $class (@classes) { $class->add_dependent_meta_instance($self); } @@ -777,7 +1020,7 @@ sub remove_meta_instance_dependencies { my $self = shift; if ( my $classes = delete $self->{meta_instance_dependencies} ) { - foreach my $class ( @$classes ) { + foreach my $class (@$classes) { $class->remove_dependent_meta_instance($self); } @@ -796,12 +1039,14 @@ sub add_dependent_meta_instance { sub remove_dependent_meta_instance { my ( $self, $metaclass ) = @_; my $name = $metaclass->name; - @$_ = grep { $_->name ne $name } @$_ for $self->{dependent_meta_instances}; + @$_ = grep { $_->name ne $name } @$_ + for $self->{dependent_meta_instances}; } sub invalidate_meta_instances { my $self = shift; - $_->invalidate_meta_instance() for $self, @{ $self->{dependent_meta_instances} }; + $_->invalidate_meta_instance() + for $self, @{ $self->{dependent_meta_instances} }; } sub invalidate_meta_instance { @@ -809,59 +1054,6 @@ sub invalidate_meta_instance { undef $self->{_meta_instance}; } -sub has_attribute { - my ($self, $attribute_name) = @_; - (defined $attribute_name) - || confess "You must define an attribute name"; - exists $self->get_attribute_map->{$attribute_name}; -} - -sub get_attribute { - my ($self, $attribute_name) = @_; - (defined $attribute_name) - || confess "You must define an attribute name"; - return $self->get_attribute_map->{$attribute_name} - # NOTE: - # this will return undef anyway, so no need ... - # if $self->has_attribute($attribute_name); - #return; -} - -sub remove_attribute { - my ($self, $attribute_name) = @_; - (defined $attribute_name) - || confess "You must define an attribute name"; - my $removed_attribute = $self->get_attribute_map->{$attribute_name}; - return unless defined $removed_attribute; - delete $self->get_attribute_map->{$attribute_name}; - $self->invalidate_meta_instances(); - $removed_attribute->remove_accessors(); - $removed_attribute->detach_from_class(); - return $removed_attribute; -} - -sub get_attribute_list { - my $self = shift; - keys %{$self->get_attribute_map}; -} - -sub get_all_attributes { - my $self = shift; - my %attrs = map { %{ $self->initialize($_)->get_attribute_map } } reverse $self->linearized_isa; - return values %attrs; -} - -sub find_attribute_by_name { - my ($self, $attr_name) = @_; - foreach my $class ($self->linearized_isa) { - # fetch the meta-class ... - my $meta = $self->initialize($class); - return $meta->get_attribute($attr_name) - if $meta->has_attribute($attr_name); - } - return; -} - # check if we can reinitialize sub is_pristine { my $self = shift; @@ -969,10 +1161,7 @@ sub _immutable_metaclass { # metaclass roles applied (via Moose), then we want to make sure # that we preserve that anonymous class (see Fey::ORM for an # example of where this matters). - my $meta_name - = $meta->is_immutable - ? $meta->_get_mutable_metaclass_name - : ref $meta; + my $meta_name = $meta->_real_ref_name; my $immutable_meta = $meta_name->create( $class_name, @@ -1051,6 +1240,8 @@ sub _inline_constructor { my ( $self, %args ) = @_; my $name = $args{constructor_name}; + # A class may not even have a constructor, and that's okay. + return unless defined $name; if ( $self->has_method($name) && !$args{replace_constructor} ) { my $class = $self->name; @@ -1293,6 +1484,15 @@ will be passed the instance, the new metaclass, and any parameters specified to C. By default, C does nothing; it is merely a hook. +=item B<< $metaclass->rebless_instance_back($instance) >> + +Does the same thing as C, except that you can only +rebless an instance into one of its superclasses. Any attributes that +do not exist in the superclass will be deinitialized. + +This is a much more dangerous operation than C, +especially when multiple inheritance is involved, so use this carefully! + =item B<< $metaclass->new_object(%params) >> This method is used to create a new object of the metaclass's @@ -1375,14 +1575,76 @@ include indirect subclasses. =back -=head2 Method introspection +=head2 Method introspection and creation -See L for -methods that operate only on the current class. Class::MOP::Class adds -introspection capabilities that take inheritance into account. +These methods allow you to introspect a class's methods, as well as +add, remove, or change methods. + +Determining what is truly a method in a Perl 5 class requires some +heuristics (aka guessing). + +Methods defined outside the package with a fully qualified name (C) will be included. Similarly, methods named +with a fully qualified name using L are also included. + +However, we attempt to ignore imported functions. + +Ultimately, we are using heuristics to determine what truly is a +method in a class, and these heuristics may get the wrong answer in +some edge cases. However, for most "normal" cases the heuristics work +correctly. =over 4 +=item B<< $metaclass->get_method($method_name) >> + +This will return a L for the specified +C<$method_name>. If the class does not have the specified method, it +returns C + +=item B<< $metaclass->has_method($method_name) >> + +Returns a boolean indicating whether or not the class defines the +named method. It does not include methods inherited from parent +classes. + +=item B<< $metaclass->get_method_list >> + +This will return a list of method I for all methods defined in +this class. + +=item B<< $metaclass->add_method($method_name, $method) >> + +This method takes a method name and a subroutine reference, and adds +the method to the class. + +The subroutine reference can be a L, and you are +strongly encouraged to pass a meta method object instead of a code +reference. If you do so, that object gets stored as part of the +class's method map directly. If not, the meta information will have to +be recreated later, and may be incorrect. + +If you provide a method object, this method will clone that object if +the object's package name does not match the class name. This lets us +track the original source of any methods added from other classes +(notably Moose roles). + +=item B<< $metaclass->remove_method($method_name) >> + +Remove the named method from the class. This method returns the +L object for the method. + +=item B<< $metaclass->method_metaclass >> + +Returns the class name of the method metaclass, see +L for more information on the method metaclass. + +=item B<< $metaclass->wrapped_method_metaclass >> + +Returns the class name of the wrapped method metaclass, see +L for more information on the wrapped +method metaclass. + =item B<< $metaclass->get_all_methods >> This will traverse the inheritance hierarchy and return a list of all @@ -1446,16 +1708,11 @@ Returns a boolean indicating whether or not the class defines the named attribute. It does not include attributes inherited from parent classes. -=item B<< $metaclass->get_attribute_map >> - -Returns a hash reference representing the attributes defined in this -class. The keys are attribute names and the values are -L objects. - =item B<< $metaclass->get_attribute_list >> This will return a list of attributes I for all attributes -defined in this class. +defined in this class. Note that this operates on the current class +only, it does not traverse the inheritance hierarchy. =item B<< $metaclass->get_all_attributes >> @@ -1720,7 +1977,7 @@ Stevan Little Estevan@iinteractive.comE =head1 COPYRIGHT AND LICENSE -Copyright 2006-2009 by Infinity Interactive, Inc. +Copyright 2006-2010 by Infinity Interactive, Inc. L