Is there a way to replace an if-elsif-else in Perl with something better?

Question

I want to build a bunch of Perl subrotines that all have the same template if elsif elsif else that takes a decision based on a factor variable. Here's an example of subroutine template:

sub get_age{

  my $factor=shift;

  if    ($factor == 1 ){ print "do something" }
  elsif ($factor == 2 ){ print "do somthing2" }
  elsif ($factor == 3 ){ print "do somthing3" }
  elsif ($factor == 4 ){ print "do somthing4" }
  else                 { print "error"        }
  }

I am wondering if there some design pattern on Perl to replace the if else condition with more elegant solution which easy to maintain in the future specifically if I need to change some of the conditions or delete some of it?

Always include actual running code. – brian d foy Nov 29 '11 at 22:21 — brian d foy, Nov 29 '11 at 22:21

score 10 · Accepted Answer · answered Nov 29 '11 at 22:33

A couple of people have mentioned a dispatch table. There are two things and it's nice to keep them apart sometimes. There's the list of possible things that could happen, and the thing that makes them happen. If you couple the two, you're stuck with your solution. If you keep them separate, you have more flexibility later.

The dispatch table specifies the behavior as data instead of program structure. Here's two different ways to do it. With your example you have integers and something like that might use an array to store things. The hash example is the same idea but looks up the behavior slightly differently.

Also notice that I factor out the print. When you have repeated code like that, try to move the repeated stuff up a level.

use v5.10;

foreach my $factor ( map { int rand 5 } 0 .. 9 ) {
    say get_age_array( $factor );
    }

my @animals = qw( cat dog bird frog );
foreach my $factor ( map { $animals[ rand @animals ] } 0 .. 9 ) {
    say get_age_hash( $factor );
    }

sub get_age_array {
    my $factor = shift;

    state $dispatch = [
        sub { 'Nothing!' }, # index 0
        sub { "Calling 1" },
        sub { 1 + 1 },
        sub { "Called 3" },
        sub { time },
        ];

    return unless int $factor <= $#$dispatch;

    $dispatch->[$factor]->();   
    }


sub get_age_hash {
    my $factor = shift;

    state $dispatch = {
        'cat'  => sub { "Called cat" },
        'dog'  => sub { "Calling 1"  },
        'bird' => sub { "Calling 2, with extra" },
        };

    return unless exists $dispatch->{$factor};

    $dispatch->{$factor}->();   
    }

I noticed your answer after posting mine, same idea, correct implementation ;-) — Sinan Ünür, Nov 29 '11 at 23:11

score 7 · Answer 2 · edited Sep 28 '15 at 15:31

7

Update: Make sure you read brian's comment below; basically, it's better to use for instead of given, due to various issues he comments on in his link. I've updated my advice to incorporate his improvements, which he outlines in Use for() instead of given():

If you're on perl 5.10 or newer, given/when is the magic pair you are looking for, but you really should use for/when instead.. Here's an example:

use strict;
use warnings;
use feature qw(switch say);

print 'Enter your grade: ';
chomp( my $grade = <> );

for ($grade) {
    when ('A') { say 'Well done!'       }
    when ('B') { say 'Try harder!'      }
    when ('C') { say 'You need help!!!' }
    default { say 'You are just making it up!' }
}

edited Sep 28 '15 at 15:31

brian d foy

129,424
31
207
592

answered Nov 29 '11 at 22:13

Marius Kjeldahl

6,830
3
33
37

6

