comment on

I plan to make a collection of various flavors of case/switch/given and package them up for CPAN as one package, probably named "Case.pm". This one is very C-flavored, with a twist. It constructs a hash associating your options with their actions, and returns a closure (necessary for handling default and fall-through). Then, when you need to execute the case, you just pass your term to the closure, and the appropriate sub(s) are executed.

I even wrangled a break() statement. No default identifier, though.

Comments on flaws or possible enhancements* would be welcome.

* within the limitations of using a hash jump table

Revision 1:

added a no-op subroutine to act as the default flag, and also as the default-default case
the term is passed to the subroutines
croaks on malformed input
simplified code by processing input list in reverse

Revision 2:(posted as followup, below)

Got rid of break(); added local $Case::action() for chaining subs
Die on non-CODE refs; warn on unreachable action block

package Swash;

# This is a tag you can stick in the list for clarity
# also serves as default routine when none is specified
sub default {}

# Make a key for each non-ref entry; the value is a coderef
# that executes the first subsequent coderef in the list
# Plus some bookkeeping to make fallthrough happen
sub new {
    my %swash;
    my ($default, $nextcode, $gotcode) = (\&default) x 2;
    my $call_pkg = caller;
    for my $item (reverse @_) {
        if (ref $item eq 'CODE') {
            if ($gotcode) {
                if (keys %swash) {
                    use Carp;
                    croak "Malformed swash: non-default coderef with n
+o associated term found";}
                $nextcode = $default = $gotcode;
            }
            $gotcode = $item;
        }
        elsif ($gotcode) {
            my ($case_code, $fallthru_code) = ($gotcode, $nextcode);
            $swash{$item} = sub {
                    my $fallthru = 1;
                    no strict 'refs';
                    no warnings 'redefine';
                    local *{$call_pkg.'::break'} = sub { $fallthru = 0
+ };
                    $case_code->($_[0]);
                    $fallthru_code->($_[0]) if $fallthru;
                };
            $nextcode = $swash{$item};
            ($gotcode, @keys) = ();
        }
        else {
            $swash{$item} = $nextcode;
        }
    }
    return sub { my ($term) = @_; ($swash{$term} || $default)->($term)
+ };
}

1;

package main;

my $case = Swash::new(
   qw(mozart)          => sub { print "$_[0] was a Musician!\n" },
   qw(einstein newton) => sub { print "$_[0] was a Genius!\n"; break()
+; },
   qw(dog cat pig)     => sub { print "$_[0] is an Animal!\n"; break()
+; },
   'Roy'               => sub { print "$_[0] should fall through..." }
+,
   Swash::default      => sub { print "No idea what $_[0] is.\n" }
);   

for (qw(mozart cat PerlMonk newton pig einstein)) {
    print "Looking up $_...\n";
    $case->($_);
}
print "And Roy?\n";
$case->('Roy');
[download]

In reply to Switch/case as a dispatch table with C-style fall-through by Roy Johnson

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.


laziness, impatience, and hubris
	PerlMonks