CUFP
shotgunefx
Like grep but returns the first match. successive calls return successive elements.
<br>
This was the solution to a reference <a href="http://www.perlmonks.org/index.pl?node_id=112053">problem</a>
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.)
<br>Plus I like the construct :).
<readmore>
<code>
#!/usr/bin/perl
#####################################################################################
# findone
# usage: findone { coderef }, @array , OPTIONAL start_index OPTIONAL end_index
# Like grep but returns the first match. successive calls return successive 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 which 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 info.
########################################################################
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_args{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);
}
</code>
<b>updated</b> Changes in response to jynx<br>
<b>updated</b> Changed to accept end_index as well.<br>
<b>updated</b> Changed to use stringified reference in cache key.<br> Now you can nest them.<br>
<pre>
my @AoA = (Array of arrays);
while ( my ($val,$index) = findone { findone{ other_criteria } @{$_} } @AoA ){
}
</pre>
<B><font size=+1>UPDATE: </font></B>Subtle Bug/Feature, see <a href="http://www.perlmonks.org/index.pl?node_id=147752">this.</a> I have a newer version that uses Filter::Simple, but I still hope to fix this without resorting to it.
<BR><B><font size=+1>UPDATE: </font></B>Rough filter simple version <a href="http://www.perlmonks.org/index.pl?node_id=148032">here</a>.
<br><br>
-Lee
<br><br>
"To be civilized is to deny one's nature."