X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FClass%2FMOP%2FClass.pm;h=1f847ab898834312579baf832d1801f4c9eddc97;hb=b4bd10ecd2eabe1a2c1bc3addad22b207f6592ee;hp=8be7f812e8f46427de78e760563e4a5c7413e4cd;hpb=3a683b397673ee5ed7788873ff77f0db92eda011;p=gitmo%2FClass-MOP.git diff --git a/lib/Class/MOP/Class.pm b/lib/Class/MOP/Class.pm index 8be7f81..1f847ab 100644 --- a/lib/Class/MOP/Class.pm +++ b/lib/Class/MOP/Class.pm @@ -11,7 +11,7 @@ use Class::MOP::Method::Wrapped; use Carp 'confess'; use Scalar::Util 'blessed', 'weaken'; -our $VERSION = '0.73'; +our $VERSION = '0.77'; $VERSION = eval $VERSION; our $AUTHORITY = 'cpan:STEVAN'; @@ -103,7 +103,7 @@ sub _new { bless { # inherited from Class::MOP::Package - 'package' => $options->{package}, + 'package' => $options->{package}, # NOTE: # since the following attributes will @@ -113,18 +113,25 @@ sub _new { # listed here for reference, because they # should not actually have a value associated # with the slot. - 'namespace' => \undef, + 'namespace' => \undef, + # inherited from Class::MOP::Module - 'version' => \undef, - 'authority' => \undef, + 'version' => \undef, + 'authority' => \undef, + # defined in Class::MOP::Class - 'superclasses' => \undef, + 'superclasses' => \undef, 'methods' => {}, 'attributes' => {}, - 'attribute_metaclass' => $options->{'attribute_metaclass'} || 'Class::MOP::Attribute', - 'method_metaclass' => $options->{'method_metaclass'} || 'Class::MOP::Method', - 'instance_metaclass' => $options->{'instance_metaclass'} || 'Class::MOP::Instance', + 'attribute_metaclass' => $options->{'attribute_metaclass'} + || 'Class::MOP::Attribute', + 'method_metaclass' => $options->{'method_metaclass'} + || 'Class::MOP::Method', + 'wrapped_method_metaclass' => $options->{'wrapped_method_metaclass'} + || 'Class::MOP::Method::Wrapped', + 'instance_metaclass' => $options->{'instance_metaclass'} + || 'Class::MOP::Instance', }, $class; } @@ -306,10 +313,11 @@ 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 method_metaclass { $_[0]->{'method_metaclass'} } -sub instance_metaclass { $_[0]->{'instance_metaclass'} } +sub get_attribute_map { $_[0]->{'attributes'} } +sub attribute_metaclass { $_[0]->{'attribute_metaclass'} } +sub method_metaclass { $_[0]->{'method_metaclass'} } +sub wrapped_method_metaclass { $_[0]->{'wrapped_method_metaclass'} } +sub instance_metaclass { $_[0]->{'instance_metaclass'} } sub get_method_map { my $self = shift; @@ -658,6 +666,7 @@ sub add_method { { my $fetch_and_prepare_method = sub { my ($self, $method_name) = @_; + my $wrapped_metaclass = $self->wrapped_method_metaclass; # fetch it locally my $method = $self->get_method($method_name); # if we dont have local ... @@ -670,12 +679,12 @@ sub add_method { # and now make sure to wrap it # even if it is already wrapped # because we need a new sub ref - $method = Class::MOP::Method::Wrapped->wrap($method); + $method = $wrapped_metaclass->wrap($method); } else { # now make sure we wrap it properly - $method = Class::MOP::Method::Wrapped->wrap($method) - unless $method->isa('Class::MOP::Method::Wrapped'); + $method = $wrapped_metaclass->wrap($method) + unless $method->isa($wrapped_metaclass); } $self->add_method($method_name => $method); return $method; @@ -744,12 +753,6 @@ sub get_method { (defined $method_name && $method_name) || confess "You must define a method name"; - # NOTE: - # I don't really need this here, because - # if the method_map is missing a key it - # will just return undef for me now - # return unless $self->has_method($method_name); - return $self->{methods}{$method_name} || $self->get_method_map->{$method_name}; } @@ -806,6 +809,12 @@ sub compute_all_applicable_methods { } shift->get_all_methods(@_); } +sub get_all_method_names { + my $self = shift; + my %uniq; + grep { $uniq{$_}++ == 0 } map { $_->name } $self->get_all_methods; +} + sub find_all_methods_by_name { my ($self, $method_name) = @_; (defined $method_name && $method_name) @@ -1055,8 +1064,7 @@ sub is_immutable { 0 } sub get_immutable_transformer { my $self = shift; if( $self->is_mutable ){ - my $class = ref $self || $self; - return $IMMUTABLE_TRANSFORMERS{$class} ||= $self->create_immutable_transformer; + return $IMMUTABLE_TRANSFORMERS{$self->name} ||= $self->create_immutable_transformer; } confess "unable to find transformer for immutable class" unless exists $IMMUTABLE_OPTIONS{$self->name}; @@ -1107,6 +1115,7 @@ sub create_immutable_transformer { class_precedence_list => 'ARRAY', linearized_isa => 'ARRAY', # FIXME perl 5.10 memoizes this on its own, no need? get_all_methods => 'ARRAY', + get_all_method_names => 'ARRAY', #get_all_attributes => 'ARRAY', # it's an alias, no need, but maybe in the future compute_all_applicable_attributes => 'ARRAY', get_meta_instance => 'SCALAR', @@ -1250,8 +1259,9 @@ as we use a special reserved slot (C<__MOP__>) to store this. =item B -This initializes and returns returns a B object -for a given a C<$package_name>. +This initializes and returns returns a B object for +a given a C<$package_name>. If a metaclass already exists for the +package, it simply returns it instead of creating a new one. =item B @@ -1460,7 +1470,8 @@ This returns a list of subclasses for this class. =item B -Returns a HASH ref of name to CODE reference mapping for this class. +Returns a HASH ref of name to L instance mapping +for this class. =item B @@ -1526,16 +1537,17 @@ CODE reference, see L for more information. =item B -This will return a CODE reference of the specified C<$method_name>, -or return undef if that method does not exist. +This will return a L instance for the specified +C<$method_name>, or return undef if that method does not exist. Unlike C this will also look in the superclasses. =item B This will attempt to remove a given C<$method_name> from the class. -It will return the CODE reference that it has removed, and will -attempt to use B to clear the methods associated name. +It will return the L instance that it has removed, +and will attempt to use B to clear the methods associated +name. =item B @@ -1559,6 +1571,12 @@ class. Use L, which is easier/better/faster. This method predates L. +=item B + +This will traverse the inheritance heirachy and return a list of all the +applicable method names for this class. Duplicate names are removed, but the +order the methods come out is not defined. + =item B This will traverse the inheritence hierarchy and locate all methods @@ -1620,8 +1638,10 @@ the call tree might looks something like this: around 2 around 1 primary - after 1 - after 2 + around 1 + around 2 + after 1 + after 2 To see examples of using method modifiers, see the following examples included in the distribution; F, F,