findone { coderef } @array

[shotgunefx]

I thought about that but I was trying to make something like a built-in. To be honest I've spent WAY to much time on this. I don't need to do this but it one of those things that I want to do, just to do.

I do have a version that works usually (Still tweaking) using Filter::Simple that basically changes any call that is not on a line with for/foreach/while to a version findfirst that doesn't keep track.

UPDATE
Here's a rough version.

package FindOne;

######################################################################
+###############
# 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
+. 
######################################################################
+###############


use 5.006;
use strict;
use warnings;
use Carp;
use Filter::Simple;
use WeakRef;


FILTER_ONLY
        code  => sub {
            my @code = split (/\n/);
            # This is suboptimal I'm sure. 
            foreach (@code){
                s/findone/FindOne::findfirst/g unless m/\b(for|foreach
+|while)\W/;
            }
            
            $_ = join ("\n",@code);
        };

require Exporter;

our @ISA = qw(Exporter);

our $DEBUG = 0;
# If $DEBUG is any true value, will tell you when calls to findone
# get changed by source filter.
# If any value above 1, will give more info.



our @EXPORT = qw(
    &findone &findfirst    
);
our $VERSION = '0.02';



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]","$coderef");    # Gene
+rate key 
        warn "Codekey is $codekey and code ref is $coderef" if $DEBUG 
+> 1;
        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} ){
            warn "new find call" if $DEBUG > 1;
            %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}++ ){
            warn "Element is $_" if $DEBUG > 1;
            $_ = $_[0]->[$persistant_args{index}];

            if (&$coderef){
                $persistant_args{index}++;
                $find_cache{$codekey} = {%persistant_args};
                weaken ($find_cache{$codekey}->{dataref});
                warn "$_ matched!" if $DEBUG > 1;
                return wantarray ?  ($_ ,($persistant_args{index} -1 )
+ ) : $_;

            }
        
        }
        delete $find_cache{$codekey};
        return;         
     }



    sub findfirst(&\@;$$) {
        my $coderef = shift ;
        carp "Really calling _findfirst" if $DEBUG;
        my %args = ('index' =>($_[1]||0), 'dataref' => $_[0] );
        my $end_index = $_[2] || $#{ $_[0] };

        for  (; $args{index} <=  $end_index; $args{index}++ ){
            warn "Element is $_ at $args{index}" if $DEBUG > 1;
            $_ = $_[0]->[$args{index}];

            if (&$coderef){
                warn $_," matched!" if $DEBUG > 1;
                return wantarray ?  ($_ ,($args{index} -1 ) ) : $_;

            }else{
                warn $_, "Didn't match" if $DEBUG > 1;
            }
        
        }
        return;         
     }

1;
__END__
# Below is stub documentation for your module. You better edit it!

=head1 NAME

FindOne - Perl extension lazy searching for array elements.

=head1 SYNOPSIS

  use FindOne;
  while (my ($val,$index) = findone { $_ > 10 } @tokens ){
        print "Found $val at $index in \@tokens\n";
  }

  my $foo = 'START';
  die "Couldn't find $foo" unless findone { m/$foo/ } @tokens;

=head1 DESCRIPTION


findone
usage: findone { coderef }, @array  , OPTIONAL start_index OPTIONAL en
+d_index


This is a basically a lazy grep. Will return the first element found.
On subsequent calls it will return subsequent elements.
undef if none are left.

If called in a list context, it will return ($match,$index);
If called in a scalar context, just returns $match.

Internally it uses Filter::Simple to change any calls to 
findone with a call to findfirst unless the current line 
contains a do, for or foreach statement.

This avoids the following gotcha.

my @tokens = (tokens here);

while ($line =<>){
    chomp($line);
    die "$line is not a valid token" unless findone { m/^$line/ } @tok
+ens;
}

Because it keeps track of where and what it's called with, 
it will never match past the first match which means it will 
fail on the second block. (Unless there are multiple matches in @token
+s. 
Then it will fail on the Matches+1 iteration.)

$FindOne::DEBUG = 1; # Will output debug info.

=bugs
Plenty, I'm sure.





=head2 EXPORT

findone() findfirst()


=head1 AUTHOR

Pumphret Lee, E<lt>[e-mail]<gt>

=head1 SEE ALSO
WeakRef
Filter::Simple
=disclaimer
This module is provided with no guarantee at all. Use at your
own risk. You are responsible for anything that goes wrong if
you use this. Enjoy!
=copyright
COPYRIGHT 
    Copyright (c) 2000-2002, Lee Pumphret. All Rights Reserved.
    This module is free software. It may be used, redistributed
        and/or modified under the same terms as Perl itself.
L<perl>.



=cut