The obvious answer is, of course, a labelled block.

TRY: {
    foreach my $try ( @options ) {
        next unless exists $hash{ $try };
        do_something( $try );
        last TRY;
    }

    log_failure();
}
[download]

This would have been obvious 30 years ago; perhaps less so today:

foreach my $try (@options) {
  next unless exists $hash{$try};
  do_something($try);
  goto SUCCESS;
}

log_failure();

SUCCESS: ...
[download]

use List::Util qw(first);
if (defined(my $try = first { $hash{$_} } @options)) {
  do_something($try);
} else {
  log_failure();
}
[download]

That's a neat idea. Unfortunately, in my real code, the $hash{$_} test is actually something expensive, so I need to stop as soon as one of the options works. I should have made a better example.

Uh, first actually bails on that. Try it!

-- Randal L. Schwartz, Perl hacker
Be sure to read my standard disclaimer if this is a reply.

I liked that quite a bit, but the structure has been bothering me, like with most other solutions: it feels to me like the failure case gets too much emphasis. I didn't know how to do any better when I first saw the post, though. But now I think I do:

{
    my $try = first { $hash{ $_ } } @options;
    defined $try or ( log_failure(), last );
    do_something( $try );
}
[download]

Makeshifts last the longest.

Last Update: This is wrong. See below for details.

Here's a somewhat exotic construction that I think reads well. Assumes that do_something() returns true on success.

log_failure()
    unless grep {
        exists($hash{$_})
        && do_something($_)
        .. 1
    } @options;
[download]

grep {
    exists($hash{$_})
    && do_something($_)
    .. 1
} @options or log_failure();
[download]

The flipflop is true for zero or one keys and the initiating condition is not evaluated again after it is first true.

Update: Tested now, and it's not right. Trying to fix it.

Another Update: Is this a bug in perl's flipflop op? In perl-5.8.4

$ perl -Mstrict -we'my $s=1;for(qw/foo bar baz/){ print if /b/..$s }'
barbaz$ 
$ perl -Mstrict -we'my $s=1;for(qw/foo bar baz/){ print if $s../b/ }'
$
[download]

Final Update: There is no bug, except in my logic. Changing the right hand side of the flipflop to match anything (//) instead of fooling with constants, I find by printing the sequence numbers that the flipflop switches off ok, but switches on again next time around.

$ perl -e'for (qw/foo bar baz blah/){print int scalar(/b/..//)}'
0111$
[download]

Here is a version that works, but it still needs that pesky $success variable I was trying to get rid of.

{
    my $success;
    grep {
        ! $success
        && exists($hash{$_})
        && do_something($_)
        .. ($success = 1)
    } @options
        or log_failure();
}
[download]

Neat hack. Note that the grep will always iterate all of @options though. Also, you can remove the dependency on do_something()'s return value with a construct like

exists $hash{ $_ } and ( do_something( $_ ), 1 )
[download]

Makeshifts last the longest.

In reply to the update:

// does not match "anything". It is overloaded to reapply the last successfully matched pattern, in your case, /b/. You wouldn't notice that because all your test data past the successful match has a "b" in it… Changing that clearly reveals faulty logic: once the right side is true, and flipflop starts over on the left side again.

$ perl -le'for( qw/foo bar baz blah/ ){ print int scalar( /b/ .. // ) 
+}'
0
1
1
1
$ perl -le'for( qw/foo bar baz quux/ ){ print int scalar( /b/ .. // ) 
+}'
0
1
1
0
[download]

Now let's take a short trip to perlop:

The value returned is either the empty string for false, or a sequence number (beginning with 1) for true. The sequence number is reset for each range encountered. The final sequence number in a range has the string "E0" appended to it, which doesn't affect its numeric value, but gives you something to search for if you want to exclude the endpoint. You can exclude the beginning point by waiting for the sequence number to be greater than 1.

You want a right side that does not succeed. Because once it succeeds, you start over on the left side again!

Now a simple, correct match-always pattern is /^/ or /(?=)/, and a simple match-never pattern is /$^/ or /(?!)/. Indeed, using a match-never pattern:

