#!/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);
}