Like grep but returns the first match. successive calls return successive elements.
I was working on awhile back. It was one of those things that I wanted to do, just to do it because it should be possible. (Have a sub that remembers some context info.)
#!/usr/bin/perl
######################################################################
+###############
# findone
# usage: findone { coderef }, @array , OPTIONAL start_index OPTIONAL
+end_index
# Like grep but returns the first match. successive calls return succe
+ssive elements.
# Can be nested. Uses Weak references to prevent the leaking of memory
+.
######################################################################
+###############
BEGIN {
use warnings;
use strict;
use WeakRef;
my %find_cache = (); # Temporary Storeage.
sub findone(&\@;$$) {
my $coderef = shift ;
# Generate a key from the caller function so we can track whic
+h call it is.
my $codekey = join(":",caller(),"$_[0]"); # Generate key
my %persistant_args = () ;
##############################################################
+##########
# Clean up old keys to prevent leaking mem. If the data does
+not exist,
# then it has been freed and we don't need to keep position in
+fo.
##############################################################
+##########
while(my ($k,$v) = each %find_cache){
delete $find_cache{$k} unless defined ($v->{dataref});
}
unless (defined $find_cache{$codekey} ){
%persistant_args = ('index' =>($_[1]||0), 'dataref' => $_[
+0] );
}else{
%persistant_args = %{$find_cache{$codekey}};
}
my $end_index = $_[2] || $#{ $_[0] };
for (; $persistant_args{index} <= $end_index; $persistant_ar
+gs{index}++ ){
$_ = $_[0]->[$persistant_args{index}];
if (&$coderef){
$persistant_args{index}++;
$find_cache{$codekey} = {%persistant_args};
weaken ($find_cache{$codekey}->{dataref});
return wantarray ? ($_ ,($persistant_args{index} -1 )
+ ) : $_;
}
}
delete $find_cache{$codekey};
return;
}
}
###########################
# Silly Example #
###########################
my @words = (qw(this Is a silly coNtrived Test)) x 5;
print "\@words is $#words\n";
while ( my ( $val ,$index ) = findone { m/[A-Z]/ } @words ){
print "_" x 40,"\n";
print "Matched uppercase letter $val at $index \n";
while ( my ( $otherval ,$otherindex ) = findone { !m/[A-Z]/ }
+@words , 10, 22 ){
print "\tInner matched all lower $otherval at $otherindex\n";
}
sleep(1);
}
updated Changes in response to jynx
updated Changed to accept end_index as well.
updated Changed to use stringified reference in cache key.
Now you can nest them.
my @AoA = (Array of arrays);
while ( my ($val,$index) = findone { findone{ other_criteria } @{$_} } @AoA ){
}
UPDATE: Subtle Bug/Feature, see
this. I have a newer version that uses Filter::Simple, but I still hope to fix this without resorting to it.
UPDATE: Rough filter simple version
here.
-Lee
"To be civilized is to deny one's nature."