$ perl -le'for( qw( foo bar baz quux ), "" ){ print int scalar( /b/ ..
+ /$^/ ) }'
0
1
2
3
4
$ perl -le'for( qw( foo bar baz quux ), "" ){ print int scalar( /baz/ 
+.. /$^/ ) }'
0
0
1
2
3
[download]

Well, that sequence looks right. So that means you can say:

log_failure()
    unless grep {
        ( exists $hash{$_} and ( do_something($_), 1 ) )
        .. /$^/
    } @options;
[download]

Makeshifts last the longest.

How about putting a "fail" sentinel at the end of @options and in %hash, such that do_something('fail') is the same as log_failure()? That way, your loop simplifies to:

foreach (@options) {
  if(exists $hash{$_}) {  # always true for $_='fail'
    &do_something($_); last;
  }
}
[download]

In the same vein, but along a different angle:

foreach my $i ( 0 .. $#options, 'fail' ) {
    if( $i eq 'fail' ) {
        log_failure();
        last;
    }
    if( exists $hash{ $options[ $i ] } ) {
        do_something( $options[ $i ] );
        last;
    }
}
[download]

Makeshifts last the longest.

sub handle_options
{
    my ($hash, $options, $subref) = @_;

    foreach my $try (@$options)
    {
        next unless exists $hash->{$try};
        $subref->( $try );
        return;
    }

    die;
}

eval {
    handle_options( \%hash, \@options, \&do_something );
}; if {$@) {
    log_failure();
}
[download]

(Yes, I am really returning undef and die'ing with no string. The key is die/not-die, determining whether or not to trigger the if ($@) { ... } block.)

The really neat thing about this method is that you can handle multiple sets of options in the same eval, so long as they all use the same algorithm.

eval {
    handle_options( \%hash1, \@options1, \&do_something1 );
    handle_options( \%hash2, \@options2, \&do_something2 );
    handle_options( \%hash3, \@options3, \&do_something3 );
}; if ($@) {
    log_failure();
}
[download]

Note: This will do_something1() for the first set before handling the second set, and so forth. The description you give implies that this should be the case, but it's explicit here.

my @Tests = (
    { 
      cond   => sub {$_[0] eq 'blue'}  , 
      action => sub { print "$_[0] is good"} 
    },
    { 
      cond   => sub {$_[0] eq 'red'}   , 
      action => sub { print "$_[0] is bad"}  
    },
    { 
      cond   => sub {$_[0] eq 'green'} , 
      action => sub { print "$_[0] is ugly"} 
    },
);

OUTER: foreach my $try (@options) {
    foreach (@Tests) { 
        if ($_->{cond}->($try)) {
            $_->{action}->($try);
            $_->{success}++;
            last OUTER;
        }
    }    
}

log_failure() unless grep {exists $_->{success}} @Tests;
[download]

For one item, Aristotle's solution is excellent. However, I believe my solution scales better when performing this kind of test over and over. *shrugs* It all depends on what you want to do.

------
We are the carpenters and bricklayers of the Information Age.

Then there are Damian modules.... *sigh* ... that's not about being less-lazy -- that's about being on some really good drugs -- you know, there is no spoon. - flyingmoose

I shouldn't have to say this, but any code, unless otherwise stated, is untested

How so? You've basically turned my TRY block into a function and deferred the failure handling through an exception. That doesn't seem more efficient to me — am I missing something?

I don't particularly like exceptions as a mechanism to deal with soft failures though. In case I did need to handle multiple cases, I'd do something much along the lines of my first post, like this:

OPTION_LIST: for(
    [ \%hash1, \@options1, \&do_something1, ],
    [ \%hash2, \@options2, \&do_something2, ],
    [ \%hash3, \@options3, \&do_something3, ],
) {
    my ( $hash, $options, $callback ) = @$_;
    foreach my $try ( @$options ) {
        next unless exists $hash->{ $try };
        $callback->( $try );
        next OPTION_LIST;
    }
    log_failure();
    last;
}
[download]

Note that both this and your code is deficient if you need atomic behaviour; do_something1 will already have been called by the time a failure to find any of the @options2 in %hash2 is detected. If that is undesired, a proper exception-based solution will hardly differ from the non-exception solution.

Makeshifts last the longest.