Beefy Boxes and Bandwidth Generously Provided by pair Networks
Don't ask to ask, just ask
 
PerlMonks  

improve ugly flow control

by perrin (Chancellor)
on Sep 19, 2004 at 07:01 UTC ( #392124=perlquestion: print w/ replies, xml ) Need Help??
perrin has asked for the wisdom of the Perl Monks concerning the following question:

I have a situation where I need to try multiple things and if any of them succeed I want to stop. However, I also need to do something if none of them succeed. I am currently using a very ugly construct kind of like this:
my $success = 0; foreach my $try (@options) { if (exists $hash{$try}) { do_something($try); $success = 1; last; } } if (!$success) { log_failure(); }
Can anyone suggest a nicer way to do this? I particularly dislike the use of the $success flag. In my real code, I have many conditions to check and have to put the flag setting code and the "last" statement after each one, which feels redundant.

Comment on improve ugly flow control
Download Code
Re: improve ugly flow control
by Aristotle (Chancellor) on Sep 19, 2004 at 07:11 UTC

    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(); }

    Makeshifts last the longest.

      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: ...
Re: improve ugly flow control
by Zaxo (Archbishop) on Sep 19, 2004 at 07:41 UTC

    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;
    or maybe better,
    grep { exists($hash{$_}) && do_something($_) .. 1 } @options or log_failure();
    Untested, but I think it's nearly right.

    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/ }' $
    I'm using a variable $s there because bart++ tells me that flipflop can play games with $. if bare integers are presented to it.

    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$
    Silly mistake on my part.

    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(); }
    $success must be checked first to short-circuit the rest of the processing.

    After Compline,
    Zaxo

      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 )

      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

      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

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

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

      Makeshifts last the longest.

Re: improve ugly flow control
by FoxtrotUniform (Prior) on Sep 19, 2004 at 07:53 UTC

    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; } }
    Now admittedly, inserting the sentinel into @options and %hash is obnoxious and hackish, but better to have that in your data than in your code....

    --
    F o x t r o t U n i f o r m
    Found a typo in this node? /msg me
    % man 3 strfry

      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; } }

      Makeshifts last the longest.

•Re: improve ugly flow control
by merlyn (Sage) on Sep 19, 2004 at 07:53 UTC
      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.

      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 ); }

      Makeshifts last the longest.

Re: improve ugly flow control
by dragonchild (Archbishop) on Sep 19, 2004 at 14:12 UTC
    If something feels redundant, that's probably a good reason to look at putting it in a subroutine. I would do something like this:
    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(); }

    (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(); }

    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.

    ------
    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

Re: improve ugly flow control
by Arunbear (Parson) on Sep 19, 2004 at 14:40 UTC
    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;
Re: improve ugly flow control
by aufflick (Deacon) on Sep 20, 2004 at 01:31 UTC
    Is anyone saying that Aristotle's clean and simple (IMHO) solution has any problems?
      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; }

        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.

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: perlquestion [id://392124]
Approved by Plankton
Front-paged by grinder
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others scrutinizing the Monastery: (8)
As of 2014-07-11 08:18 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    When choosing user names for websites, I prefer to use:








    Results (220 votes), past polls