in reply to Making each(@ary) work on 5.10?

I took that as a challenge!

Tie::ArrayAsHash:

{
    package Tie::ArrayAsHash;
    
    use strict;
    no warnings;
    use Carp;
    use Hash::FieldHash qw(fieldhash);
    use Scalar::Util qw(reftype);
    
    use base qw(Exporter);
    BEGIN {
        our @EXPORT_OK = 'aeach';
        $INC{'Tie/ArrayAsHash.pm'} = __FILE__;
    };
    
    use constant {
        IDX_DATA  => 0,
        IDX_EACH  => 1,
        NEXT_IDX  => 2,
    };
    
    fieldhash my %cache;
    
    sub aeach (\[@%])
    {
        my $thing = shift;
        return each %$thing
            if reftype $thing eq 'HASH';
        confess "should be passed a HASH or ARRAY"
            unless reftype $thing eq 'ARRAY';
        
        my $thing_h = $cache{$thing} ||= do {
            tie my %h, __PACKAGE__, $thing;
            \%h
        };
        
        each %$thing_h;
    }
    
    sub TIEHASH
    {
        my ($class, $arrayref) = @_;
        bless [$arrayref, 0] => $class;
    }
    
    sub STORE
    {
        my ($self, $k, $v) = @_;
        $self->[IDX_DATA][$k] = $v;
    }

    sub FETCH
    {
        my ($self, $k) = @_;
        $self->[IDX_DATA][$k];
    }

    sub FIRSTKEY
    {
        my ($self) = @_;
        $self->[IDX_EACH] = 0;
        $self->NEXTKEY;
    }
    
    sub NEXTKEY
    {
        my ($self) = @_;
        my $curr = $self->[IDX_EACH]++;
        return if $curr >= @{ $self->[IDX_DATA] };
        return $curr;
    }
    
    sub EXISTS
    {
        my ($self, $k) = @_;
        !!($k eq $k+0
            and $k < @{ $self->[IDX_DATA] }
        );
    }
    
    sub DELETE
    {
        my ($self, $k) = @_;
        return pop @{ $self->[IDX_DATA] }
            if @{ $self->[IDX_DATA] } == $k + 1;
        confess "DELETE not fully implemented";
    }

    sub CLEAR
    {
        my ($self) = @_;
        $self->[IDX_DATA] = [];
    }
    
    sub SCALAR
    {
        my ($self) = @_;
        my %tmp =
            map { $_ => $self->[IDX_DATA][$_] }
            0 .. $#{ $self->[IDX_DATA] };
        return scalar(%tmp);
    }
}

[download]

Usage:

use 5.010;
use Tie::ArrayAsHash 'aeach';

my %hash = qw(
  a  foo
  b  bar
  c  baz
);
my @array = qw(
  foo
  bar
  baz
);

while (my ($key, $value) = aeach %hash)
{
    say "HASH $key => $value";
}

while (my ($idx, $value) = aeach @array)
{
    say "ARRAY $idx => $value";
}

[download]

Basically it's Perl 5.12's each, but should work in Perl 5.8+. But it's called aeach.

It is possible to define a sub called each but it's kinda awkward to actually use it.

perl -E'sub Monkey::do{say$_,for@_,do{($monkey=[caller(0)]->[3])=~s{::}{ }and$monkey}}"Monkey say"->Monkey::do'

Replies are listed 'Best First'.
Re^2: Making each(@ary) work on 5.10?
by sedusedan (Pilgrim) on Jul 27, 2012 at 01:11 UTC

    Neat! tobyink++

    All I need now is something like, say feature::each_on_array, so that the code below: 

    use feature::each_on_array;
@a = (1..1000);
while (my ($idx, $item) = each @a) { }

    [download]

    will run on Perl 5.10 and will take no performance hit on 5.12+.

    Are you interested in packaging Tie::ArrayAsHash for distribution? There's already Tie::Array::AsHash on CPAN. Perhaps rethink the name because your solution also provides aeach(). 

    package feature::each_on_array;

use strict;
use warnings;
use Tie::ArrayAsHash qw(aeach);

sub import {
    return unless $^V lt 5.16.0;
    no strict 'refs';
    my @caller = caller;
    *{"$caller[0]::each"} = \&aeach;
}

1;

    [download]
[reply]
[d/l]
[select]

      As I said, there's a reason I called it aeach instead of each. You can define your own sub called each, but if you try to actually use it, you just get the Perl built-in. This goes right down to the Perl tokenizer.

      There are only three ways to call your own each function: qualify your call with the package name (MyPackage::each(@array)), prefix it with an ampersand (&each(\@array) - note that prototype will be ignored, so you need to pass a reference), or call it as a method (but methods can't be called on unblessed arrays, unless you use autobox).

      Now, it is palso ossible to overwrite the core each with your own:

      use Tie::ArrayAsHash 'aeach';
BEGIN { *CORE::GLOBAL::each = \&aeach };

      [download]

      However, this is a global override rather than being package scoped or lexically scoped. (You might think that it would introduce infinite recursion because aeach internally calls each, but actually it does not. This is because aeach has already been compiled when the override happens, so is not affected by the override.)

      To override each for just a lexical scope is a much harder proposition.

      perl -E'sub Monkey::do{say$_,for@_,do{($monkey=[caller(0)]->[3])=~s{::}{ }and$monkey}}"Monkey say"->Monkey::do'
[reply]
[d/l]
[select]

        I don't think you're entirely correct. The code which I posted (feature::each_on_array) works on my 5.10. And I did not override "each" globally, only on the caller's package. 

        % perl -I. -Mfeature::each_on_array -E'say $^V; @a = (qw/a b c/); whil
+e (($i, $e) = each @a) { say $i, $e }'
v5.10.1
0a
1b
2c

        [download]
        vs 
        % perl -I. -Mfeature::each_on_array -E'say $^V; @a = (qw/a b c/); whil
+e (($i, $e) = each @a) { say $i, $e } package Foo; @b = (qw/a b c/); 
+while (($i, $e) = each @b) { say $i, $e }'
Type of arg 1 to each must be hash (not array dereference) at -e line 
+1, near "@b) "

        [download]

        Perl here does call our subroutine's each.

        I'll be packaging this as a CPAN module; I need this to work on a 5.10 box, and I want to see CPAN Testers result. I'm including Tie::ArrayAsHash for now.

[reply]
[d/l]
[select]

        To override each for just a lexical scope is a much harder proposition.

        ex::override maybe? 

        {
  use ex::override 'each' => \&aeach;
  ...
  no ex::override 'each'; 
}

        [download]
[reply]
[d/l]

In Section Seekers of Perl Wisdom