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');
-
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.