X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FNEXT.pm;h=dc3127763b5191d53bcb145a5404eaeb33fdc604;hb=f89542f789fc8ac88f7cd7e93bb8d9cd6228182b;hp=64610fed27d3a93954ade6b6c9031f322ef04498;hpb=e23eab12291345ee6d531ea992930dc71f52fcab;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/lib/NEXT.pm b/lib/NEXT.pm
index 64610fe..dc31277 100644
--- a/lib/NEXT.pm
+++ b/lib/NEXT.pm
@@ -1,7 +1,8 @@
 package NEXT;
-$VERSION = '0.60';
+$VERSION = '0.61';
 use Carp;
 use strict;
+use overload ();
 
 sub NEXT::ELSEWHERE::ancestors
 {
@@ -29,130 +30,151 @@ sub NEXT::ELSEWHERE::ordered_ancestors
 	            :                0 } @outlist;
 }
 
-sub AUTOLOAD
+sub NEXT::ELSEWHERE::buildAUTOLOAD
 {
-	my ($self) = @_;
-	my $caller = (caller(1))[3]; 
-	my $wanted = $NEXT::AUTOLOAD || 'NEXT::AUTOLOAD';
-	undef $NEXT::AUTOLOAD;
-	my ($caller_class, $caller_method) = $caller =~ m{(.*)::(.*)}g;
-	my ($wanted_class, $wanted_method) = $wanted =~ m{(.*)::(.*)}g;
-	croak "Can't call $wanted from $caller"
-		unless $caller_method eq $wanted_method;
-
-	local ($NEXT::NEXT{$self,$wanted_method}, $NEXT::SEEN) =
-	      ($NEXT::NEXT{$self,$wanted_method}, $NEXT::SEEN);
-
-
-	unless ($NEXT::NEXT{$self,$wanted_method}) {
-		my @forebears =
-			NEXT::ELSEWHERE::ancestors ref $self || $self,
-						   $wanted_class;
-		while (@forebears) {
-			last if shift @forebears eq $caller_class
-		}
-		no strict 'refs';
-		@{$NEXT::NEXT{$self,$wanted_method}} = 
-			map { *{"${_}::$caller_method"}{CODE}||() } @forebears
-				unless $wanted_method eq 'AUTOLOAD';
-		@{$NEXT::NEXT{$self,$wanted_method}} = 
-			map { (*{"${_}::AUTOLOAD"}{CODE}) ? "${_}::AUTOLOAD" : ()} @forebears
-				unless @{$NEXT::NEXT{$self,$wanted_method}||[]};
-		$NEXT::SEEN->{$self,*{$caller}{CODE}}++;
-	}
-	my $call_method = shift @{$NEXT::NEXT{$self,$wanted_method}};
-	while ($wanted_class =~ /^NEXT\b.*\b(UNSEEN|DISTINCT)\b/
-	       && defined $call_method
-	       && $NEXT::SEEN->{$self,$call_method}++) {
-		$call_method = shift @{$NEXT::NEXT{$self,$wanted_method}};
-	}
-	unless (defined $call_method) {
-		return unless $wanted_class =~ /^NEXT:.*:ACTUAL/;
-		(local $Carp::CarpLevel)++;
-		croak qq(Can't locate object method "$wanted_method" ),
-		      qq(via package "$caller_class");
-	};
-	return $self->$call_method(@_[1..$#_]) if ref $call_method eq 'CODE';
-	no strict 'refs';
-	($wanted_method=${$caller_class."::AUTOLOAD"}) =~ s/.*:://
-		if $wanted_method eq 'AUTOLOAD';
-	$$call_method = $caller_class."::NEXT::".$wanted_method;
-	return $call_method->(@_);
+    my $autoload_name = caller() . '::AUTOLOAD';
+
+    no strict 'refs';
+    *{$autoload_name} = sub {
+        my ($self) = @_;
+        my $depth = 1;
+        until (((caller($depth))[3]||q{}) !~ /^\(eval\)$/) { $depth++ }
+        my $caller = (caller($depth))[3];
+        my $wanted = $NEXT::AUTOLOAD || $autoload_name;
+        undef $NEXT::AUTOLOAD;
+        my ($caller_class, $caller_method) = $caller =~ m{(.*)::(.*)}g;
+        my ($wanted_class, $wanted_method) = $wanted =~ m{(.*)::(.*)}g;
+        croak "Can't call $wanted from $caller"
+            unless $caller_method eq $wanted_method;
+
+        my $key = ref $self && overload::Overloaded($self)
+            ? overload::StrVal($self) : $self;
+
+        local ($NEXT::NEXT{$key,$wanted_method}, $NEXT::SEEN) =
+            ($NEXT::NEXT{$key,$wanted_method}, $NEXT::SEEN);
+
+        unless ($NEXT::NEXT{$key,$wanted_method}) {
+            my @forebears =
+                NEXT::ELSEWHERE::ancestors ref $self || $self,
+                            $wanted_class;
+            while (@forebears) {
+                last if shift @forebears eq $caller_class
+            }
+            no strict 'refs';
+            @{$NEXT::NEXT{$key,$wanted_method}} = 
+                map { *{"${_}::$caller_method"}{CODE}||() } @forebears
+                    unless $wanted_method eq 'AUTOLOAD';
+            @{$NEXT::NEXT{$key,$wanted_method}} = 
+                map { (*{"${_}::AUTOLOAD"}{CODE}) ? "${_}::AUTOLOAD" : ()} @forebears
+                    unless @{$NEXT::NEXT{$key,$wanted_method}||[]};
+            $NEXT::SEEN->{$key,*{$caller}{CODE}}++;
+        }
+        my $call_method = shift @{$NEXT::NEXT{$key,$wanted_method}};
+        while ($wanted_class =~ /^NEXT\b.*\b(UNSEEN|DISTINCT)\b/
+            && defined $call_method
+            && $NEXT::SEEN->{$key,$call_method}++) {
+            $call_method = shift @{$NEXT::NEXT{$key,$wanted_method}};
+        }
+        unless (defined $call_method) {
+            return unless $wanted_class =~ /^NEXT:.*:ACTUAL/;
+            (local $Carp::CarpLevel)++;
+            croak qq(Can't locate object method "$wanted_method" ),
+                qq(via package "$caller_class");
+        };
+        return $self->$call_method(@_[1..$#_]) if ref $call_method eq 'CODE';
+        no strict 'refs';
+        ($wanted_method=${$caller_class."::AUTOLOAD"}) =~ s/.*:://
+            if $wanted_method eq 'AUTOLOAD';
+        $$call_method = $caller_class."::NEXT::".$wanted_method;
+        return $call_method->(@_);
+    };
 }
 
 no strict 'vars';
-package NEXT::UNSEEN;		@ISA = 'NEXT';
-package NEXT::DISTINCT;		@ISA = 'NEXT';
-package NEXT::ACTUAL;		@ISA = 'NEXT';
-package NEXT::ACTUAL::UNSEEN;	@ISA = 'NEXT';
-package NEXT::ACTUAL::DISTINCT;	@ISA = 'NEXT';
-package NEXT::UNSEEN::ACTUAL;	@ISA = 'NEXT';
-package NEXT::DISTINCT::ACTUAL;	@ISA = 'NEXT';
-
-package EVERY::LAST;		@ISA = 'EVERY';
-package EVERY;			@ISA = 'NEXT';
-sub AUTOLOAD
-{
-	my ($self) = @_;
-	my $caller = (caller(1))[3]; 
-	my $wanted = $EVERY::AUTOLOAD || 'EVERY::AUTOLOAD';
-	undef $EVERY::AUTOLOAD;
-	my ($wanted_class, $wanted_method) = $wanted =~ m{(.*)::(.*)}g;
-
-	local $NEXT::ALREADY_IN_EVERY{$self,$wanted_method} =
-	      $NEXT::ALREADY_IN_EVERY{$self,$wanted_method};
-
-	return if $NEXT::ALREADY_IN_EVERY{$self,$wanted_method}++;
-	
-	my @forebears = NEXT::ELSEWHERE::ordered_ancestors ref $self || $self,
-					                   $wanted_class;
-	@forebears = reverse @forebears if $wanted_class =~ /\bLAST\b/;
-	no strict 'refs';
-	my %seen;
-	my @every = map { my $sub = "${_}::$wanted_method";
-		          !*{$sub}{CODE} || $seen{$sub}++ ? () : $sub
-		        } @forebears
-				unless $wanted_method eq 'AUTOLOAD';
-
-	my $want = wantarray;
-	if (@every) {
-		if ($want) {
-			return map {($_, [$self->$_(@_[1..$#_])])} @every;
-		}
-		elsif (defined $want) {
-			return { map {($_, scalar($self->$_(@_[1..$#_])))}
-				     @every
-			       };
-		}
-		else {
-			$self->$_(@_[1..$#_]) for @every;
-			return;
-		}
-	}
-
-	@every = map { my $sub = "${_}::AUTOLOAD";
-		       !*{$sub}{CODE} || $seen{$sub}++ ? () : "${_}::AUTOLOAD"
-		     } @forebears;
-	if ($want) {
-		return map { $$_ = ref($self)."::EVERY::".$wanted_method;
-			     ($_, [$self->$_(@_[1..$#_])]);
-			   } @every;
-	}
-	elsif (defined $want) {
-		return { map { $$_ = ref($self)."::EVERY::".$wanted_method;
-			       ($_, scalar($self->$_(@_[1..$#_])))
-			     } @every
-		       };
-	}
-	else {
-		for (@every) {
-			$$_ = ref($self)."::EVERY::".$wanted_method;
-			$self->$_(@_[1..$#_]);
-		}
-		return;
-	}
+package NEXT;                                  NEXT::ELSEWHERE::buildAUTOLOAD();
+package NEXT::UNSEEN;		@ISA = 'NEXT';     NEXT::ELSEWHERE::buildAUTOLOAD();
+package NEXT::DISTINCT;		@ISA = 'NEXT';     NEXT::ELSEWHERE::buildAUTOLOAD();
+package NEXT::ACTUAL;		@ISA = 'NEXT';     NEXT::ELSEWHERE::buildAUTOLOAD();
+package NEXT::ACTUAL::UNSEEN;	@ISA = 'NEXT'; NEXT::ELSEWHERE::buildAUTOLOAD();
+package NEXT::ACTUAL::DISTINCT;	@ISA = 'NEXT'; NEXT::ELSEWHERE::buildAUTOLOAD();
+package NEXT::UNSEEN::ACTUAL;	@ISA = 'NEXT'; NEXT::ELSEWHERE::buildAUTOLOAD();
+package NEXT::DISTINCT::ACTUAL;	@ISA = 'NEXT'; NEXT::ELSEWHERE::buildAUTOLOAD();
+
+package EVERY;
+
+sub EVERY::ELSEWHERE::buildAUTOLOAD {
+    my $autoload_name = caller() . '::AUTOLOAD';
+
+    no strict 'refs';
+    *{$autoload_name} = sub {
+        my ($self) = @_;
+        my $depth = 1;
+        until (((caller($depth))[3]||q{}) !~ /^\(eval\)$/) { $depth++ }
+        my $caller = (caller($depth))[3];
+        my $wanted = $EVERY::AUTOLOAD || $autoload_name;
+        undef $EVERY::AUTOLOAD;
+        my ($wanted_class, $wanted_method) = $wanted =~ m{(.*)::(.*)}g;
+
+        my $key = ref($self) && overload::Overloaded($self)
+            ? overload::StrVal($self) : $self;
+
+        local $NEXT::ALREADY_IN_EVERY{$key,$wanted_method} =
+            $NEXT::ALREADY_IN_EVERY{$key,$wanted_method};
+
+        return if $NEXT::ALREADY_IN_EVERY{$key,$wanted_method}++;
+
+        my @forebears = NEXT::ELSEWHERE::ordered_ancestors ref $self || $self,
+                                        $wanted_class;
+        @forebears = reverse @forebears if $wanted_class =~ /\bLAST\b/;
+        no strict 'refs';
+        my %seen;
+        my @every = map { my $sub = "${_}::$wanted_method";
+                    !*{$sub}{CODE} || $seen{$sub}++ ? () : $sub
+                    } @forebears
+                    unless $wanted_method eq 'AUTOLOAD';
+
+        my $want = wantarray;
+        if (@every) {
+            if ($want) {
+                return map {($_, [$self->$_(@_[1..$#_])])} @every;
+            }
+            elsif (defined $want) {
+                return { map {($_, scalar($self->$_(@_[1..$#_])))}
+                        @every
+                    };
+            }
+            else {
+                $self->$_(@_[1..$#_]) for @every;
+                return;
+            }
+        }
+
+        @every = map { my $sub = "${_}::AUTOLOAD";
+                !*{$sub}{CODE} || $seen{$sub}++ ? () : "${_}::AUTOLOAD"
+                } @forebears;
+        if ($want) {
+            return map { $$_ = ref($self)."::EVERY::".$wanted_method;
+                    ($_, [$self->$_(@_[1..$#_])]);
+                } @every;
+        }
+        elsif (defined $want) {
+            return { map { $$_ = ref($self)."::EVERY::".$wanted_method;
+                    ($_, scalar($self->$_(@_[1..$#_])))
+                    } @every
+                };
+        }
+        else {
+            for (@every) {
+                $$_ = ref($self)."::EVERY::".$wanted_method;
+                $self->$_(@_[1..$#_]);
+            }
+            return;
+        }
+    };
 }
 
+package EVERY::LAST;   @ISA = 'EVERY';   EVERY::ELSEWHERE::buildAUTOLOAD();
+package EVERY;         @ISA = 'NEXT';    EVERY::ELSEWHERE::buildAUTOLOAD();
 
 1;
 
@@ -229,7 +251,7 @@ do better.
 
 By default, if a redispatch attempt fails to find another method
 elsewhere in the objects class hierarchy, it quietly gives up and does
-nothing (but see L<"Enforcing redispatch">). This gracious acquiesence
+nothing (but see L<"Enforcing redispatch">). This gracious acquiescence
 is also unlike the (generally annoying) behaviour of C<SUPER>, which
 throws an exception if it cannot redispatch.
 
@@ -416,7 +438,7 @@ order. Instead, they are called "breadth-first-dependency-wise".
 That means that the inheritance tree of the object is traversed breadth-first
 and the resulting order of classes is used as the sequence in which methods
 are called. However, that sequence is modified by imposing a rule that the
-appropritae method of a derived class must be called before the same method of
+appropriate method of a derived class must be called before the same method of
 any ancestral class. That's why, in the above example, C<X::foo> is called
 before C<D::foo>, even though C<D> comes before C<X> in C<@B::ISA>.