Beefy Boxes and Bandwidth Generously Provided by pair Networks
Just another Perl shrine
 
PerlMonks  

comment on

( [id://3333]=superdoc: print w/replies, xml ) Need Help??
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

In reply to findone { coderef } @array by shotgunefx
in thread findone { coderef } @array by shotgunefx

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post; it's "PerlMonks-approved HTML":



  • Are you posting in the right place? Check out Where do I post X? to know for sure.
  • Posts may use any of the Perl Monks Approved HTML tags. Currently these include the following:
    <code> <a> <b> <big> <blockquote> <br /> <dd> <dl> <dt> <em> <font> <h1> <h2> <h3> <h4> <h5> <h6> <hr /> <i> <li> <nbsp> <ol> <p> <small> <strike> <strong> <sub> <sup> <table> <td> <th> <tr> <tt> <u> <ul>
  • Snippets of code should be wrapped in <code> tags not <pre> tags. In fact, <pre> tags should generally be avoided. If they must be used, extreme care should be taken to ensure that their contents do not have long lines (<70 chars), in order to prevent horizontal scrolling (and possible janitor intervention).
  • Want more info? How to link or How to display code and escape characters are good places to start.
Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others drinking their drinks and smoking their pipes about the Monastery: (3)
As of 2024-03-29 01:55 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found