Perl makes it really easy to iterate over elements of an array. Examples include:
foreach my $element ( @array ) { ...... }
...and...
my @newlist = map { ....... } @array;
But there are times when you find yourself in the middle of one of those looping constructs, just wishing that there were a way to know the index of the element that is the subject of the current loop iteration. The most common Perl idioms when this is necessary are:
foreach my $idx ( 0 .. $#array ) {
#do something with $array[$idx];
}
...and...
my @newlist = map { # do something with $array[$_] } 0 .. $#array;
But this wouldn't be Perl if there weren't Another Way. What follows is a class called IndexedArray, and an accompanying test snippet. The class should be saved as IndexedArray.pm and put somewhere accessible by use IndexedArray;. To use it, you must tie your array to this class. The class mimicks an ordinary Perl array in every way I know of, but it adds one object method called which(). Whenever it makes sense, which() returns the index of the most recently accessed element of the tied array.
which()'s return value wouldn't really make sense when it follows a splice(), unshift(), pop(), and a few other array actions, and perhaps I should cause it to return undef under such circumstances. The current implementation is that whenever you do something with the array that doesn't result in a clearly defined 'last element accessed', which()'s internal tracking variable is just reset to zero. This is sort of in keeping with the same idea of scalar keys; resetting the each() iterator for hashes.
I'd like to hear what others think of this. If it generates any interest, I may add a what() method (it would return the value of the last element accessed).(added) And if this actually seems useful to anyone, I might gear it up for CPAN as Tie::Array::CurrentIndex, or something along those lines.
First, the module: IndexedArray.pm, and second, the test snippet. Enjoy, and let me know what you think!
package IndexedArray;
use strict;
our $VERSION = '0.50';
sub TIEARRAY {
my $class = shift;
bless { ARRAY => [], INDEX => 0 }, $class;
}
sub FETCHSIZE {
my $self = shift;
$self->{INDEX} = 0;
scalar @{ $self->{ARRAY} };
}
sub STORESIZE {
my( $self, $size ) = ( $_[0], $_[1]-1 );
$self->{INDEX} = 0;
$#{ $self->{ARRAY} } = $size;
}
sub STORE {
my( $self, $index, $value ) = @_;
$self->{INDEX} = $index;
$self->{ARRAY}[$index] = $value;
}
sub FETCH {
my( $self, $index ) = @_;
$self->{INDEX} = $index;
$self->{ARRAY}[$index];
}
sub CLEAR {
my( $self ) = shift;
$self->{INDEX} = 0;
@{ $self->{ARRAY} } = ();
}
sub POP {
my $self = shift;
$self->{INDEX} = 0;
pop( @{ $self->{ARRAY} } );
}
sub PUSH {
my $self = shift;
$self->{INDEX} = $#{ $self->{ARRAY} } + scalar( @_ );
push( @{ $self->{ARRAY} }, @_ );
}
sub SHIFT {
my $self = shift;
$self->{INDEX} = 0;
shift( @{ $self->{ARRAY} } );
}
sub UNSHIFT {
my $self = shift;
$self->{INDEX} = 0;
unshift( @{ $self->{ARRAY} }, @_ );
}
sub EXISTS {
my( $self, $index ) = @_;
$self->{INDEX} = $index;
exists( $self->{ARRAY}[ $index ] );
}
sub DELETE {
my( $self, $index ) = @_;
$self->{INDEX} = 0;
delete( $self->{ARRAY}[ $index ] );
}
sub SPLICE {
my( $self ) = shift;
my $size = $self->FETCHSIZE();
my $offset = @_ ? shift : 0;
$offset += $size if $offset < 0;
my $length = @_ ? shift : $size - $offset;
$self->{INDEX} = 0;
return splice( @{ $self->{ARRAY} }, $offset, $length, @_ );
}
sub which {
my $self = shift;
return $self->{INDEX};
}
sub what {
my $self = shift;
return $self->{ARRAY}[ $self->{INDEX} ];
}
sub DESTROY { }
sub EXTEND { }
1;
And now a test snippet...
use strict;
use warnings;
use IndexedArray;
my $obj = tie my @array, 'IndexedArray';
print "First test: Store A .. F to \@array and print \@array.\n";
@array = ( 'A' .. 'F' );
print "@array\n\n";
print "Second test: Fetch \$array[3] and discover which "
. "element it was.\n"
. "$array[3] came from ", $obj->which(), ".\n\n";
print "Third test: Iterate over \@array, and discover which\n"
. "element is being accessed in each iteration.\n"
. "Use foreach in this test.\n";
iteration_test( \@array );
print "\nFourth test. Sort \@array in reverse order, and repeat "
. "the third test.\n";
@array = reverse @array;
iteration_test( \@array );
sub iteration_test {
foreach my $element ( @{ $_[0] } ) {
print "$element came from \$array["
. $obj->which()
. "].\n";
}
}
