Move NEXT from ext/ to cpan/

9 files changed, 1015 insertions, 0 deletions

diff --git a/cpan/NEXT/Changes b/cpan/NEXT/Changes
new file mode 100644
index 0000000000..b691d25a28
--- /dev/null
+++ b/cpan/NEXT/Changes
@@ -0,0 +1,60 @@
+Revision history for Perl extension NEXT.pm.
+
+0.64    Mon Jun  8 14:36:00 2009
+    - Fixed overwriting dynamically scoped regex vars (Norbert Buchmuller,
+      Closes RT#36956).
+
+0.63    Fri Apr 10 16:52:44 2009
+    - Specify plans for all tests (Jarkko Hietaniemi). Merged from blead
+      perl (Florian Ragwitz).
+    - Default to installing to privlib instead of sitelib on perls where
+      NEXT is core (Jerry D. Hedden).
+
+0.62    Wed Apr  8 03:27:25 2009
+    - Be less aggressive when looking at the symbol table to find
+      methods. This prevents "used only once" warnings on 5.10.
+
+0.61    Tue Mar 24 02:50:26 2009
+    - Pod tweaks (Alan Ferrency).
+    - Fix a bug when using NEXT from within an eval block (Dave Rolsky).
+    - Fix some pod typos (Piotr Fusik).
+    - Fix a bug when using NEXT within overloaded stringification
+      (Marcel Grünauer).
+    - Make NEXT work with AUTOLOAD (Damian Conway).
+
+0.60    Wed Aug 13 03:55:33 2003
+    - Re-re-re-fixed NEXT::UNSEEN bug under diamond inheritance
+      (Note to self: don't code whilst on vacation!)
+    - Implemented and documented EVERY functionality
+
+0.53    Tue Aug 12 10:53:25 2003
+    - Re-re-fixed NEXT::UNSEEN bug under diamond inheritance
+
+0.52    Wed Jul 30 21:06:59 2003
+    - Refixed NEXT::UNSEEN bug under diamond inheritance
+
+0.51    Tue Jul 29 23:09:48 2003
+    - Fixed NEXT::UNSEEN bug under diamond inheritance (thanks Dan
+      and Alan)
+    - Moved &ancestors out of NEXT class in case anyone ever
+      calls NEXT::ancestors
+    - Replaced UNSEEN with DISTINCT (but left UNSEEN operational
+      for backwards compatibility)
+
+0.50    Fri Nov 16 11:20:40 2001
+    - Added a $VERSION (oops!)
+    - Fixed handling of diamond patterns (thanks Paul)
+    - Added NEXT::ACTUAL to require existence of next method (thanks Paul)
+    - Added NEXT::UNSEEN to avoid calling multiply inherited
+      methods twice (thanks Paul)
+    - Re-fixed setting of $AUTOLOAD in NEXT'd AUTOLOADS to be
+      consistent with more useful SUPER:: behaviour
+    - Corified tests
+
+0.02    Mon Sep  3 07:52:27 2001
+    - Fixed setting of $AUTOLOAD in NEXT'd AUTOLOADS (thanks Leonid)
+    - Changed licence for inclusion in core distribution
+    - Documented the difference between NEXT and SUPER (thanks Ken)
+
+0.01    Tue Apr 10 18:27:00 EST 2001
+    - original version
diff --git a/cpan/NEXT/README b/cpan/NEXT/README
new file mode 100644
index 0000000000..af8b5624ae
--- /dev/null
+++ b/cpan/NEXT/README
@@ -0,0 +1,57 @@
+==============================================================================
+                       Release of version 0.60 of NEXT
+==============================================================================
+
+
+NAME
+
+    NEXT - Pseudo class for method redispatch
+
+
+DESCRIPTION
+
+    NEXT.pm adds a pseudoclass named C<NEXT> to any program that
+    uses it. If a method C<m> calls C<$self->NEXT::m()>, the call to
+    C<m> is redispatched as if the calling method had not originally
+    been found.
+
+    In other words, a call to C<$self->NEXT::m()> resumes the
+    depth-first, left-to-right search of parent classes that
+    resulted in the original call to C<m>.
+
+    Note that this is not the same thing as C<$self->SUPER::m()>, which
+    begins a new dispatch that is restricted to searching the ancestors
+    of the current class. C<$self->NEXT::m()> can backtrack past
+    the current class -- to look for a suitable method in other
+    ancestors of C<$self> -- whereas C<$self->SUPER::m()> cannot.
+
+    An particularly interesting use of redispatch is in
+    C<AUTOLOAD>'ed methods. If such a method determines that it is
+    not able to handle a particular call, it may choose to
+    redispatch that call, in the hope that some other C<AUTOLOAD>
+    (above it, or to its left) might do better.
+
+    The module also allows you to specify that multiply inherited
+    methods should only be redispatched once, and what should
+    happen if no redispatch is possible.
+
+
+AUTHOR
+
+    Damian Conway (damian@conway.org)
+
+
+COPYRIGHT
+
+	 Copyright (c) 2000-2001, Damian Conway. All Rights Reserved.
+	 This module is free software. It may be used, redistributed
+	    and/or modified under the same terms as Perl itself.
+
+
+==============================================================================
+
+AVAILABILITY
+
+NEXT has been uploaded to the CPAN
+
+==============================================================================
diff --git a/cpan/NEXT/lib/NEXT.pm b/cpan/NEXT/lib/NEXT.pm
new file mode 100644
index 0000000000..1e59280241
--- /dev/null
+++ b/cpan/NEXT/lib/NEXT.pm
@@ -0,0 +1,563 @@
+package NEXT;
+$VERSION = '0.64';
+use Carp;
+use strict;
+use overload ();
+
+sub NEXT::ELSEWHERE::ancestors
+{
+	my @inlist = shift;
+	my @outlist = ();
+	while (my $next = shift @inlist) {
+		push @outlist, $next;
+		no strict 'refs';
+		unshift @inlist, @{"$outlist[-1]::ISA"};
+	}
+	return @outlist;
+}
+
+sub NEXT::ELSEWHERE::ordered_ancestors
+{
+	my @inlist = shift;
+	my @outlist = ();
+	while (my $next = shift @inlist) {
+		push @outlist, $next;
+		no strict 'refs';
+		push @inlist, @{"$outlist[-1]::ISA"};
+	}
+	return sort { $a->isa($b) ? -1
+	            : $b->isa($a) ? +1
+	            :                0 } @outlist;
+}
+
+sub NEXT::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 = $NEXT::AUTOLOAD || $autoload_name;
+        undef $NEXT::AUTOLOAD;
+        my ($caller_class, $caller_method) = do { $caller =~ m{(.*)::(.*)}g };
+        my ($wanted_class, $wanted_method) = do { $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 {
+                    my $stash = \%{"${_}::"};
+                    ($stash->{$caller_method} && (*{$stash->{$caller_method}}{CODE}))
+                        ? *{$stash->{$caller_method}}{CODE}
+                        : () } @forebears
+                    unless $wanted_method eq 'AUTOLOAD';
+            @{$NEXT::NEXT{$key,$wanted_method}} =
+                map {
+                    my $stash = \%{"${_}::"};
+                    ($stash->{AUTOLOAD} && (*{$stash->{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 (do { $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 do { $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';
+        do { ($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;                                  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) = do { $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 do { $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;
+
+__END__
+
+=head1 NAME
+
+NEXT.pm - Provide a pseudo-class NEXT (et al) that allows method redispatch
+
+
+=head1 SYNOPSIS
+
+    use NEXT;
+
+    package A;
+    sub A::method   { print "$_[0]: A method\n";   $_[0]->NEXT::method() }
+    sub A::DESTROY  { print "$_[0]: A dtor\n";     $_[0]->NEXT::DESTROY() }
+
+    package B;
+    use base qw( A );
+    sub B::AUTOLOAD { print "$_[0]: B AUTOLOAD\n"; $_[0]->NEXT::AUTOLOAD() }
+    sub B::DESTROY  { print "$_[0]: B dtor\n";     $_[0]->NEXT::DESTROY() }
+
+    package C;
+    sub C::method   { print "$_[0]: C method\n";   $_[0]->NEXT::method() }
+    sub C::AUTOLOAD { print "$_[0]: C AUTOLOAD\n"; $_[0]->NEXT::AUTOLOAD() }
+    sub C::DESTROY  { print "$_[0]: C dtor\n";     $_[0]->NEXT::DESTROY() }
+
+    package D;
+    use base qw( B C );
+    sub D::method   { print "$_[0]: D method\n";   $_[0]->NEXT::method() }
+    sub D::AUTOLOAD { print "$_[0]: D AUTOLOAD\n"; $_[0]->NEXT::AUTOLOAD() }
+    sub D::DESTROY  { print "$_[0]: D dtor\n";     $_[0]->NEXT::DESTROY() }
+
+    package main;
+
+    my $obj = bless {}, "D";
+
+    $obj->method();		# Calls D::method, A::method, C::method
+    $obj->missing_method(); # Calls D::AUTOLOAD, B::AUTOLOAD, C::AUTOLOAD
+
+    # Clean-up calls D::DESTROY, B::DESTROY, A::DESTROY, C::DESTROY
+
+
+
+=head1 DESCRIPTION
+
+NEXT.pm adds a pseudoclass named C<NEXT> to any program
+that uses it. If a method C<m> calls C<$self-E<gt>NEXT::m()>, the call to
+C<m> is redispatched as if the calling method had not originally been found.
+
+In other words, a call to C<$self-E<gt>NEXT::m()> resumes the depth-first,
+left-to-right search of C<$self>'s class hierarchy that resulted in the
+original call to C<m>.
+
+Note that this is not the same thing as C<$self-E<gt>SUPER::m()>, which
+begins a new dispatch that is restricted to searching the ancestors
+of the current class. C<$self-E<gt>NEXT::m()> can backtrack
+past the current class -- to look for a suitable method in other
+ancestors of C<$self> -- whereas C<$self-E<gt>SUPER::m()> cannot.
+
+A typical use would be in the destructors of a class hierarchy,
+as illustrated in the synopsis above. Each class in the hierarchy
+has a DESTROY method that performs some class-specific action
+and then redispatches the call up the hierarchy. As a result,
+when an object of class D is destroyed, the destructors of I<all>
+its parent classes are called (in depth-first, left-to-right order).
+
+Another typical use of redispatch would be in C<AUTOLOAD>'ed methods.
+If such a method determined that it was not able to handle a
+particular call, it might choose to redispatch that call, in the
+hope that some other C<AUTOLOAD> (above it, or to its left) might
+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 acquiescence
+is also unlike the (generally annoying) behaviour of C<SUPER>, which
+throws an exception if it cannot redispatch.
+
+Note that it is a fatal error for any method (including C<AUTOLOAD>)
+to attempt to redispatch any method that does not have the
+same name. For example:
+
+        sub D::oops { print "oops!\n"; $_[0]->NEXT::other_method() }
+
+
+=head2 Enforcing redispatch
+
+It is possible to make C<NEXT> redispatch more demandingly (i.e. like
+C<SUPER> does), so that the redispatch throws an exception if it cannot
+find a "next" method to call.
+
+To do this, simple invoke the redispatch as:
+
+	$self->NEXT::ACTUAL::method();
+
+rather than:
+
+	$self->NEXT::method();
+
+The C<ACTUAL> tells C<NEXT> that there must actually be a next method to call,
+or it should throw an exception.
+
+C<NEXT::ACTUAL> is most commonly used in C<AUTOLOAD> methods, as a means to
+decline an C<AUTOLOAD> request, but preserve the normal exception-on-failure 
+semantics:
+
+	sub AUTOLOAD {
+		if ($AUTOLOAD =~ /foo|bar/) {
+			# handle here
+		}
+		else {  # try elsewhere
+			shift()->NEXT::ACTUAL::AUTOLOAD(@_);
+		}
+	}
+
+By using C<NEXT::ACTUAL>, if there is no other C<AUTOLOAD> to handle the
+method call, an exception will be thrown (as usually happens in the absence of
+a suitable C<AUTOLOAD>).
+
+
+=head2 Avoiding repetitions
+
+If C<NEXT> redispatching is used in the methods of a "diamond" class hierarchy:
+
+	#     A   B
+	#    / \ /
+	#   C   D
+	#    \ /
+	#     E
+
+	use NEXT;
+
+	package A;                 
+	sub foo { print "called A::foo\n"; shift->NEXT::foo() }
+
+	package B;                 
+	sub foo { print "called B::foo\n"; shift->NEXT::foo() }
+
+	package C; @ISA = qw( A );
+	sub foo { print "called C::foo\n"; shift->NEXT::foo() }
+
+	package D; @ISA = qw(A B);
+	sub foo { print "called D::foo\n"; shift->NEXT::foo() }
+
+	package E; @ISA = qw(C D);
+	sub foo { print "called E::foo\n"; shift->NEXT::foo() }
+
+	E->foo();
+
+then derived classes may (re-)inherit base-class methods through two or
+more distinct paths (e.g. in the way C<E> inherits C<A::foo> twice --
+through C<C> and C<D>). In such cases, a sequence of C<NEXT> redispatches
+will invoke the multiply inherited method as many times as it is
+inherited. For example, the above code prints:
+
+        called E::foo
+        called C::foo
+        called A::foo
+        called D::foo
+        called A::foo
+        called B::foo
+
+(i.e. C<A::foo> is called twice).
+
+In some cases this I<may> be the desired effect within a diamond hierarchy,
+but in others (e.g. for destructors) it may be more appropriate to 
+call each method only once during a sequence of redispatches.
+
+To cover such cases, you can redispatch methods via:
+
+        $self->NEXT::DISTINCT::method();
+
+rather than:
+
+        $self->NEXT::method();
+
+This causes the redispatcher to only visit each distinct C<method> method
+once. That is, to skip any classes in the hierarchy that it has
+already visited during redispatch. So, for example, if the
+previous example were rewritten:
+
+        package A;                 
+        sub foo { print "called A::foo\n"; shift->NEXT::DISTINCT::foo() }
+
+        package B;                 
+        sub foo { print "called B::foo\n"; shift->NEXT::DISTINCT::foo() }
+
+        package C; @ISA = qw( A );
+        sub foo { print "called C::foo\n"; shift->NEXT::DISTINCT::foo() }
+
+        package D; @ISA = qw(A B);
+        sub foo { print "called D::foo\n"; shift->NEXT::DISTINCT::foo() }
+
+        package E; @ISA = qw(C D);
+        sub foo { print "called E::foo\n"; shift->NEXT::DISTINCT::foo() }
+
+        E->foo();
+
+then it would print:
+        
+        called E::foo
+        called C::foo
+        called A::foo
+        called D::foo
+        called B::foo
+
+and omit the second call to C<A::foo> (since it would not be distinct
+from the first call to C<A::foo>).
+
+Note that you can also use:
+
+        $self->NEXT::DISTINCT::ACTUAL::method();
+
+or:
+
+        $self->NEXT::ACTUAL::DISTINCT::method();
+
+to get both unique invocation I<and> exception-on-failure.
+
+Note that, for historical compatibility, you can also use
+C<NEXT::UNSEEN> instead of C<NEXT::DISTINCT>.
+
+
+=head2 Invoking all versions of a method with a single call
+
+Yet another pseudo-class that NEXT.pm provides is C<EVERY>.
+Its behaviour is considerably simpler than that of the C<NEXT> family.
+A call to:
+
+	$obj->EVERY::foo();
+
+calls I<every> method named C<foo> that the object in C<$obj> has inherited.
+That is:
+
+	use NEXT;
+
+	package A; @ISA = qw(B D X);
+	sub foo { print "A::foo " }
+
+	package B; @ISA = qw(D X);
+	sub foo { print "B::foo " }
+
+	package X; @ISA = qw(D);
+	sub foo { print "X::foo " }
+
+	package D;
+	sub foo { print "D::foo " }
+
+	package main;
+
+	my $obj = bless {}, 'A';
+	$obj->EVERY::foo();        # prints" A::foo B::foo X::foo D::foo
+
+Prefixing a method call with C<EVERY::> causes every method in the
+object's hierarchy with that name to be invoked. As the above example
+illustrates, they are not called in Perl's usual "left-most-depth-first"
+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
+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>.
+
+In general, there's no need to worry about the order of calls. They will be
+left-to-right, breadth-first, most-derived-first. This works perfectly for
+most inherited methods (including destructors), but is inappropriate for
+some kinds of methods (such as constructors, cloners, debuggers, and
+initializers) where it's more appropriate that the least-derived methods be
+called first (as more-derived methods may rely on the behaviour of their
+"ancestors"). In that case, instead of using the C<EVERY> pseudo-class:
+
+	$obj->EVERY::foo();        # prints" A::foo B::foo X::foo D::foo      
+
+you can use the C<EVERY::LAST> pseudo-class:
+
+	$obj->EVERY::LAST::foo();  # prints" D::foo X::foo B::foo A::foo      
+
+which reverses the order of method call.
+
+Whichever version is used, the actual methods are called in the same
+context (list, scalar, or void) as the original call via C<EVERY>, and return:
+
+=over
+
+=item *
+
+A hash of array references in list context. Each entry of the hash has the
+fully qualified method name as its key and a reference to an array containing
+the method's list-context return values as its value.
+
+=item *
+
+A reference to a hash of scalar values in scalar context. Each entry of the hash has the
+fully qualified method name as its key and the method's scalar-context return values as its value.
+
+=item *
+
+Nothing in void context (obviously).
+
+=back
+
+=head2 Using C<EVERY> methods
+
+The typical way to use an C<EVERY> call is to wrap it in another base
+method, that all classes inherit. For example, to ensure that every
+destructor an object inherits is actually called (as opposed to just the
+left-most-depth-first-est one):
+
+        package Base;
+        sub DESTROY { $_[0]->EVERY::Destroy }
+
+        package Derived1; 
+        use base 'Base';
+        sub Destroy {...}
+
+        package Derived2; 
+        use base 'Base', 'Derived1';
+        sub Destroy {...}
+
+et cetera. Every derived class than needs its own clean-up
+behaviour simply adds its own C<Destroy> method (I<not> a C<DESTROY> method),
+which the call to C<EVERY::LAST::Destroy> in the inherited destructor
+then correctly picks up.
+
+Likewise, to create a class hierarchy in which every initializer inherited by
+a new object is invoked:
+
+        package Base;
+        sub new {
+		my ($class, %args) = @_;
+		my $obj = bless {}, $class;
+		$obj->EVERY::LAST::Init(\%args);
+	}
+
+        package Derived1; 
+        use base 'Base';
+        sub Init {
+		my ($argsref) = @_;
+		...
+	}
+
+        package Derived2; 
+        use base 'Base', 'Derived1';
+        sub Init {
+		my ($argsref) = @_;
+		...
+	}
+
+et cetera. Every derived class than needs some additional initialization
+behaviour simply adds its own C<Init> method (I<not> a C<new> method),
+which the call to C<EVERY::LAST::Init> in the inherited constructor
+then correctly picks up.
+
+
+=head1 AUTHOR
+
+Damian Conway (damian@conway.org)
+
+=head1 BUGS AND IRRITATIONS
+
+Because it's a module, not an integral part of the interpreter, NEXT.pm
+has to guess where the surrounding call was found in the method
+look-up sequence. In the presence of diamond inheritance patterns
+it occasionally guesses wrong.
+
+It's also too slow (despite caching).
+
+Comment, suggestions, and patches welcome.
+
+=head1 COPYRIGHT
+
+ Copyright (c) 2000-2001, Damian Conway. All Rights Reserved.
+ This module is free software. It may be used, redistributed
+    and/or modified under the same terms as Perl itself.
diff --git a/cpan/NEXT/t/actual.t b/cpan/NEXT/t/actual.t
new file mode 100644
index 0000000000..a3a724ae4a
--- /dev/null
+++ b/cpan/NEXT/t/actual.t
@@ -0,0 +1,44 @@
+use Test::More tests => 10;
+
+BEGIN {
+    if ($ENV{PERL_CORE}) {
+        chdir('t') if -d 't';
+        @INC = qw(../lib);
+    }
+}
+
+BEGIN { use_ok('NEXT') };
+my $order = 0;
+
+package A;
+@ISA = qw/B C D/;
+
+sub test { ++$order; ::ok($order==1,"test A"); $_[0]->NEXT::ACTUAL::test;}
+
+package B;
+@ISA = qw/D C/;
+sub test { ++$order; ::ok($order==2,"test B"); $_[0]->NEXT::ACTUAL::test;}
+
+package C;
+@ISA = qw/D/;
+sub test {
+	++$order; ::ok($order==4||$order==6,"test C");
+	$_[0]->NEXT::ACTUAL::test;
+}
+
+package D;
+
+sub test {
+	++$order; ::ok($order==3||$order==5||$order==7||$order==8,"test D");
+        $_[0]->NEXT::ACTUAL::test;
+}
+
+package main;
+
+my $foo = {};
+
+bless($foo,"A");
+
+eval{ $foo->test }
+	? fail("Didn't die on missing ancestor") 
+	: pass("Correctly dies after full traversal");
diff --git a/cpan/NEXT/t/actuns.t b/cpan/NEXT/t/actuns.t
new file mode 100644
index 0000000000..b3da0c69fd
--- /dev/null
+++ b/cpan/NEXT/t/actuns.t
@@ -0,0 +1,38 @@
+use Test::More tests => 6;
+
+BEGIN {
+    if ($ENV{PERL_CORE}) {
+        chdir('t') if -d 't';
+        @INC = qw(../lib);
+    }
+}
+
+BEGIN { use_ok('NEXT') };
+my $order = 0;
+
+package A;
+@ISA = qw/B C D/;
+
+sub test { ::ok(++$order==1,"test A"); $_[0]->NEXT::UNSEEN::ACTUAL::test;}
+
+package B;
+@ISA = qw/D C/;
+sub test { ::ok(++$order==2,"test B"); $_[0]->NEXT::ACTUAL::UNSEEN::test;}
+
+package C;
+@ISA = qw/D/;
+sub test { ::ok(++$order==4,"test C"); $_[0]->NEXT::UNSEEN::ACTUAL::test;}
+
+package D;
+
+sub test { ::ok(++$order==3,"test D"); $_[0]->NEXT::ACTUAL::UNSEEN::test;}
+
+package main;
+
+my $foo = {};
+
+bless($foo,"A");
+
+eval{ $foo->test }
+	? fail("Didn't die on missing ancestor") 
+	: pass("Correctly dies after C");
diff --git a/cpan/NEXT/t/dynamically_scoped_regex_vars.t b/cpan/NEXT/t/dynamically_scoped_regex_vars.t
new file mode 100644
index 0000000000..2d209e0e4c
--- /dev/null
+++ b/cpan/NEXT/t/dynamically_scoped_regex_vars.t
@@ -0,0 +1,50 @@
+use Test::More tests => 7;
+
+BEGIN {
+    if ($ENV{PERL_CORE}) {
+        chdir('t') if -d 't';
+        @INC = qw(../lib);
+    }
+}
+
+BEGIN { use_ok('NEXT') };
+
+package A;
+use base qw(B);
+use NEXT;
+sub test_next { shift->NEXT::test_next(@_); }
+sub test_next_distinct { shift->NEXT::DISTINCT::test_next_distinct(@_); }
+sub test_next_actual { shift->NEXT::ACTUAL::test_next_actual(@_); }
+sub test_next_actual_distinct { shift->NEXT::ACTUAL::DISTINCT::test_next_actual_distinct(@_); }
+sub test_every { shift->EVERY::test_every(@_); }
+sub test_every_last { shift->EVERY::LAST::test_every_last(@_); }
+
+package B;
+sub test_next { $_[1]; }
+sub test_next_distinct { $_[1]; }
+sub test_next_actual { $_[1]; }
+sub test_next_actual_distinct { $_[1]; }
+sub test_every { $_[1]; }
+sub test_every_last { $_[1]; }
+
+package main;
+
+my $foo = bless {}, 'A';
+
+"42" =~ /(.*)/;
+is($foo->test_next($&), $&, "The value of '\$&' was not overwritten in NEXT.");
+
+"42" =~ /(.*)/;
+is($foo->test_next_distinct($&), $&, "The value of '\$&' was not overwritten in NEXT::DISTINCT.");
+
+"42" =~ /(.*)/;
+is($foo->test_next_actual($&), $&, "The value of '\$&' was not overwritten in NEXT::ACTUAL.");
+
+"42" =~ /(.*)/;
+is($foo->test_next_actual_distinct($&), $&, "The value of '\$&' was not overwritten in NEXT::ACTUAL::DISTINCT.");
+
+"42" =~ /(.*)/;
+is($foo->test_every($&)->{'B::test_every'}, $&, "The value of '\$&' was not overwritten in EVERY.");
+
+"42" =~ /(.*)/;
+is($foo->test_every_last($&)->{'B::test_every_last'}, $&, "The value of '\$&' was not overwritten in EVERY::LAST.");
diff --git a/cpan/NEXT/t/next.t b/cpan/NEXT/t/next.t
new file mode 100644
index 0000000000..8b26f0e4aa
--- /dev/null
+++ b/cpan/NEXT/t/next.t
@@ -0,0 +1,114 @@
+BEGIN {
+    if ($ENV{PERL_CORE}) {
+        chdir('t') if -d 't';
+        @INC = qw(../lib);
+    }
+}
+
+BEGIN { print "1..26\n"; }
+
+use NEXT;
+
+print "ok 1\n";
+
+package A;
+sub A::method   { return ( 3, $_[0]->NEXT::method() ) }
+sub A::DESTROY  { $_[0]->NEXT::DESTROY() }
+sub A::evaled   { eval { $_[0]->NEXT::evaled(); return 'evaled' } }
+
+package B;
+use base qw( A );
+sub B::AUTOLOAD { return ( 9, $_[0]->NEXT::AUTOLOAD() )
+			if $AUTOLOAD =~ /.*(missing_method|secondary)/ }
+sub B::DESTROY  { $_[0]->NEXT::DESTROY() }
+
+package C;
+sub C::DESTROY  { print "ok 24\n"; $_[0]->NEXT::DESTROY() }
+
+package D;
+@D::ISA = qw( B C E );
+sub D::method   { return ( 2, $_[0]->NEXT::method() ) }
+sub D::AUTOLOAD { return ( 8, $_[0]->NEXT::AUTOLOAD() ) }
+sub D::DESTROY  { print "ok 23\n"; $_[0]->NEXT::DESTROY() }
+sub D::oops     { $_[0]->NEXT::method() }
+sub D::secondary { return ( 17, 18, map { $_+10 } $_[0]->NEXT::secondary() ) }
+
+package E;
+@E::ISA = qw( F G );
+sub E::method   { return ( 4,  $_[0]->NEXT::method(), $_[0]->NEXT::method() ) }
+sub E::AUTOLOAD { return ( 10, $_[0]->NEXT::AUTOLOAD() ) 
+			if $AUTOLOAD =~ /.*(missing_method|secondary)/ }
+sub E::DESTROY  { print "ok 25\n"; $_[0]->NEXT::DESTROY() }
+
+package F;
+sub F::method   { return ( 5  ) }
+sub F::AUTOLOAD { return ( 11 ) if $AUTOLOAD =~ /.*(missing_method|secondary)/ }
+sub F::DESTROY  { print "ok 26\n" }
+
+package G;
+sub G::method   { return ( 6 ) }
+sub G::AUTOLOAD { print "not "; return }
+sub G::DESTROY  { print "not ok 22"; return }
+
+package main;
+
+my $obj = bless {}, "D";
+
+my @vals;
+
+# TEST NORMAL REDISPATCH (ok 2..6)
+@vals = $obj->method();
+print map "ok $_\n", @vals;
+
+# RETEST NORMAL REDISPATCH SHOULD BE THE SAME (ok 7)
+@vals = $obj->method();
+print "not " unless join("", @vals) == "23456";
+print "ok 7\n";
+
+# TEST AUTOLOAD REDISPATCH (ok 8..11)
+@vals = $obj->missing_method();
+print map "ok $_\n", @vals;
+
+# NAMED METHOD CAN'T REDISPATCH TO NAMED METHOD OF DIFFERENT NAME (ok 12)
+eval { $obj->oops() } && print "not ";
+print "ok 12\n";
+
+# AUTOLOAD'ED METHOD CAN'T REDISPATCH TO NAMED METHOD (ok 13)
+
+eval {
+	local *C::AUTOLOAD = sub { $_[0]->NEXT::method() };
+	*C::AUTOLOAD = *C::AUTOLOAD;
+	eval { $obj->missing_method(); } && print "not ";
+};
+print "ok 13\n";
+
+# NAMED METHOD CAN'T REDISPATCH TO AUTOLOAD'ED METHOD (ok 14)
+eval { 
+	*C::method = sub{ $_[0]->NEXT::AUTOLOAD() };
+	*C::method = *C::method;
+	eval { $obj->method(); } && print "not ";
+};
+print "ok 14\n";
+
+# BASE CLASS METHODS ONLY REDISPATCHED WITHIN HIERARCHY (ok 15..16)
+my $ob2 = bless {}, "B";
+@val = $ob2->method();         
+print "not " unless @val==1 && $val[0]==3;
+print "ok 15\n";
+
+@val = $ob2->missing_method(); 
+print "not " unless @val==1 && $val[0]==9;
+print "ok 16\n";
+
+# TEST SECONDARY AUTOLOAD REDISPATCH (ok 17..21)
+@vals = $obj->secondary();
+print map "ok $_\n", @vals;
+
+# TEST HANDLING OF NEXT:: INSIDE EVAL (22)
+eval {
+	$obj->evaled;
+	$@ && print "not ";
+};
+print "ok 22\n";
+
+# CAN REDISPATCH DESTRUCTORS (ok 23..26)
diff --git a/cpan/NEXT/t/stringify.t b/cpan/NEXT/t/stringify.t
new file mode 100644
index 0000000000..8d06890ceb
--- /dev/null
+++ b/cpan/NEXT/t/stringify.t
@@ -0,0 +1,35 @@
+use warnings;
+use strict;
+use Test::More tests => 2;
+
+BEGIN {
+    if ($ENV{PERL_CORE}) {
+        chdir('t') if -d 't';
+        @INC = qw(../lib);
+    }
+}
+
+BEGIN { use_ok('NEXT') };
+
+
+package Foo;
+
+use overload '""' => 'stringify';
+
+use constant BAR => (1..5);
+
+sub new { bless {}, shift }
+
+sub stringify {
+    my $self = shift;
+    my %result = $self->EVERY::LAST::BAR;
+    join '-' => @{ $result{'Foo::BAR'} };
+}
+
+
+
+package main;
+
+my $foo = Foo->new;
+is("$foo", '1-2-3-4-5', 'overloading stringification');
+
diff --git a/cpan/NEXT/t/unseen.t b/cpan/NEXT/t/unseen.t
new file mode 100644
index 0000000000..5166816280
--- /dev/null
+++ b/cpan/NEXT/t/unseen.t
@@ -0,0 +1,54 @@
+use Test::More tests => 7;
+
+BEGIN {
+    if ($ENV{PERL_CORE}) {
+        chdir('t') if -d 't';
+        @INC = qw(../lib);
+    }
+}
+
+BEGIN { use_ok('NEXT') };
+my $order = 0;
+
+package A;
+@ISA = qw/B C D/;
+
+sub test { ::ok(++$order==1,"test A"); $_[0]->NEXT::UNSEEN::test; 1}
+
+package B;
+@ISA = qw/D C/;
+sub test { ::ok(++$order==2,"test B"); $_[0]->NEXT::UNSEEN::test; 1}
+
+package C;
+@ISA = qw/D/;
+sub test { ::ok(++$order==4,"test C"); $_[0]->NEXT::UNSEEN::test; 1}
+
+package D;
+
+sub test { ::ok(++$order==3,"test D"); $_[0]->NEXT::UNSEEN::test; 1}
+
+package main;
+
+my $foo = {};
+
+bless($foo,"A");
+
+eval{ $foo->test }
+	? pass("Correctly survives after C")
+	: fail("Shouldn't die on missing ancestor");
+
+package Diamond::Base;
+my $seen;
+sub test {
+	$seen++ ? ::fail("Can't visit inherited test twice")
+		: ::pass("First diamond is okay");
+	shift->NEXT::UNSEEN::test;
+}
+
+package Diamond::Left;  @ISA = qw[Diamond::Base];
+package Diamond::Right; @ISA = qw[Diamond::Base];
+package Diamond::Top;   @ISA = qw[Diamond::Left Diamond::Right];
+
+package main;
+
+Diamond::Top->test;