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]