From: Rafael Garcia-Suarez Date: Tue, 3 Jun 2008 06:29:35 +0000 (+0000) Subject: Update to NEXT by Damian. X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=597fc7a09a53eb11962ad7d817b9904ed154d0ed;p=p5sagit%2Fp5-mst-13.2.git Update to NEXT by Damian. This fixes the working of NEXT with AUTOLOAD. p4raw-id: //depot/perl@33991 --- diff --git a/lib/NEXT.pm b/lib/NEXT.pm index 57e2b41..f695f96 100644 --- a/lib/NEXT.pm +++ b/lib/NEXT.pm @@ -1,5 +1,5 @@ package NEXT; -$VERSION = '0.60_02'; +$VERSION = '0.60_03'; use Carp; use strict; use overload (); @@ -30,139 +30,151 @@ sub NEXT::ELSEWHERE::ordered_ancestors : 0 } @outlist; } -sub AUTOLOAD +sub NEXT::ELSEWHERE::buildAUTOLOAD { - my ($self) = @_; - my $depth = 1; - until ((caller($depth))[3] !~ /^\(eval\)$/) { $depth++ } - my $caller = (caller($depth))[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; - - 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->(@_); + 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 $depth = 1; - until ((caller($depth))[3] !~ /^\(eval\)$/) { $depth++ } - my $caller = (caller($depth))[3]; - my $wanted = $EVERY::AUTOLOAD || 'EVERY::AUTOLOAD'; - 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 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;