adding in the linearized_isa method

[gitmo/Class-MOP.git] / lib / Class / MOP / Class.pm

diff --git a/lib/Class/MOP/Class.pm b/lib/Class/MOP/Class.pm
index e3b70d1..1dc8e24 100644 (file)
--- a/lib/Class/MOP/Class.pm
+++ b/lib/Class/MOP/Class.pm
@@ -13,7 +13,7 @@ use Scalar::Util 'blessed', 'reftype', 'weaken';
 use Sub::Name    'subname';
 use B            'svref_2object';
 
-our $VERSION   = '0.23';
+our $VERSION   = '0.24';
 our $AUTHORITY = 'cpan:STEVAN';
 
 use base 'Class::MOP::Module';
@@ -134,7 +134,7 @@ sub check_metaclass_compatability {
     return if blessed($self)            eq 'Class::MOP::Class'   &&
               $self->instance_metaclass eq 'Class::MOP::Instance';
 
-    my @class_list = $self->class_precedence_list;
+    my @class_list = $self->linearized_isa;
     shift @class_list; # shift off $self->name
 
     foreach my $class_name (@class_list) {
@@ -386,6 +386,11 @@ sub superclasses {
     @{$self->get_package_symbol('@ISA')};
 }
 
+sub linearized_isa {
+    my %seen;
+    grep { !($seen{$_}++) } (shift)->class_precedence_list
+}
+
 sub class_precedence_list {
     my $self = shift;
     # NOTE:
@@ -549,15 +554,7 @@ sub find_method_by_name {
     my ($self, $method_name) = @_;
     (defined $method_name && $method_name)
         || confess "You must define a method name to find";
-    # keep a record of what we have seen
-    # here, this will handle all the
-    # inheritence issues because we are
-    # using the &class_precedence_list
-    my %seen_class;
-    my @cpl = $self->class_precedence_list();
-    foreach my $class (@cpl) {
-        next if $seen_class{$class};
-        $seen_class{$class}++;
+    foreach my $class ($self->linearized_isa) {
         # fetch the meta-class ...
         my $meta = $self->initialize($class);
         return $meta->get_method($method_name)
@@ -568,15 +565,8 @@ sub find_method_by_name {
 
 sub compute_all_applicable_methods {
     my $self = shift;
-    my @methods;
-    # keep a record of what we have seen
-    # here, this will handle all the
-    # inheritence issues because we are
-    # using the &class_precedence_list
-    my (%seen_class, %seen_method);
-    foreach my $class ($self->class_precedence_list()) {
-        next if $seen_class{$class};
-        $seen_class{$class}++;
+    my (@methods, %seen_method);
+    foreach my $class ($self->linearized_isa) {
         # fetch the meta-class ...
         my $meta = $self->initialize($class);
         foreach my $method_name ($meta->get_method_list()) {
@@ -597,14 +587,7 @@ sub find_all_methods_by_name {
     (defined $method_name && $method_name)
         || confess "You must define a method name to find";
     my @methods;
-    # keep a record of what we have seen
-    # here, this will handle all the
-    # inheritence issues because we are
-    # using the &class_precedence_list
-    my %seen_class;
-    foreach my $class ($self->class_precedence_list()) {
-        next if $seen_class{$class};
-        $seen_class{$class}++;
+    foreach my $class ($self->linearized_isa) {
         # fetch the meta-class ...
         my $meta = $self->initialize($class);
         push @methods => {
@@ -620,16 +603,9 @@ sub find_next_method_by_name {
     my ($self, $method_name) = @_;
     (defined $method_name && $method_name)
         || confess "You must define a method name to find";
-    # keep a record of what we have seen
-    # here, this will handle all the
-    # inheritence issues because we are
-    # using the &class_precedence_list
-    my %seen_class;
-    my @cpl = $self->class_precedence_list();
+    my @cpl = $self->linearized_isa;
     shift @cpl; # discard ourselves
     foreach my $class (@cpl) {
-        next if $seen_class{$class};
-        $seen_class{$class}++;
         # fetch the meta-class ...
         my $meta = $self->initialize($class);
         return $meta->get_method($method_name)
@@ -703,15 +679,8 @@ sub get_attribute_list {
 
 sub compute_all_applicable_attributes {
     my $self = shift;
-    my @attrs;
-    # keep a record of what we have seen
-    # here, this will handle all the
-    # inheritence issues because we are
-    # using the &class_precedence_list
-    my (%seen_class, %seen_attr);
-    foreach my $class ($self->class_precedence_list()) {
-        next if $seen_class{$class};
-        $seen_class{$class}++;
+    my (@attrs, %seen_attr);
+    foreach my $class ($self->linearized_isa) {
         # fetch the meta-class ...
         my $meta = $self->initialize($class);
         foreach my $attr_name ($meta->get_attribute_list()) {
@@ -725,14 +694,7 @@ sub compute_all_applicable_attributes {
 
 sub find_attribute_by_name {
     my ($self, $attr_name) = @_;
-    # keep a record of what we have seen
-    # here, this will handle all the
-    # inheritence issues because we are
-    # using the &class_precedence_list
-    my %seen_class;
-    foreach my $class ($self->class_precedence_list()) {
-        next if $seen_class{$class};
-        $seen_class{$class}++;
+    foreach my $class ($self->linearized_isa) {
         # fetch the meta-class ...
         my $meta = $self->initialize($class);
         return $meta->get_attribute($attr_name)
@@ -810,6 +772,7 @@ sub create_immutable_transformer {
        /],
        memoize     => {
            class_precedence_list             => 'ARRAY',
+           linearized_isa                    => 'ARRAY',
            compute_all_applicable_attributes => 'ARRAY',
            get_meta_instance                 => 'SCALAR',
            get_method_map                    => 'SCALAR',
@@ -1075,6 +1038,11 @@ This computes the a list of all the class's ancestors in the same order
 in which method dispatch will be done. This is similair to
 what B<Class::ISA::super_path> does, but we don't remove duplicate names.
 
+=item B<linearized_isa>
+
+This returns a list based on C<class_precedence_list> but with all 
+duplicates removed.
+
 =back
 
 =head2 Methods