Beefy Boxes and Bandwidth Generously Provided by pair Networks
The stupid question is the question not asked
 
PerlMonks  

findone { coderef } @array

by shotgunefx (Parson)
on Feb 27, 2002 at 20:45 UTC ( #148032=note: print w/ replies, xml ) Need Help??


in reply to Re: findone { coderef } @array
in thread findone { coderef } @array

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>perl@leeland.net<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


Comment on findone { coderef } @array
Download Code

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: note [id://148032]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others imbibing at the Monastery: (18)
As of 2014-09-22 16:14 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    How do you remember the number of days in each month?











    Results (198 votes), past polls