Instead of `given`, use `for` to avoid the various bugs with `given`. See [Use for() instead of given()](http://www.effectiveperlprogramming.com/blog/1333). – brian d foy Nov 29 '11 at 22:35
The blog link in the answer gives a HTTP 404. – Susheel Javadi Sep 03 '15 at 09:46
The link is now http://www.effectiveperlprogramming.com/2011/05/use-for-instead-of-given/ – brian d foy Sep 28 '15 at 15:32

score 3 · Answer 3 · answered Nov 30 '11 at 02:09

just making things shorter:

sub get_age1 {
    my $age = shift;
    $age == 1 ? print "do something" :
    $age == 2 ? print "do somthing2" :
    $age == 3 ? print "do somthing3" :
    $age == 4 ? print "do somthing4" :
                print "error"
}

this one makes more sense if the condition can be best expressed as a regex:

sub get_age2 {    
    for (shift) { 
        if    (/^ 1 $/x) {print "do something"}
        elsif (/^ 2 $/x) {print "do somthing2"}
        elsif (/^ 3 $/x) {print "do somthing3"}
        elsif (/^ 4 $/x) {print "do somthing4"}
        else             {print "error"       }
    }
}

here are a few dispatch tables:

the simple one (with a bug):

{
    my %age = ( # defined at runtime
        1 => sub {print "do something"},
        2 => sub {print "do somthing2"},
        3 => sub {print "do somthing3"},
        4 => sub {print "do somthing4"},
    );
    # unsafe to call get_age3() before sub definition
    sub get_age3 {
        ($age{$_[0]} or sub {print "error"})->()
    }
}

a better one:

{
    my %age;
    BEGIN {
        %age = ( # defined at compile time
            1 => sub {print "do something"},
            2 => sub {print "do somthing2"},
            3 => sub {print "do somthing3"},
            4 => sub {print "do somthing4"},
        )
    }
    # safe to call get_age4() before sub definition
    sub get_age4 {
        ($age{$_[0]} or sub {print "error"})->()
    }
}

another way to write it:

BEGIN {
    my %age = ( # defined at compile time
        1 => sub {print "do something"},
        2 => sub {print "do somthing2"},
        3 => sub {print "do somthing3"},
        4 => sub {print "do somthing4"},
    );
    # safe to call get_age5() before sub definition
    sub get_age5 {
        ($age{$_[0]} or sub {print "error"})->()
    }
}

another good way to write it:

{
    my $age;
    # safe to call get_age6() before sub definition
    sub get_age6 {
        $age ||= { # defined once when first called
           1 => sub {print "do something"},
           2 => sub {print "do somthing2"},
           3 => sub {print "do somthing3"},
           4 => sub {print "do somthing4"},
        };
        ($$age{$_[0]} or sub {print "error"})->()
    }
}

In the first example, since you're printing in any case, you can do with a single `print` and apply the conditional on the string: `print ( $age == 1 ? ... : $age == 2 ? ... : ... );` — Zaid, Nov 30 '11 at 05:13

Claudio Fsr · Answer 4 · 2020-09-13T13:37:41.760

See examples/references/dispatch_table.pl

https://code-maven.com/slides/perl/dispatch-table

#!/usr/bin/perl
use strict;
use warnings;

# Use subroutine references in a hash to define what to do for each case

my %dispatch_table = (
    '+' => \&add,
    '*' => \&multiply,
    '3' => \&do_something_3,
    '4' => \&do_something_4,
);

foreach my $operation ('+', 'blabla', 'foobar', '*'){
    $dispatch_table{$operation}->(
        var1 => 5,
        var2 => 7,
        var3 => 9,                       
    ) if ( exists $dispatch_table{$operation} );
}

sub add {
    my %args = (@_);
    my $var1 = $args{var1}; 
    my $var2 = $args{var2};

    my $sum = $var1 + $var2;
    print "sum = $sum \n";
    return;
}

sub multiply {
    my %args = (@_);
    my $var1 = $args{var1}; 
    my $var3 = $args{var3};

    my $mult = $var1 * $var3;
    print "mult = $mult \n";
    return;
}

Output:

sum = 12 
mult = 45

score 0 · Answer 5 · answered Nov 29 '11 at 22:47

0

Dispatch tables are a perfect fit for this type of design pattern. I've used this idiom many times. Something like this:

sub get_age {
    my $facter = shift;
    my %lookup_map = (
        1 => sub {.....},
        2 => sub {.....},
        3 => \&some_other_sub,
        default => \&some_default_sub,
    );
    my $code_ref = $lookup_map{$facter} || $lookup_map{default};
    my $return_value = $code_ref->();
    return $return_value;
}

This works when the argument you are using to determine which case gets executed is going to exist as a key in your hash table. If it is possible that it won't be an exact match then you may need to use regular expressions or some other way to match your input to which bit of code to execute. You can use regexes as hash keys like this:

my %patterns = (
    qr{^/this/one}i => sub {....},
    qr{^/that/one}is => sub {....},
    qr{some-other-match/\d+}i => \&some_other_match,
)
my $code_ref;
for my $regex (keys %patterns) {
    if ($facter =~ $regex) {
        $code_ref = $patterns{$regex};
        last;
    }
}
$code_ref ||= \&default_code_ref;
$code_ref->();

answered Nov 29 '11 at 22:47

localfilmmaker

416
1
4
9

1

You also redefine the dispatch table on every call to get_age. :) – brian d foy Nov 29 '11 at 22:54
2

The keys of a hash are always strings. So, I am not sure what the point of `qr//` is achieving there. – Sinan Ünür Nov 29 '11 at 23:13
@briandfoy, yes you are right. The dispatch table will most likely not change from one call to get_age() to another. So pulling that dispatch table out of the sub so it is only defined once would be best. – localfilmmaker Nov 29 '11 at 23:28
3

@localfilmmaker See http://perldoc.perl.org/perldata.html *Hashes are unordered collections of scalar values indexed by their associated **string** key.* (emphasis mine). – Sinan Ünür Nov 29 '11 at 23:39
Thanks for the clarification, @SinanÜnür and briandfoy. – localfilmmaker Nov 30 '11 at 00:30

score -1 · Answer 6 · answered Nov 29 '11 at 22:14

-1

This may be a place for something like a dispatch table. I haven't done it myself but this page might be a start: http://www.perlmonks.org/?node_id=456530

answered Nov 29 '11 at 22:14

Dave Rager

8,002
3
33
52

score -4 · Answer 7 · edited Nov 29 '11 at 22:37

-4

use Switch;

Read Dispatch Tables in Higher Order Perl.

edited Nov 29 '11 at 22:37

brian d foy

129,424
31
207
592

answered Nov 29 '11 at 22:14

aartist

3,145
3
33
31

3

Switch was removed from the Perl core in v5.14, so you shouldn't use it for new code. – brian d foy Nov 29 '11 at 22:38

Is there a way to replace an if-elsif-else in Perl with something better?

7 Answers7